1
0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-08-25 14:41:46 +02:00

Jastrow OK

This commit is contained in:
Anthony Scemama 2023-03-31 14:41:32 +02:00
parent daddb57200
commit 5ae8828684

View File

@ -131,66 +131,66 @@ int main() {
The following data stored in the context: The following data stored in the context:
#+NAME: qmckl_jastrow_args #+NAME: qmckl_jastrow_args
| Variable | Type | In/Out | Description | | Variable | Type | Description |
|---------------------------+---------------------------------------+--------+-------------------------------------------------------------------| |---------------------------+---------------------------------------+-------------------------------------------------------------------|
| ~uninitialized~ | ~int32_t~ | in | Keeps bits set for uninitialized data | | ~uninitialized~ | ~int32_t~ | Keeps bits set for uninitialized data |
| ~rescale_factor_ee~ | ~double~ | in | The distance scaling factor | | ~rescale_factor_ee~ | ~double~ | The distance scaling factor |
| ~rescale_factor_en~ | ~double[type_nucl_num]~ | in | The distance scaling factor | | ~rescale_factor_en~ | ~double[type_nucl_num]~ | The distance scaling factor |
| ~aord_num~ | ~int64_t~ | in | The number of a coeffecients | | ~aord_num~ | ~int64_t~ | The number of a coeffecients |
| ~bord_num~ | ~int64_t~ | in | The number of b coeffecients | | ~bord_num~ | ~int64_t~ | The number of b coeffecients |
| ~cord_num~ | ~int64_t~ | in | The number of c coeffecients | | ~cord_num~ | ~int64_t~ | The number of c coeffecients |
| ~type_nucl_num~ | ~int64_t~ | in | Number of Nuclei types | | ~type_nucl_num~ | ~int64_t~ | Number of Nuclei types |
| ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | IDs of types of Nuclei | | ~type_nucl_vector~ | ~int64_t[nucl_num]~ | IDs of types of Nuclei |
| ~a_vector~ | ~double[aord_num + 1][type_nucl_num]~ | in | a polynomial coefficients | | ~a_vector~ | ~double[aord_num + 1][type_nucl_num]~ | a polynomial coefficients |
| ~b_vector~ | ~double[bord_num + 1]~ | in | b polynomial coefficients | | ~b_vector~ | ~double[bord_num + 1]~ | b polynomial coefficients |
| ~c_vector~ | ~double[cord_num][type_nucl_num]~ | in | c polynomial coefficients | | ~c_vector~ | ~double[cord_num][type_nucl_num]~ | 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 |
Computed data: Computed data:
| Variable | Type | In/Out | | Variable | Type | In/Out | |
|-------------------------------------+-------------------------------------------------------------------+---------------------------------------------------------------------------------------------------------| |-------------------------------------+-----------------------------------------------------------------+---------------------------------------------------------------------------------------------------------+----------------------------------------------|
| ~dim_c_vector~ | ~int64_t~ | Number of unique C coefficients | | ~dim_c_vector~ | ~int64_t~ | Number of unique C coefficients | |
| ~dim_c_vector_date~ | ~uint64_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~ | ~double[type_nucl_num]~ | Asymptotic component | |
| ~asymp_jasa_date~ | ~uint64_t~ | Ladt modification of the 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~ | ~double[2]~ | Asymptotic component (up- or down-spin) | |
| ~asymp_jasb_date~ | ~uint64_t~ | Ladt modification of the asymptotic component | | ~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~ | ~double[dim_c_vector][nucl_num]~ | vector of non-zero coefficients | |
| ~c_vector_full_date~ | ~uint64_t~ | Keep track of changes here | | ~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~ | ~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 | | ~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 | | ~tmp_c~ | ~double[walk_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 | | ~dtmp_c~ | ~double[walk_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~ | ~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_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~ | ~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_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~ | ~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_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~ | ~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 | | ~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~ | ~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_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~ | ~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_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~ | ~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 | | ~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 | | ~factor_ee~ | ~double[walk_num]~ | Jastrow factor: electron-electron part | |
| ~value_date~ | ~uint64_t~ | out | Keep track of the date | | ~factor_ee_date~ | ~uint64_t~ | Jastrow factor: electron-electron part | |
| ~gl~ | ~double[walk_num][4][elec_num]~ | out | Gradient and Laplacian of the Jastrow factor | | ~factor_en~ | ~double[walk_num]~ | Jastrow factor: electron-nucleus part | |
| ~value_date~ | ~uint64_t~ | out | Keep track of the date | | ~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 #+NAME: jastrow_data
#+BEGIN_SRC python :results none :exports none #+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 compute. If it is the case, then the data is recomputed and the
current date is stored. current date is stored.
** Electron-electron component ** Electron-electron component
*** Asymptotic 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); //assert(fabs(ee_distance[elec_num*elec_num+1]-6.5517646321055665) < 1.e-12);
#+end_src #+end_src
** Electron-nucleus component ** Electron-nucleus component
*** Asymptotic component for *** Asymptotic component for
@ -6014,7 +6014,7 @@ assert(fabs(een_rescaled_e[0][2][1][5]-0.3424402276009091) < 1.e-12);
#+end_src #+end_src
*** Electron-electron rescaled distances derivatives in $J_\text{eeN}$ *** Electron-electron rescaled distances derivatives in $J_\text{eeN}$
~een_rescaled_e_deriv_e~ stores the table of the derivatives of the ~een_rescaled_e_deriv_e~ stores the table of the derivatives of the
rescaled distances between all pairs of electrons and raised to the rescaled distances between all pairs of electrons and raised to the
power $p$ defined by ~cord_num~. Here we take its derivatives 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 #+end_src
*** Temporary arrays for electron-electron-nucleus Jastrow $f_{een}$ *** Temporary arrays for electron-electron-nucleus Jastrow $f_{een}$
Prepare ~c_vector_full~ and ~lkpm_combined_index~ tables required for the Prepare ~c_vector_full~ and ~lkpm_combined_index~ tables required for the
calculation of the three-body jastrow ~factor_een~ and its derivative calculation of the three-body jastrow ~factor_een~ and its derivative
~factor_een_deriv_e~. ~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); 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); assert(fabs(dtmp_c[0][1][0][0][0][0] - 0.237440520852232) < 1e-12);
#+end_src #+end_src
*** Electron-electron-nucleus Jastrow $f_{een}$ *** Electron-electron-nucleus Jastrow $f_{een}$
Calculate the electron-electron-nuclear three-body jastrow component ~factor_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 #+end_src
** Total Jastrow ** Total Jastrow
*** Value *** Value
Value of the total Jastrow factor: $\exp(J)$ 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, rc = qmckl_compute_jastrow_champ_value_doc(context,
ctx->electron.walker.num, ctx->electron.walker.num,
ctx->jastrow_champ.factor_ee, ctx->jastrow_champ.factor_ee,
ctx->jastrow_champ.factor_en, ctx->jastrow_champ.factor_en,
ctx->jastrow_champ.factor_een, ctx->jastrow_champ.factor_een,
ctx->jastrow_champ.value); ctx->jastrow_champ.value);
ctx->jastrow_champ.factor_ee_date = ctx->date; ctx->jastrow_champ.value_date = ctx->date;
} }
return QMCKL_SUCCESS; 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(in) :: f_ee(walk_num), f_en(walk_num), f_een(walk_num)
double precision , intent(out) :: value(walk_num) double precision , intent(out) :: value(walk_num)
integer :: i integer*8 :: i
info = QMCKL_SUCCESS 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 function qmckl_compute_jastrow_champ_value_doc_f
#+end_src #+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none #+CALL: generate_private_c_header(table=qmckl_jastrow_champ_value_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_value")
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
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none #+RESULTS:
qmckl_exit_code qmckl_compute_jastrow_champ_value_doc ( #+begin_src c :tangle (eval h_private_func) :comments org
qmckl_exit_code qmckl_compute_jastrow_champ_value (
const qmckl_context context, const qmckl_context context,
const int64_t walk_num, const int64_t walk_num,
const double* factor_ee, const double* f_ee,
const double* factor_en, const double* f_en,
const double* factor_een, const double* f_een,
double* const value); double* const value );
#+end_src #+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none #+CALL: generate_private_c_header(table=qmckl_jastrow_champ_value_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_value_doc")
qmckl_exit_code 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_doc (
const qmckl_context context, const qmckl_context context,
const int64_t walk_num, const int64_t walk_num,
const double* factor_ee, const double* f_ee,
const double* factor_en, const double* f_en,
const double* factor_een, const double* f_een,
double* const value); double* const value );
#+end_src #+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 #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
inline qmckl_exit_code inline qmckl_exit_code
@ -9957,7 +9966,7 @@ qmckl_compute_jastrow_champ_value_hpc (
const double* factor_en, const double* factor_en,
const double* factor_een, const double* factor_een,
double* const value) double* const value)
{ {
if (context == QMCKL_NULL_CONTEXT) return QMCKL_INVALID_CONTEXT; if (context == QMCKL_NULL_CONTEXT) return QMCKL_INVALID_CONTEXT;
if (walk_num <= 0 ) return QMCKL_INVALID_ARG_2; 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) #+begin_src c :tangle (eval c_test)
printf("Total Jastrow value\n");
/* Check if Jastrow is properly initialized */ /* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context)); assert(qmckl_jastrow_champ_provided(context));
@ -10018,7 +10028,7 @@ assert(rc == QMCKL_SUCCESS);
double total_j[walk_num]; double total_j[walk_num];
rc = qmckl_check(context, 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); 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<elec_num; ++e) {
if (m < 3) { /* test only gradients */
assert (total_j_deriv[k][m][e]/total_j[k] - (factor_ee_deriv_e[k][m][e] + factor_en_deriv_e[k][m][e] + factor_een_deriv_e[k][m][e]) < 1.e-12);
}
}
}
}
#+end_src #+end_src
* End of files :noexport: * End of files :noexport: