diff --git a/.github/workflows/test-build.yml b/.github/workflows/test-build.yml index cbaeab1..2032472 100644 --- a/.github/workflows/test-build.yml +++ b/.github/workflows/test-build.yml @@ -23,6 +23,11 @@ jobs: make -j 8 make -j check make distcheck + - name: Archive test log file + uses: actions/upload-artifact@v2 + with: + name: test-suite.log + path: test-suite.log # x86_macos: # diff --git a/Makefile.am b/Makefile.am index aed1bcb..eada72e 100644 --- a/Makefile.am +++ b/Makefile.am @@ -57,7 +57,7 @@ test_qmckl_f = tests/qmckl_f.f90 test_qmckl_fo = tests/qmckl_f.o src_qmckl_f = src/qmckl_f.f90 src_qmckl_fo = src/qmckl_f.o -header_tests = tests/chbrclf.h +header_tests = tests/chbrclf.h tests/n2.h fortrandir = $(datadir)/$(PACKAGE_NAME)/fortran/ dist_fortran_DATA = $(qmckl_f) @@ -177,6 +177,7 @@ $(htmlize_el): tests/chbrclf.h: $(qmckl_h) +tests/n2.h: $(qmckl_h) generated.mk: $(ORG_FILES) $(PYTHON) $(srcdir)/tools/build_makefile.py diff --git a/configure.ac b/configure.ac index fc31af1..2f807f9 100644 --- a/configure.ac +++ b/configure.ac @@ -98,7 +98,6 @@ AC_CHECK_LIB([pthread], [pthread_create]) # CFLAGS="${CFLAGS} ${OPENMP_CFLAGS}" #fi - ## BLAS #AX_BLAS([], [AC_MSG_ERROR([BLAS was not found.])]) @@ -244,13 +243,13 @@ ${PACKAGE_NAME} Version ${PACKAGE_VERSION} ${QMCKL_DEVEL} Prefix: '${prefix}'. -CC..........: ${CC} -CPPFLAGS....: ${CPPFLAGS} -CFLAGS......: ${CFLAGS} -FC..........: ${FC} -FCLAGS......: ${FCFLAGS} -LDFLAGS:....: ${LDFLAGS} -LIBS........: ${LIBS} +CC..............: ${CC} +CPPFLAGS........: ${CPPFLAGS} +CFLAGS..........: ${CFLAGS} +FC..............: ${FC} +FCLAGS..........: ${FCFLAGS} +LDFLAGS:........: ${LDFLAGS} +LIBS............: ${LIBS} Package features: ${ARGS} diff --git a/org/qmckl_ao.org b/org/qmckl_ao.org index 5d201a6..ee12d98 100644 --- a/org/qmckl_ao.org +++ b/org/qmckl_ao.org @@ -59,6 +59,7 @@ gradients and Laplacian of the atomic basis functions. #include #include #include "chbrclf.h" +#include "qmckl_ao_private_func.h" int main() { @@ -98,33 +99,43 @@ int main() { The following arrays are stored in the context: - |--------------------+---------------+----------------------------------------------------------------------| - | ~type~ | | Gaussian (~'G'~) or Slater (~'S'~) | - | ~shell_num~ | | Number of shells | - | ~prim_num~ | | Total number of primitives | - | ~nucleus_index~ | ~[nucl_num]~ | Index of the first shell of each nucleus | - | ~shell_ang_mom~ | ~[shell_num]~ | Angular momentum of each shell | - | ~shell_prim_num~ | ~[shell_num]~ | Number of primitives in each shell | - | ~shell_prim_index~ | ~[shell_num]~ | Address of the first primitive of each shell in the ~EXPONENT~ array | - | ~shell_factor~ | ~[shell_num]~ | Normalization factor for each shell | - | ~exponent~ | ~[prim_num]~ | Array of exponents | - | ~coefficient~ | ~[prim_num]~ | Array of coefficients | - | ~prim_factor~ | ~[prim_num]~ | Normalization factors of the primtives | + |---------------------+---------------+----------------------------------------------------------------------| + | ~type~ | | Gaussian (~'G'~) or Slater (~'S'~) | + | ~shell_num~ | | Number of shells | + | ~prim_num~ | | Total number of primitives | + | ~nucleus_index~ | ~[nucl_num]~ | Index of the first shell of each nucleus | + | ~nucleus_shell_num~ | ~[nucl_num]~ | Number of shells per nucleus | + | ~shell_ang_mom~ | ~[shell_num]~ | Angular momentum of each shell | + | ~shell_prim_num~ | ~[shell_num]~ | Number of primitives in each shell | + | ~shell_prim_index~ | ~[shell_num]~ | Address of the first primitive of each shell in the ~EXPONENT~ array | + | ~shell_factor~ | ~[shell_num]~ | Normalization factor for each shell | + | ~exponent~ | ~[prim_num]~ | Array of exponents | + | ~coefficient~ | ~[prim_num]~ | Array of coefficients | + | ~prim_factor~ | ~[prim_num]~ | Normalization factors of the primtives | + | ~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 | Computed data: - |----------------------+-------------------------------------+-----------------------------------------------------------------------------------------------| - | ~nucleus_prim_index~ | ~[nucl_num]~ | Index of the first primitive for each nucleus | - | ~primitive_vgl~ | ~[prim_num][5][walk_num][elec_num]~ | Value, gradients, Laplacian of the primitives at electron positions | - | ~primitive_vgl_date~ | ~uint64_t~ | Late modification date of Value, gradients, Laplacian of the primitives at electron positions | - | ~shell_vgl~ | ~[prim_num][5][walk_num][elec_num]~ | Value, gradients, Laplacian of the primitives at electron positions | - | ~shell_vgl_date~ | ~uint64_t~ | Late modification date of Value, gradients, Laplacian of the shells at electron positions | - |----------------------+-------------------------------------+-----------------------------------------------------------------------------------------------| - | ~nucl_shell_index~ | ~[nucl_num]~ | Index of the first shell for each nucleus | - | ~exponent_sorted~ | ~[prim_num]~ | Array of exponents for sorted primitives | - | ~coeff_norm_sorted~ | ~[prim_num]~ | Array of normalized coefficients for sorted primitives | - | ~prim_factor_sorted~ | ~[prim_num]~ | Normalization factors of the sorted primtives | - | ~nuclear_radius~ | ~[nucl_num]~ | Distance beyond which all the AOs are zero | + |--------------------------+--------------------------------------+-----------------------------------------------------------------------------------------------| + | ~coefficient_normalized~ | ~[prim_num]~ | Normalized primitive coefficients | + | ~nucleus_prim_index~ | ~[nucl_num]~ | Index of the first primitive for each nucleus | + | ~nucleus_max_ang_mom~ | ~[nucl_num]~ | Maximum angular momentum for each nucleus | + | ~nucleus_range~ | ~[nucl_num]~ | Distance beyond which all the AOs are zero | + |--------------------------+--------------------------------------+-----------------------------------------------------------------------------------------------| + | ~primitive_vgl~ | ~[5][walk_num][elec_num][prim_num]~ | Value, gradients, Laplacian of the primitives at electron positions | + | ~primitive_vgl_date~ | ~uint64_t~ | Late modification date of Value, gradients, Laplacian of the primitives at electron positions | + | ~shell_vgl~ | ~[5][walk_num][elec_num][shell_num]~ | Value, gradients, Laplacian of the primitives at electron positions | + | ~shell_vgl_date~ | ~uint64_t~ | Late modification date of Value, gradients, Laplacian of the AOs at electron positions | + | ~ao_vgl~ | ~[5][walk_num][elec_num][ao_num]~ | Value, gradients, Laplacian of the primitives at electron positions | + | ~ao_vgl_date~ | ~uint64_t~ | Late modification date of Value, gradients, Laplacian of the AOs at electron positions | + |--------------------------+--------------------------------------+-----------------------------------------------------------------------------------------------| + | ~nucl_shell_index~ | ~[nucl_num]~ | Index of the first shell for each nucleus | + | ~exponent_sorted~ | ~[prim_num]~ | Array of exponents for sorted primitives | + | ~coeff_norm_sorted~ | ~[prim_num]~ | Array of normalized coefficients for sorted primitives | + | ~prim_factor_sorted~ | ~[prim_num]~ | Normalization factors of the sorted primtives | For H_2 with the following basis set, @@ -154,6 +165,7 @@ D 1 type = 'G' shell_num = 12 prim_num = 20 +ao_num = 38 nucleus_index = [0 , 6] shell_ang_mom = [0, 0, 0, 1, 1, 2, 0, 0, 0, 1, 1, 2] shell_factor = [ 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1.] @@ -178,24 +190,34 @@ prim_factor = [ 1.0006253235944540e+01, 2.4169531573445120e+00, 7.96109248497664 #+begin_src c :comments org :tangle (eval h_private_type) typedef struct qmckl_ao_basis_struct { - int32_t uninitialized; int64_t shell_num; int64_t prim_num; + int64_t ao_num; int64_t * nucleus_index; int64_t * nucleus_shell_num; int32_t * shell_ang_mom; int64_t * shell_prim_num; - int64_t * nucleus_prim_index; int64_t * shell_prim_index; double * shell_factor; - double * exponent ; - double * coefficient ; - double * prim_factor ; + double * exponent; + double * coefficient; + double * prim_factor; + double * ao_factor; + + int64_t * nucleus_prim_index; + double * coefficient_normalized; + int32_t * nucleus_max_ang_mom; + double * nucleus_range; double * primitive_vgl; int64_t primitive_vgl_date; double * shell_vgl; int64_t shell_vgl_date; + double * ao_vgl; + int64_t ao_vgl_date; + + int32_t uninitialized; bool provided; + bool ao_cartesian; char type; } qmckl_ao_basis_struct; #+end_src @@ -221,11 +243,10 @@ qmckl_exit_code qmckl_init_ao_basis(qmckl_context context) { qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); - ctx->ao_basis.uninitialized = (1 << 12) - 1; + ctx->ao_basis.uninitialized = (1 << 14) - 1; /* Default values */ - /* ctx->ao_basis. - ,*/ + ctx->ao_basis.ao_cartesian = true; return QMCKL_SUCCESS; } @@ -237,7 +258,9 @@ qmckl_exit_code qmckl_init_ao_basis(qmckl_context context) { char qmckl_get_ao_basis_type (const qmckl_context context); int64_t qmckl_get_ao_basis_shell_num (const qmckl_context context); int64_t qmckl_get_ao_basis_prim_num (const qmckl_context context); +int64_t qmckl_get_ao_basis_ao_num (const qmckl_context context); int64_t* qmckl_get_ao_basis_nucleus_index (const qmckl_context context); +int64_t* qmckl_get_ao_basis_nucleus_shell_num(const qmckl_context context); int32_t* qmckl_get_ao_basis_shell_ang_mom (const qmckl_context context); int64_t* qmckl_get_ao_basis_shell_prim_num (const qmckl_context context); int64_t* qmckl_get_ao_basis_shell_prim_index (const qmckl_context context); @@ -245,6 +268,7 @@ double* qmckl_get_ao_basis_shell_factor (const qmckl_context context); double* qmckl_get_ao_basis_exponent (const qmckl_context context); double* qmckl_get_ao_basis_coefficient (const qmckl_context context); double* qmckl_get_ao_basis_prim_factor (const qmckl_context context); +double* qmckl_get_ao_basis_ao_factor (const qmckl_context context); #+end_src When all the data for the AOs have been provided, the following @@ -491,6 +515,44 @@ double* qmckl_get_ao_basis_prim_factor (const qmckl_context context) { } +int64_t qmckl_get_ao_basis_ao_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 << 12; + + if ( (ctx->ao_basis.uninitialized & mask) != 0) { + return (int64_t) 0; + } + + assert (ctx->ao_basis.ao_num > (int64_t) 0); + return ctx->ao_basis.ao_num; +} + + +double* qmckl_get_ao_basis_ao_factor (const qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return NULL; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 13; + + if ( (ctx->ao_basis.uninitialized & mask) != 0) { + return NULL; + } + + assert (ctx->ao_basis.ao_factor != NULL); + return ctx->ao_basis.ao_factor; +} + + bool qmckl_ao_basis_provided(const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { @@ -502,6 +564,9 @@ bool qmckl_ao_basis_provided(const qmckl_context context) { return ctx->ao_basis.provided; } + + + #+end_src ** Initialization functions @@ -513,6 +578,7 @@ bool qmckl_ao_basis_provided(const qmckl_context context) { qmckl_exit_code qmckl_set_ao_basis_type (qmckl_context context, const char t); qmckl_exit_code qmckl_set_ao_basis_shell_num (qmckl_context context, const int64_t shell_num); qmckl_exit_code qmckl_set_ao_basis_prim_num (qmckl_context context, const int64_t prim_num); +qmckl_exit_code qmckl_set_ao_basis_ao_num (qmckl_context context, const int64_t ao_num); qmckl_exit_code qmckl_set_ao_basis_nucleus_index (qmckl_context context, const int64_t * nucleus_index); qmckl_exit_code qmckl_set_ao_basis_nucleus_shell_num(qmckl_context context, const int64_t * nucleus_shell_num); qmckl_exit_code qmckl_set_ao_basis_shell_ang_mom (qmckl_context context, const int32_t * shell_ang_mom); @@ -522,6 +588,8 @@ qmckl_exit_code qmckl_set_ao_basis_shell_factor (qmckl_context context, con qmckl_exit_code qmckl_set_ao_basis_exponent (qmckl_context context, const double * exponent); qmckl_exit_code qmckl_set_ao_basis_coefficient (qmckl_context context, const double * coefficient); qmckl_exit_code qmckl_set_ao_basis_prim_factor (qmckl_context context, const double * prim_factor); +qmckl_exit_code qmckl_set_ao_basis_ao_factor (qmckl_context context, const double * ao_factor); +qmckl_exit_code qmckl_set_ao_basis_cartesian (qmckl_context context, const bool cartesian); #+end_src #+NAME:pre2 @@ -720,7 +788,7 @@ qmckl_exit_code qmckl_set_ao_basis_shell_ang_mom(qmckl_context context, const i qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = shell_num * sizeof(char); + mem_info.size = shell_num * sizeof(int32_t); int32_t * new_array = (int32_t*) qmckl_malloc(context, mem_info); if (new_array == NULL) { @@ -942,6 +1010,7 @@ qmckl_exit_code qmckl_set_ao_basis_coefficient(qmckl_context context, const dou <> } + qmckl_exit_code qmckl_set_ao_basis_prim_factor(qmckl_context context, const double* prim_factor) { <> @@ -983,6 +1052,83 @@ qmckl_exit_code qmckl_set_ao_basis_prim_factor(qmckl_context context, const dou <> } + +qmckl_exit_code qmckl_set_ao_basis_ao_num(qmckl_context context, const int64_t ao_num) { + <> + + if (ao_num <= 0) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_ao_basis_shell_num", + "ao_num must be positive"); + } + + int64_t shell_num = qmckl_get_ao_basis_shell_num(context); + + if (ao_num < shell_num) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_ao_basis_shell_num", + "ao_num < shell_num"); + } + + int32_t mask = 1 << 12; + ctx->ao_basis.ao_num = ao_num; + + <> +} + + +qmckl_exit_code qmckl_set_ao_basis_ao_factor(qmckl_context context, const double* ao_factor) { + <> + + int32_t mask = 1 << 13; + + const int64_t ao_num = qmckl_get_ao_basis_ao_num(context); + if (ao_num == 0L) { + return qmckl_failwith( context, + QMCKL_FAILURE, + "qmckl_set_ao_basis_ao_factor", + "ao_num is not set"); + } + + + if (ctx->ao_basis.ao_factor != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.ao_factor); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_set_ao_basis_ao_factor", + NULL); + } + } + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ao_num * sizeof(double); + double* new_array = (double*) qmckl_malloc(context, mem_info); + + if (new_array == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_set_ao_basis_ao_factor", + NULL); + } + + memcpy(new_array, ao_factor, mem_info.size); + + ctx->ao_basis.ao_factor = new_array; + + <> +} + + +qmckl_exit_code qmckl_set_ao_basis_cartesian(qmckl_context context, const bool t) { + <> + + int32_t mask = 1; + ctx->ao_basis.ao_cartesian = t; + + <> +} #+end_src When the basis set is completely entered, other data structures are @@ -1014,26 +1160,113 @@ qmckl_exit_code qmckl_finalize_basis(qmckl_context context) { if (rc != QMCKL_SUCCESS) return rc; /* nucleus_prim_index */ - qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = (ctx->nucleus.num + (int64_t) 1) * sizeof(int64_t); + { + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = (ctx->nucleus.num + (int64_t) 1) * sizeof(int64_t); - ctx->ao_basis.nucleus_prim_index = (int64_t*) qmckl_malloc(context, mem_info); + ctx->ao_basis.nucleus_prim_index = (int64_t*) qmckl_malloc(context, mem_info); - if (ctx->ao_basis.nucleus_prim_index == NULL) { - return qmckl_failwith( context, - QMCKL_ALLOCATION_FAILED, - "qmckl_nucleus_prim_index", - NULL); + if (ctx->ao_basis.nucleus_prim_index == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "ao_basis.nucleus_prim_index", + NULL); + } + + for (int64_t i=0 ; iao_basis.nucleus_index[i]; + ctx->ao_basis.nucleus_prim_index[i] = ctx->ao_basis.shell_prim_index[shell_idx]; + } + ctx->ao_basis.nucleus_prim_index[nucl_num] = ctx->ao_basis.prim_num; } - for (int64_t i=0 ; iao_basis.nucleus_index[i]; - ctx->ao_basis.nucleus_prim_index[i] = ctx->ao_basis.shell_prim_index[shell_idx]; + + /* Normalize coefficients */ + { + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->ao_basis.prim_num * sizeof(double); + + ctx->ao_basis.coefficient_normalized = (double *) qmckl_malloc(context, mem_info); + + if (ctx->ao_basis.coefficient_normalized == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "ao_basis.coefficient_normalized", + NULL); + } + + for (int64_t ishell=0 ; ishell < ctx->ao_basis.shell_num ; ++ishell) { + for (int64_t iprim=ctx->ao_basis.shell_prim_index[ishell] ; + iprim < ctx->ao_basis.shell_prim_index[ishell]+ctx->ao_basis.shell_prim_num[ishell] ; + ++iprim) { + ctx->ao_basis.coefficient_normalized[iprim] = + ctx->ao_basis.coefficient[iprim] * ctx->ao_basis.prim_factor[iprim] * + ctx->ao_basis.shell_factor[ishell]; + } + } } - ctx->ao_basis.nucleus_prim_index[nucl_num] = ctx->ao_basis.prim_num; - /* TODO : sort the basis set here */ + /* Find max angular momentum on each nucleus */ + { + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->nucleus.num * sizeof(int32_t); + + ctx->ao_basis.nucleus_max_ang_mom = (int32_t *) qmckl_malloc(context, mem_info); + + if (ctx->ao_basis.nucleus_max_ang_mom == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "ao_basis.nucleus_max_ang_mom", + NULL); + } + + for (int64_t inucl=0 ; inucl < nucl_num ; ++inucl) { + ctx->ao_basis.nucleus_max_ang_mom[inucl] = 0; + for (int64_t ishell=ctx->ao_basis.nucleus_index[inucl] ; + ishell < ctx->ao_basis.nucleus_index[inucl] + ctx->ao_basis.nucleus_shell_num[inucl] ; + ++ishell) { + ctx->ao_basis.nucleus_max_ang_mom[inucl] = + ctx->ao_basis.nucleus_max_ang_mom[inucl] > ctx->ao_basis.shell_ang_mom[ishell] ? + ctx->ao_basis.nucleus_max_ang_mom[inucl] : ctx->ao_basis.shell_ang_mom[ishell] ; + } + } + } + + /* Find distance beyond which all AOs are zero. + The distance is obtained by sqrt(log(cutoff)*range) */ + { + if (ctx->ao_basis.type == 'G') { + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->nucleus.num * sizeof(double); + + ctx->ao_basis.nucleus_range = (double *) qmckl_malloc(context, mem_info); + + if (ctx->ao_basis.nucleus_range == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "ao_basis.nucleus_range", + NULL); + } + + for (int64_t inucl=0 ; inucl < ctx->nucleus.num ; ++inucl) { + ctx->ao_basis.nucleus_range[inucl] = 0.; + for (int64_t ishell=ctx->ao_basis.nucleus_index[inucl] ; + ishell < ctx->ao_basis.nucleus_index[inucl] + ctx->ao_basis.nucleus_shell_num[inucl] ; + ++ishell) { + for (int64_t iprim=ctx->ao_basis.shell_prim_index[ishell] ; + iprim < ctx->ao_basis.shell_prim_index[ishell] + ctx->ao_basis.shell_prim_num[ishell] ; + ++iprim) { + double range = 1./ctx->ao_basis.exponent[iprim]; + ctx->ao_basis.nucleus_range[inucl] = + ctx->ao_basis.nucleus_range[inucl] > range ? + ctx->ao_basis.nucleus_range[inucl] : range; + } + } + } + } + } + /* TODO : sort the basis set here */ return QMCKL_SUCCESS; } #+end_src @@ -1160,6 +1393,36 @@ interface integer (c_int64_t) , intent(in) , value :: context real (c_double) , intent(in) :: prim_factor(*) end function +end interface +interface + integer(c_int32_t) function qmckl_set_ao_basis_ao_num(context, num) & + 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 :: num + end function +end interface +interface + integer(c_int32_t) function qmckl_set_ao_basis_ao_factor(context,ao_factor) & + bind(C) + use, intrinsic :: iso_c_binding + import + implicit none + integer (c_int64_t) , intent(in) , value :: context + real (c_double) , intent(in) :: ao_factor(*) + end function +end interface +interface + integer(c_int32_t) function qmckl_set_ao_basis_cartesian(context,cartesian) & + bind(C) + use, intrinsic :: iso_c_binding + import + implicit none + integer (c_int64_t) , intent(in) , value :: context + logical (c_bool) , intent(in) , value :: cartesian + end function end interface #+end_src @@ -1183,8 +1446,9 @@ assert(rc == QMCKL_SUCCESS); assert(qmckl_nucleus_provided(context)); -const int64_t shell_num = chbrclf_shell_num; -const int64_t prim_num = chbrclf_prim_num; +const int64_t shell_num = chbrclf_shell_num; +const int64_t prim_num = chbrclf_prim_num; +const int64_t ao_num = chbrclf_ao_num; 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]); @@ -1194,8 +1458,9 @@ 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]); -char typ = 'G'; +const char typ = 'G'; assert(!qmckl_ao_basis_provided(context)); @@ -1245,11 +1510,98 @@ 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, 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)); +int64_t shell_num_test ; +int64_t prim_num_test ; +int64_t ao_num_test ; +int64_t * nucleus_index_test ; +int64_t * nucleus_shell_num_test; +int32_t * shell_ang_mom_test ; +int64_t * shell_prim_num_test ; +int64_t * shell_prim_index_test ; +double * shell_factor_test ; +double * exponent_test ; +double * coefficient_test ; +double * prim_factor_test ; +double * ao_factor_test ; +char typ_test ; + + +typ_test = qmckl_get_ao_basis_type (context); +assert(typ == typ_test); + +shell_num_test = qmckl_get_ao_basis_shell_num (context); +assert(shell_num == shell_num_test); + +prim_num_test = qmckl_get_ao_basis_prim_num (context); +assert(prim_num == prim_num_test); + +nucleus_index_test = qmckl_get_ao_basis_nucleus_index (context); +for (int64_t i=0 ; i < nucl_num ; ++i) { + assert(nucleus_index_test[i] == nucleus_index[i]); + } + +nucleus_shell_num_test = qmckl_get_ao_basis_nucleus_shell_num (context); +for (int64_t i=0 ; i < nucl_num ; ++i) { + assert(nucleus_shell_num_test[i] == nucleus_shell_num[i]); + } + +shell_ang_mom_test = qmckl_get_ao_basis_shell_ang_mom (context); +for (int64_t i=0 ; i < shell_num ; ++i) { + assert(shell_ang_mom_test[i] == shell_ang_mom[i]); + } + +shell_factor_test = qmckl_get_ao_basis_shell_factor (context); +for (int64_t i=0 ; i < shell_num ; ++i) { + assert(shell_factor_test[i] == shell_factor[i]); +} + +shell_prim_num_test = qmckl_get_ao_basis_shell_prim_num (context); +for (int64_t i=0 ; i < shell_num ; ++i) { + assert(shell_prim_num_test[i] == shell_prim_num[i]); +} + +shell_prim_index_test = qmckl_get_ao_basis_shell_prim_index (context); +for (int64_t i=0 ; i < shell_num ; ++i) { + assert(shell_prim_index_test[i] == shell_prim_index[i]); +} + +exponent_test = qmckl_get_ao_basis_exponent(context); +for (int64_t i=0 ; i < prim_num ; ++i) { + assert(exponent_test[i] == exponent[i]); +} + +coefficient_test = qmckl_get_ao_basis_coefficient(context); +for (int64_t i=0 ; i < prim_num ; ++i) { + assert(coefficient_test[i] == coefficient[i]); +} + +prim_factor_test = qmckl_get_ao_basis_prim_factor (context); +for (int64_t i=0 ; i < prim_num ; ++i) { + assert(prim_factor_test[i] == prim_factor[i]); +} + +ao_num_test = qmckl_get_ao_basis_ao_num(context); +assert(ao_num == ao_num_test); + +ao_factor_test = qmckl_get_ao_basis_ao_factor (context); +for (int64_t i=0 ; i < ao_num ; ++i) { + assert(ao_factor_test[i] == ao_factor[i]); +} + #+end_src * Radial part + +** TODO Helper functions to accelerate calculations ** General functions for Gaussian basis functions ~qmckl_ao_gaussian_vgl~ computes the values, gradients and @@ -1487,7 +1839,7 @@ end function test_qmckl_ao_gaussian_vgl ** TODO General functions for Slater basis functions ** TODO General functions for Radial functions on a grid -** DONE Computation of primitives +** Computation of primitives *** Get @@ -1607,7 +1959,7 @@ qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context) | double | elec_coord[walk_num][3][elec_num] | in | Electron coordinates | | double | nucl_coord[3][elec_num] | in | Nuclear coordinates | | double | expo[prim_num] | in | Exponents of the primitives | - | double | primitive_vgl[prim_num][5][walk_num][elec_num] | out | Value, gradients and Laplacian of the primitives | + | double | primitive_vgl[5][walk_num][elec_num][prim_num] | out | Value, gradients and Laplacian of the primitives | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_ao_basis_primitive_gaussian_vgl_f(context, & @@ -1625,7 +1977,7 @@ integer function qmckl_compute_ao_basis_primitive_gaussian_vgl_f(context, & double precision , intent(in) :: elec_coord(elec_num,3,walk_num) double precision , intent(in) :: nucl_coord(nucl_num,3) double precision , intent(in) :: expo(prim_num) - double precision , intent(out) :: primitive_vgl(elec_num,walk_num,5,prim_num) + double precision , intent(out) :: primitive_vgl(prim_num,elec_num,walk_num,5) integer*8 :: inucl, iprim, iwalk, ielec double precision :: x, y, z, two_a, ar2, r2, v, cutoff @@ -1651,11 +2003,11 @@ integer function qmckl_compute_ao_basis_primitive_gaussian_vgl_f(context, & v = dexp(-ar2) two_a = -2.d0 * expo(iprim) * v - primitive_vgl(ielec, iwalk, 1, iprim) = v - primitive_vgl(ielec, iwalk, 2, iprim) = two_a * x - primitive_vgl(ielec, iwalk, 3, iprim) = two_a * y - primitive_vgl(ielec, iwalk, 4, iprim) = two_a * z - primitive_vgl(ielec, iwalk, 5, iprim) = two_a * (3.d0 - 2.d0*ar2) + primitive_vgl(iprim, ielec, iwalk, 1) = v + primitive_vgl(iprim, ielec, iwalk, 2) = two_a * x + primitive_vgl(iprim, ielec, iwalk, 3) = two_a * y + primitive_vgl(iprim, ielec, iwalk, 4) = two_a * z + primitive_vgl(iprim, ielec, iwalk, 5) = two_a * (3.d0 - 2.d0*ar2) end do end do @@ -1792,22 +2144,22 @@ assert(rc == QMCKL_SUCCESS); -double prim_vgl[prim_num][5][walk_num][elec_num]; +double prim_vgl[5][walk_num][elec_num][prim_num]; rc = qmckl_get_ao_basis_primitive_vgl(context, &(prim_vgl[0][0][0][0])); assert (rc == QMCKL_SUCCESS); -assert( fabs(prim_vgl[7][0][0][26] - ( 1.0501570432064878E-003)) < 1.e-14 ); -assert( fabs(prim_vgl[7][1][0][26] - (-7.5014974095310560E-004)) < 1.e-14 ); -assert( fabs(prim_vgl[7][2][0][26] - (-3.8250692897610380E-003)) < 1.e-14 ); -assert( fabs(prim_vgl[7][3][0][26] - ( 3.4950559194080275E-003)) < 1.e-14 ); -assert( fabs(prim_vgl[7][4][0][26] - ( 2.0392163767356572E-002)) < 1.e-14 ); +assert( fabs(prim_vgl[0][0][26][7] - ( 1.0501570432064878E-003)) < 1.e-14 ); +assert( fabs(prim_vgl[1][0][26][7] - (-7.5014974095310560E-004)) < 1.e-14 ); +assert( fabs(prim_vgl[2][0][26][7] - (-3.8250692897610380E-003)) < 1.e-14 ); +assert( fabs(prim_vgl[3][0][26][7] - ( 3.4950559194080275E-003)) < 1.e-14 ); +assert( fabs(prim_vgl[4][0][26][7] - ( 2.0392163767356572E-002)) < 1.e-14 ); -assert( fabs(prim_vgl[39][0][1][15] - ( 1.0825844173157661E-003)) < 1.e-14 ); -assert( fabs(prim_vgl[39][1][1][15] - ( 2.3774237611651531E-003)) < 1.e-14 ); -assert( fabs(prim_vgl[39][2][1][15] - ( 2.1423191526963063E-003)) < 1.e-14 ); -assert( fabs(prim_vgl[39][3][1][15] - ( 4.3312003523048492E-004)) < 1.e-14 ); -assert( fabs(prim_vgl[39][4][1][15] - ( 7.5174404780004771E-003)) < 1.e-14 ); +assert( fabs(prim_vgl[0][1][15][39] - ( 1.0825844173157661E-003)) < 1.e-14 ); +assert( fabs(prim_vgl[1][1][15][39] - ( 2.3774237611651531E-003)) < 1.e-14 ); +assert( fabs(prim_vgl[2][1][15][39] - ( 2.1423191526963063E-003)) < 1.e-14 ); +assert( fabs(prim_vgl[3][1][15][39] - ( 4.3312003523048492E-004)) < 1.e-14 ); +assert( fabs(prim_vgl[4][1][15][39] - ( 7.5174404780004771E-003)) < 1.e-14 ); } @@ -1915,6 +2267,13 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context) NULL); } + if(!(ctx->electron.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + /* Compute if necessary */ if (ctx->electron.coord_new_date > ctx->ao_basis.shell_vgl_date) { @@ -1922,7 +2281,7 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context) if (ctx->ao_basis.shell_vgl == NULL) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = ctx->ao_basis.prim_num * 5 * ctx->electron.num * + mem_info.size = ctx->ao_basis.shell_num * 5 * ctx->electron.num * ctx->electron.walk_num * sizeof(double); double* shell_vgl = (double*) qmckl_malloc(context, mem_info); @@ -1950,7 +2309,7 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context) ctx->electron.coord_new, ctx->nucleus.coord, ctx->ao_basis.exponent, - ctx->ao_basis.coefficient, + ctx->ao_basis.coefficient_normalized, ctx->ao_basis.shell_vgl); } else { return qmckl_failwith( context, @@ -1990,14 +2349,14 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context) | ~double~ | ~elec_coord[walk_num][3][elec_num]~ | in | Electron coordinates | | ~double~ | ~nucl_coord[3][elec_num]~ | in | Nuclear coordinates | | ~double~ | ~expo[prim_num]~ | in | Exponents of the primitives | - | ~double~ | ~coef[prim_num]~ | in | Coefficients of the primitives | - | ~double~ | ~shell_vgl[shell_num][5][walk_num][elec_num]~ | out | Value, gradients and Laplacian of the shells | + | ~double~ | ~coef_normalized[prim_num]~ | in | Coefficients of the primitives | + | ~double~ | ~shell_vgl[5][walk_num][elec_num][shell_num]~ | out | Value, gradients and Laplacian of the shells | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f(context, & prim_num, shell_num, elec_num, nucl_num, walk_num, & nucleus_shell_num, nucleus_index, shell_prim_index, shell_prim_num, & - elec_coord, nucl_coord, expo, coef, shell_vgl) & + elec_coord, nucl_coord, expo, coef_normalized, shell_vgl) & result(info) use qmckl implicit none @@ -2014,8 +2373,8 @@ integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f(context, & double precision , intent(in) :: elec_coord(elec_num,3,walk_num) double precision , intent(in) :: nucl_coord(nucl_num,3) double precision , intent(in) :: expo(prim_num) - double precision , intent(in) :: coef(prim_num) - double precision , intent(out) :: shell_vgl(elec_num,walk_num,5,shell_num) + double precision , intent(in) :: coef_normalized(prim_num) + double precision , intent(out) :: shell_vgl(shell_num,elec_num,walk_num,5) integer*8 :: inucl, iprim, iwalk, ielec, ishell double precision :: x, y, z, two_a, ar2, r2, v, cutoff @@ -2027,19 +2386,24 @@ integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f(context, & cutoff = -dlog(1.d-15) do inucl=1,nucl_num - do ishell=nucleus_index(inucl)+1, nucleus_index(inucl)+nucleus_shell_num(inucl) - ! C is zero-based, so shift bounds by one - do iwalk = 1, walk_num - do ielec = 1, elec_num + do iwalk = 1, walk_num + do ielec = 1, elec_num - shell_vgl(ielec, iwalk, 1:5, ishell) = 0.d0 + x = elec_coord(ielec,1,iwalk) - nucl_coord(inucl,1) + y = elec_coord(ielec,2,iwalk) - nucl_coord(inucl,2) + z = elec_coord(ielec,3,iwalk) - nucl_coord(inucl,3) - x = elec_coord(ielec,1,iwalk) - nucl_coord(inucl,1) - y = elec_coord(ielec,2,iwalk) - nucl_coord(inucl,2) - z = elec_coord(ielec,3,iwalk) - nucl_coord(inucl,3) + r2 = x*x + y*y + z*z - r2 = x*x + y*y + z*z + do ishell=nucleus_index(inucl)+1, nucleus_index(inucl)+nucleus_shell_num(inucl) + ! C is zero-based, so shift bounds by one + + shell_vgl(ishell, ielec, iwalk, 1) = 0.d0 + shell_vgl(ishell, ielec, iwalk, 2) = 0.d0 + shell_vgl(ishell, ielec, iwalk, 3) = 0.d0 + shell_vgl(ishell, ielec, iwalk, 4) = 0.d0 + shell_vgl(ishell, ielec, iwalk, 5) = 0.d0 do iprim = shell_prim_index(ishell)+1, shell_prim_index(ishell)+shell_prim_num(ishell) @@ -2048,23 +2412,23 @@ integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f(context, & cycle end if - v = coef(iprim) * dexp(-ar2) + v = coef_normalized(iprim) * dexp(-ar2) two_a = -2.d0 * expo(iprim) * v - shell_vgl(ielec, iwalk, 1, ishell) = & - shell_vgl(ielec, iwalk, 1, ishell) + v + shell_vgl(ishell, ielec, iwalk, 1) = & + shell_vgl(ishell, ielec, iwalk, 1) + v - shell_vgl(ielec, iwalk, 2, ishell) = & - shell_vgl(ielec, iwalk, 2, ishell) + two_a * x + shell_vgl(ishell, ielec, iwalk, 2) = & + shell_vgl(ishell, ielec, iwalk, 2) + two_a * x - shell_vgl(ielec, iwalk, 3, ishell) = & - shell_vgl(ielec, iwalk, 3, ishell) + two_a * y + shell_vgl(ishell, ielec, iwalk, 3) = & + shell_vgl(ishell, ielec, iwalk, 3) + two_a * y - shell_vgl(ielec, iwalk, 4, ishell) = & - shell_vgl(ielec, iwalk, 4, ishell) + two_a * z + shell_vgl(ishell, ielec, iwalk, 4) = & + shell_vgl(ishell, ielec, iwalk, 4) + two_a * z - shell_vgl(ielec, iwalk, 5, ishell) = & - shell_vgl(ielec, iwalk, 5, ishell) + two_a * (3.d0 - 2.d0*ar2) + shell_vgl(ishell, ielec, iwalk, 5) = & + shell_vgl(ishell, ielec, iwalk, 5) + two_a * (3.d0 - 2.d0*ar2) end do @@ -2077,24 +2441,26 @@ integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f(context, & end function qmckl_compute_ao_basis_shell_gaussian_vgl_f #+end_src +# #+CALL: generate_c_header(table=qmckl_ao_basis_shell_gaussian_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_basis_shell_gaussian_vgl")) - #+begin_src c :tangle (eval h_private_func) :comments org :exports none -qmckl_exit_code qmckl_compute_ao_basis_shell_gaussian_vgl( + #+RESULTS: + #+begin_src c :tangle (eval h_private_func) :comments org + qmckl_exit_code qmckl_compute_ao_basis_shell_gaussian_vgl ( const qmckl_context context, - const int64_t prim_num, - const int64_t shell_num, - const int64_t elec_num, - const int64_t nucl_num, - const int64_t walk_num, + const int64_t prim_num, + const int64_t shell_num, + const int64_t elec_num, + const int64_t nucl_num, + const int64_t walk_num, const int64_t* nucleus_shell_num, - const int64_t* shell_prim_index, const int64_t* nucleus_index, + const int64_t* shell_prim_index, const int64_t* shell_prim_num, - const double* elec_coord, - const double* nucl_coord, - const double* expo, - const double* coef, - double* const shell_vgl); + const double* elec_coord, + const double* nucl_coord, + const double* expo, + const double* coef_normalized, + double* const shell_vgl ); #+end_src #+CALL: generate_c_interface(table=qmckl_ao_basis_shell_gaussian_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_basis_shell_gaussian_vgl")) @@ -2115,7 +2481,7 @@ qmckl_exit_code qmckl_compute_ao_basis_shell_gaussian_vgl( elec_coord, & nucl_coord, & expo, & - coef, & + coef_normalized, & shell_vgl) & bind(C) result(info) @@ -2135,8 +2501,8 @@ qmckl_exit_code qmckl_compute_ao_basis_shell_gaussian_vgl( real (c_double ) , intent(in) :: elec_coord(elec_num,3,walk_num) real (c_double ) , intent(in) :: nucl_coord(elec_num,3) real (c_double ) , intent(in) :: expo(prim_num) - real (c_double ) , intent(in) :: coef(prim_num) - real (c_double ) , intent(out) :: shell_vgl(elec_num,walk_num,5,shell_num) + real (c_double ) , intent(in) :: coef_normalized(prim_num) + real (c_double ) , intent(out) :: shell_vgl(shell_num,elec_num,walk_num,5) integer(c_int32_t), external :: qmckl_compute_ao_basis_shell_gaussian_vgl_f info = qmckl_compute_ao_basis_shell_gaussian_vgl_f & @@ -2153,7 +2519,7 @@ qmckl_exit_code qmckl_compute_ao_basis_shell_gaussian_vgl( elec_coord, & nucl_coord, & expo, & - coef, & + coef_normalized, & shell_vgl) end function qmckl_compute_ao_basis_shell_gaussian_vgl @@ -2189,50 +2555,50 @@ nucl_2 = np.array( [ 1.168459237342663e+00, 1.125660720053393e+00, 2.83337031 #double prim_vgl[prim_num][5][walk_num][elec_num]; x = elec_26_w1 ; y = nucl_1 -a = [( 8.236000E+03, -1.130000E-04 ), - ( 1.235000E+03, -8.780000E-04 ), - ( 2.808000E+02, -4.540000E-03 ), - ( 7.927000E+01, -1.813300E-02 ), - ( 2.559000E+01, -5.576000E-02 ), - ( 8.997000E+00, -1.268950E-01 ), - ( 3.319000E+00, -1.703520E-01 ), - ( 9.059000E-01, 1.403820E-01 ), - ( 3.643000E-01, 5.986840E-01 ), - ( 1.285000E-01, 3.953890E-01 )] +a = [( 8.236000E+03, -1.130000E-04 * 6.1616545431994848e+02 ), + ( 1.235000E+03, -8.780000E-04 * 1.4847738511079908e+02 ), + ( 2.808000E+02, -4.540000E-03 * 4.8888635917437597e+01 ), + ( 7.927000E+01, -1.813300E-02 * 1.8933972232608955e+01 ), + ( 2.559000E+01, -5.576000E-02 * 8.1089160941724145e+00 ), + ( 8.997000E+00, -1.268950E-01 * 3.7024003863155635e+00 ), + ( 3.319000E+00, -1.703520E-01 * 1.7525302846177560e+00 ), + ( 9.059000E-01, 1.403820E-01 * 6.6179013183966806e-01 ), + ( 3.643000E-01, 5.986840E-01 * 3.3419848027174592e-01 ), + ( 1.285000E-01, 3.953890E-01 * 1.5296336817449557e-01 )] -print ( "[1][0][0][26] : %e"% f(a,x,y)) -print ( "[1][1][0][26] : %e"% df(a,x,y,1)) -print ( "[1][2][0][26] : %e"% df(a,x,y,2)) -print ( "[1][3][0][26] : %e"% df(a,x,y,3)) -print ( "[1][4][0][26] : %e"% lf(a,x,y)) +print ( "[1][0][0][26] : %25.15e"% f(a,x,y)) +print ( "[1][1][0][26] : %25.15e"% df(a,x,y,1)) +print ( "[1][2][0][26] : %25.15e"% df(a,x,y,2)) +print ( "[1][3][0][26] : %25.15e"% df(a,x,y,3)) +print ( "[1][4][0][26] : %25.15e"% lf(a,x,y)) x = elec_15_w2 ; y = nucl_2 -a = [(3.387000E+01, 6.068000E-03), - (5.095000E+00, 4.530800E-02), - (1.159000E+00, 2.028220E-01), - (3.258000E-01, 5.039030E-01), - (1.027000E-01, 3.834210E-01)] +a = [(3.387000E+01, 6.068000E-03 *1.0006253235944540e+01), + (5.095000E+00, 4.530800E-02 *2.4169531573445120e+00), + (1.159000E+00, 2.028220E-01 *7.9610924849766440e-01), + (3.258000E-01, 5.039030E-01 *3.0734305383061117e-01), + (1.027000E-01, 3.834210E-01 *1.2929684417481876e-01)] -print ( "[14][0][1][15] : %e"% f(a,x,y)) -print ( "[14][1][1][15] : %e"% df(a,x,y,1)) -print ( "[14][2][1][15] : %e"% df(a,x,y,2)) -print ( "[14][3][1][15] : %e"% df(a,x,y,3)) -print ( "[14][4][1][15] : %e"% lf(a,x,y)) +print ( "[0][1][15][14] : %25.15e"% f(a,x,y)) +print ( "[1][1][15][14] : %25.15e"% df(a,x,y,1)) +print ( "[2][1][15][14] : %25.15e"% df(a,x,y,2)) +print ( "[3][1][15][14] : %25.15e"% df(a,x,y,3)) +print ( "[4][1][15][14] : %25.15e"% lf(a,x,y)) #+end_src #+RESULTS: #+begin_example - [1][0][0][26] : 1.875569e-01 - [1][1][0][26] : -2.615250e-02 - [1][2][0][26] : -1.333535e-01 - [1][3][0][26] : 1.218483e-01 - [1][4][0][26] : 3.227973e-02 - [14][0][1][15] : 4.509748e-02 - [14][1][1][15] : 3.203918e-02 - [14][2][1][15] : 2.887081e-02 - [14][3][1][15] : 5.836910e-03 - [14][4][1][15] : 1.564721e-02 + [1][0][0][26] : 3.564393437193867e-02 + [1][1][0][26] : -6.030177988891605e-03 + [1][2][0][26] : -3.074832579871845e-02 + [1][3][0][26] : 2.809546963133958e-02 + [1][4][0][26] : 1.903338597841753e-02 + [0][1][15][14] : 5.928089771361000e-03 + [1][1][15][14] : 4.355862298893037e-03 + [2][1][15][14] : 3.925108924950765e-03 + [3][1][15][14] : 7.935527764416084e-04 + [4][1][15][14] : 2.697495005143935e-03 #+end_example *** Test @@ -2259,38 +2625,55 @@ rc = qmckl_set_electron_coord (context, 'N', elec_coord); assert(rc == QMCKL_SUCCESS); -double shell_vgl[shell_num][5][walk_num][elec_num]; +double shell_vgl[5][walk_num][elec_num][shell_num]; rc = qmckl_get_ao_basis_shell_vgl(context, &(shell_vgl[0][0][0][0])); assert (rc == QMCKL_SUCCESS); -printf(" shell_vgl[1][0][0][26] %25.15e\n", shell_vgl[1][0][0][26]); -printf(" shell_vgl[1][1][0][26] %25.15e\n", shell_vgl[1][1][0][26]); -printf(" shell_vgl[1][2][0][26] %25.15e\n", shell_vgl[1][2][0][26]); -printf(" shell_vgl[1][3][0][26] %25.15e\n", shell_vgl[1][3][0][26]); -printf(" shell_vgl[1][4][0][26] %25.15e\n", shell_vgl[1][4][0][26]); +printf(" shell_vgl[1][0][0][26] %25.15e\n", shell_vgl[0][0][26][1]); +printf(" shell_vgl[1][1][0][26] %25.15e\n", shell_vgl[1][0][26][1]); +printf(" shell_vgl[1][2][0][26] %25.15e\n", shell_vgl[2][0][26][1]); +printf(" shell_vgl[1][3][0][26] %25.15e\n", shell_vgl[3][0][26][1]); +printf(" shell_vgl[1][4][0][26] %25.15e\n", shell_vgl[4][0][26][1]); -printf(" shell_vgl[14][0][1][15] %25.15e\n", shell_vgl[14][0][1][15]); -printf(" shell_vgl[14][1][1][15] %25.15e\n", shell_vgl[14][1][1][15]); -printf(" shell_vgl[14][2][1][15] %25.15e\n", shell_vgl[14][2][1][15]); -printf(" shell_vgl[14][3][1][15] %25.15e\n", shell_vgl[14][3][1][15]); -printf(" shell_vgl[14][4][1][15] %25.15e\n", shell_vgl[14][4][1][15]); +printf(" shell_vgl[14][0][1][15] %25.15e\n", shell_vgl[0][1][15][14]); +printf(" shell_vgl[14][1][1][15] %25.15e\n", shell_vgl[1][1][15][14]); +printf(" shell_vgl[14][2][1][15] %25.15e\n", shell_vgl[2][1][15][14]); +printf(" shell_vgl[14][3][1][15] %25.15e\n", shell_vgl[3][1][15][14]); +printf(" shell_vgl[14][4][1][15] %25.15e\n", shell_vgl[4][1][15][14]); -assert( fabs(shell_vgl[1][0][0][26] - ( 1.875568658202993e-01)) < 1.e-14 ); -assert( fabs(shell_vgl[1][1][0][26] - ( -2.615250164814435e-02)) < 1.e-14 ); -assert( fabs(shell_vgl[1][2][0][26] - ( -1.333535498894419e-01)) < 1.e-14 ); -assert( fabs(shell_vgl[1][3][0][26] - ( 1.218482800201208e-01)) < 1.e-14 ); -assert( fabs(shell_vgl[1][4][0][26] - ( 3.197054084474042e-02)) < 1.e-14 ); +assert( fabs(shell_vgl[0][0][26][1] - ( 3.564393437193868e-02)) < 1.e-14 ); +assert( fabs(shell_vgl[1][0][26][1] - (-6.030177987072189e-03)) < 1.e-14 ); +assert( fabs(shell_vgl[2][0][26][1] - (-3.074832579537582e-02)) < 1.e-14 ); +assert( fabs(shell_vgl[3][0][26][1] - ( 2.809546963519935e-02)) < 1.e-14 ); +assert( fabs(shell_vgl[4][0][26][1] - ( 1.896046117183968e-02)) < 1.e-14 ); -assert( fabs(shell_vgl[14][0][1][15] - ( 4.509748459243634e-02)) < 1.e-14 ); -assert( fabs(shell_vgl[14][1][1][15] - ( 3.203917730584210e-02)) < 1.e-14 ); -assert( fabs(shell_vgl[14][2][1][15] - ( 2.887080725789477e-02)) < 1.e-14 ); -assert( fabs(shell_vgl[14][3][1][15] - ( 5.836910453297223e-03)) < 1.e-14 ); -assert( fabs(shell_vgl[14][4][1][15] - ( 1.572966698871693e-02)) < 1.e-14 ); +assert( fabs(shell_vgl[0][1][15][14] - ( 5.928089771361000e-03)) < 1.e-14 ); +assert( fabs(shell_vgl[1][1][15][14] - ( 4.355862296021654e-03)) < 1.e-14 ); +assert( fabs(shell_vgl[2][1][15][14] - ( 3.925108924923650e-03)) < 1.e-14 ); +assert( fabs(shell_vgl[3][1][15][14] - ( 7.935527784022099e-04)) < 1.e-14 ); +assert( fabs(shell_vgl[4][1][15][14] - ( 2.708246573703548e-03)) < 1.e-14 ); } + #+end_src * Polynomial part + + Going from the atomic basis set to AOs implies a systematic + construction of all the angular functions of each shell. We + consider two cases for the angular functions: the real-valued + spherical harmonics, and the polynomials in Cartesian coordinates. + In the case of spherical harmonics, the AOs are ordered in + increasing magnetic quantum number ($-l \le m \le l$), and in the + case of polynomials we choose the canonical ordering, i.e + + \begin{eqnarray} + p & : & p_x, p_y, p_z \nonumber \\ + d & : & d_{xx}, d_{xy}, d_{xz}, d_{yy}, d_{yz}, d_{zz} \nonumber \\ + f & : & f_{xxx}, f_{xxy}, f_{xxz}, f_{xyy}, f_{xyz}, f_{xzz}, f_{yyy}, f_{yyz}, f_{yzz}, f_{zzz} \nonumber \\ + {\rm etc.} \nonumber + \end{eqnarray} + ** General functions for Powers of $x-X_i$ :PROPERTIES: :Name: qmckl_ao_power @@ -2613,7 +2996,6 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, real*8 :: Y(3) integer :: lmax_array(3) real*8 :: pows(-2:lmax,3) - integer, external :: qmckl_ao_power_f double precision :: xy, yz, xz double precision :: da, db, dc, dd @@ -2906,6 +3288,508 @@ end function test_qmckl_ao_polynomial_vgl #+end_src * Combining radial and polynomial parts + +*** Get + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_ao_vgl(qmckl_context context, double* const ao_vgl); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_ao_vgl(qmckl_context context, double* const ao_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; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->ao_basis.ao_num * 5 * ctx->electron.num * ctx->electron.walk_num; + memcpy(ao_vgl, ctx->ao_basis.ao_vgl, sze * sizeof(double)); + + return QMCKL_SUCCESS; +} + #+end_src + + #+begin_src f90 :tangle (eval fh_func) :comments org :exports none + interface + integer(c_int32_t) function qmckl_get_ao_vgl (context, ao_vgl) & + bind(C) + use, intrinsic :: iso_c_binding + import + implicit none + + integer (c_int64_t) , intent(in) , value :: context + double precision, intent(out) :: ao_vgl(*) + end function + end interface + #+end_src + +*** Provide + + #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none +qmckl_exit_code qmckl_provide_ao_vgl(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_ao_vgl(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->ao_basis.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_ao_vgl", + NULL); + } + + if(!(ctx->electron.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + /* Compute if necessary */ + if (ctx->electron.coord_new_date > ctx->ao_basis.ao_vgl_date) { + + qmckl_exit_code rc; + + /* Provide required data */ + rc = qmckl_provide_ao_basis_shell_vgl(context); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, "qmckl_provide_ao_basis_shell_vgl", NULL); + } + + /* Allocate array */ + if (ctx->ao_basis.ao_vgl == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->ao_basis.ao_num * 5 * ctx->electron.num * + ctx->electron.walk_num * sizeof(double); + double* ao_vgl = (double*) qmckl_malloc(context, mem_info); + + if (ao_vgl == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_ao_basis_ao_vgl", + NULL); + } + ctx->ao_basis.ao_vgl = ao_vgl; + } + + rc = qmckl_compute_ao_vgl(context, + ctx->ao_basis.ao_num, + ctx->ao_basis.shell_num, + ctx->electron.num, + ctx->nucleus.num, + ctx->electron.walk_num, + ctx->electron.coord_new, + ctx->nucleus.coord, + ctx->ao_basis.nucleus_index, + ctx->ao_basis.nucleus_shell_num, + ctx->ao_basis.nucleus_range, + ctx->ao_basis.nucleus_max_ang_mom, + ctx->ao_basis.shell_ang_mom, + ctx->ao_basis.ao_factor, + ctx->ao_basis.shell_vgl, + ctx->ao_basis.ao_vgl); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->ao_basis.ao_vgl_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute + :PROPERTIES: + :Name: qmckl_compute_ao_vgl + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_ao_vgl_args + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~ao_num~ | in | Number of AOs | + | ~int64_t~ | ~shell_num~ | in | Number of shells | + | ~int64_t~ | ~elec_num~ | in | Number of electrons | + | ~int64_t~ | ~nucl_num~ | in | Number of nuclei | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~double~ | ~elec_coord[walk_num][3][elec_num]~ | in | Electron coordinates | + | ~double~ | ~nucl_coord[3][nucl_num]~ | in | Nuclear coordinates | + | ~int64_t~ | ~nucleus_index[nucl_num]~ | in | Index of the 1st shell of each nucleus | + | ~int64_t~ | ~nucleus_shell_num[nucl_num]~ | in | Number of shells per nucleus | + | ~double~ | ~nucleus_range[nucl_num]~ | in | Range beyond which all is zero | + | ~int32_t~ | ~nucleus_max_ang_mom[nucl_num]~ | in | Maximum angular momentum per nucleus | + | ~int32_t~ | ~shell_ang_mom[shell_num]~ | in | Angular momentum of each shell | + | ~double~ | ~ao_factor[ao_num]~ | in | Normalization factor of the AOs | + | ~double~ | ~shell_vgl[5][walk_num][elec_num][shell_num]~ | in | Value, gradients and Laplacian of the shells | + | ~double~ | ~ao_vgl[5][walk_num][elec_num][ao_num]~ | out | Value, gradients and Laplacian of the AOs | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_ao_vgl_f(context, & + ao_num, shell_num, elec_num, nucl_num, walk_num, & + elec_coord, nucl_coord, nucleus_index, nucleus_shell_num, & + nucleus_range, nucleus_max_ang_mom, shell_ang_mom, & + ao_factor, shell_vgl, ao_vgl) & + result(info) + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer*8 , intent(in) :: ao_num + integer*8 , intent(in) :: shell_num + integer*8 , intent(in) :: elec_num + integer*8 , intent(in) :: nucl_num + integer*8 , intent(in) :: walk_num + double precision , intent(in) :: elec_coord(elec_num,3,walk_num) + double precision , intent(in) :: nucl_coord(nucl_num,3) + integer*8 , intent(in) :: nucleus_index(nucl_num) + integer*8 , intent(in) :: nucleus_shell_num(nucl_num) + double precision , intent(in) :: nucleus_range(nucl_num) + integer , intent(in) :: nucleus_max_ang_mom(nucl_num) + integer , intent(in) :: shell_ang_mom(shell_num) + double precision , intent(in) :: ao_factor(ao_num) + double precision , intent(in) :: shell_vgl(shell_num,elec_num,walk_num,5) + double precision , intent(out) :: ao_vgl(ao_num,elec_num,walk_num,5) + + double precision :: e_coord(3), n_coord(3) + integer*8 :: n_poly + integer :: l, il, k + integer*8 :: ielec, inucl, ishell, iwalk + integer :: lstart(0:20) + double precision :: x, y, z, r2 + double precision :: cutoff + integer, external :: qmckl_ao_polynomial_vgl_f + + double precision, allocatable :: poly_vgl(:,:) + integer , allocatable :: powers(:,:) + + allocate(poly_vgl(5,ao_num), powers(3,ao_num)) + + ! Pre-computed data + do l=0,20 + lstart(l) = l*(l+1)*(l+2)/6 +1 + end do + + info = QMCKL_SUCCESS + + ! Don't compute polynomials when the radial part is zero. + ! TODO : Use numerical precision here + cutoff = -dlog(1.d-15) + + do iwalk = 1,walk_num + do ielec = 1, elec_num + e_coord(1) = elec_coord(ielec,1,iwalk) + e_coord(2) = elec_coord(ielec,2,iwalk) + e_coord(3) = elec_coord(ielec,3,iwalk) + k=1 + do inucl=1,nucl_num + n_coord(1) = nucl_coord(inucl,1) + n_coord(2) = nucl_coord(inucl,2) + n_coord(3) = nucl_coord(inucl,3) + + ! Test if the electron is in the range of the nucleus + x = e_coord(1) - n_coord(1) + y = e_coord(2) - n_coord(2) + z = e_coord(3) - n_coord(3) + + r2 = x*x + z*z + z*z + + if (r2 > cutoff*nucleus_range(inucl)) then + cycle + end if + + ! Compute polynomials + info = qmckl_ao_polynomial_vgl_f(context, e_coord, n_coord, & + nucleus_max_ang_mom(inucl), n_poly, powers, 3_8, & + poly_vgl, 5_8) + + ! Loop over shells + do ishell = nucleus_index(inucl)+1, nucleus_index(inucl)+nucleus_shell_num(inucl) + l = shell_ang_mom(ishell) + do il = lstart(l), lstart(l+1)-1 + ! Value + ao_vgl(k,ielec,iwalk,1) = & + poly_vgl(1,il) * shell_vgl(ishell,ielec,iwalk,1) * ao_factor(k) + + ! Grad_x + ao_vgl(k,ielec,iwalk,2) = ( & + poly_vgl(2,il) * shell_vgl(ishell,ielec,iwalk,1) + & + poly_vgl(1,il) * shell_vgl(ishell,ielec,iwalk,2) & + ) * ao_factor(k) + + ! Grad_y + ao_vgl(k,ielec,iwalk,3) = ( & + poly_vgl(3,il) * shell_vgl(ishell,ielec,iwalk,1) + & + poly_vgl(1,il) * shell_vgl(ishell,ielec,iwalk,3) & + ) * ao_factor(k) + + ! Grad_z + ao_vgl(k,ielec,iwalk,4) = ( & + poly_vgl(4,il) * shell_vgl(ishell,ielec,iwalk,1) + & + poly_vgl(1,il) * shell_vgl(ishell,ielec,iwalk,4) & + ) * ao_factor(k) + + ! Lapl_z + ao_vgl(k,ielec,iwalk,5) = ( & + poly_vgl(5,il) * shell_vgl(ishell,ielec,iwalk,1) + & + poly_vgl(1,il) * shell_vgl(ishell,ielec,iwalk,5) + & + 2.d0 * ( & + poly_vgl(2,il) * shell_vgl(ishell,ielec,iwalk,2) + & + poly_vgl(3,il) * shell_vgl(ishell,ielec,iwalk,3) + & + poly_vgl(4,il) * shell_vgl(ishell,ielec,iwalk,4) ) & + ) * ao_factor(k) + + k = k+1 + end do + end do + end do + end do + end do + + deallocate(poly_vgl, powers) +end function qmckl_compute_ao_vgl_f + #+end_src + +# #+CALL: generate_c_header(table=qmckl_ao_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_vgl")) + + #+RESULTS: + #+begin_src c :tangle (eval h_private_func) :comments org + qmckl_exit_code qmckl_compute_ao_vgl ( + const qmckl_context context, + const int64_t ao_num, + const int64_t shell_num, + const int64_t elec_num, + const int64_t nucl_num, + const int64_t walk_num, + const double* elec_coord, + const double* nucl_coord, + const int64_t* nucleus_index, + const int64_t* nucleus_shell_num, + const double* nucleus_range, + const int32_t* nucleus_max_ang_mom, + const int32_t* shell_ang_mom, + const double* ao_factor, + const double* shell_vgl, + double* const ao_vgl ); + #+end_src + + #+CALL: generate_c_interface(table=qmckl_ao_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_vgl")) + + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_compute_ao_vgl & + (context, & + ao_num, & + shell_num, & + elec_num, & + nucl_num, & + walk_num, & + elec_coord, & + nucl_coord, & + nucleus_index, & + nucleus_shell_num, & + nucleus_range, & + nucleus_max_ang_mom, & + shell_ang_mom, & + ao_factor, & + shell_vgl, & + ao_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 :: ao_num + integer (c_int64_t) , intent(in) , value :: shell_num + 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) :: elec_coord(elec_num,3,walk_num) + real (c_double ) , intent(in) :: nucl_coord(nucl_num,3) + integer (c_int64_t) , intent(in) :: nucleus_index(nucl_num) + integer (c_int64_t) , intent(in) :: nucleus_shell_num(nucl_num) + real (c_double ) , intent(in) :: nucleus_range(nucl_num) + integer (c_int32_t) , intent(in) :: nucleus_max_ang_mom(nucl_num) + integer (c_int32_t) , intent(in) :: shell_ang_mom(shell_num) + real (c_double ) , intent(in) :: ao_factor(ao_num) + real (c_double ) , intent(in) :: shell_vgl(shell_num,elec_num,walk_num,5) + real (c_double ) , intent(out) :: ao_vgl(ao_num,elec_num,walk_num,5) + + integer(c_int32_t), external :: qmckl_compute_ao_vgl_f + info = qmckl_compute_ao_vgl_f & + (context, & + ao_num, & + shell_num, & + elec_num, & + nucl_num, & + walk_num, & + elec_coord, & + nucl_coord, & + nucleus_index, & + nucleus_shell_num, & + nucleus_range, & + nucleus_max_ang_mom, & + shell_ang_mom, & + ao_factor, & + shell_vgl, & + ao_vgl) + + end function qmckl_compute_ao_vgl + #+end_src + + #+begin_src python :results output :exports none +import numpy as np + +def f(a,x,y): + return np.sum( [c * np.exp( -b*(np.linalg.norm(x-y))**2) for b,c in a] ) + +def df(a,x,y,n): + h0 = 1.e-6 + if n == 1: h = np.array([h0,0.,0.]) + elif n == 2: h = np.array([0.,h0,0.]) + elif n == 3: h = np.array([0.,0.,h0]) + return ( f(a,x+h,y) - f(a,x-h,y) ) / (2.*h0) + +def d2f(a,x,y,n): + h0 = 1.e-6 + if n == 1: h = np.array([h0,0.,0.]) + elif n == 2: h = np.array([0.,h0,0.]) + elif n == 3: h = np.array([0.,0.,h0]) + return ( f(a,x+h,y) - 2.*f(a,x,y) + f(a,x-h,y) ) / h0**2 + +def lf(a,x,y): + return d2f(a,x,y,1) + d2f(a,x,y,2) + d2f(a,x,y,3) + +elec_26_w1 = np.array( [ 1.49050402641, 2.90106987953, -1.05920815468 ] ) +elec_15_w2 = np.array( [ -2.20180344582,-1.9113150239, 2.2193744778600002 ] ) +nucl_1 = np.array( [ -2.302574592081335e+00, -3.542027060505035e-01, -5.334129934317614e-02] ) + +#double prim_vgl[prim_num][5][walk_num][elec_num]; +x = elec_26_w1 ; y = nucl_1 +a = [( 403.830000, 0.001473 * 5.9876577632594533e+04), + ( 121.170000, 0.012672 * 7.2836806319891484e+03), + ( 46.345000, 0.058045 * 1.3549226646722386e+03), + ( 19.721000, 0.170510 * 3.0376315094739988e+02), + ( 8.862400, 0.318596 * 7.4924579607137730e+01), + ( 3.996200, 0.384502 * 1.8590543353806009e+01), + ( 1.763600, 0.273774 * 4.4423176930919421e+00), + ( 0.706190, 0.074397 * 8.9541051939952665e-01)] + +print ( "[0][0][26][219] : %25.15e"%(f(a,x,y) * (x[0] - y[0])**2) ) +print ( "[1][0][26][219] : %25.15e"%(df(a,x,y,1)* (x[0] - y[0]) * (x[1] - y[1]) + 2.*f(a,x,y) * (x[0] - y[0])) ) + +print ( "[0][0][26][220] : %25.15e"%(f(a,x,y) * (x[0] - y[0]) * (x[1] - y[1])) ) +print ( "[1][0][26][220] : %25.15e"%(df(a,x,y,1)* (x[0] - y[0]) * (x[1] - y[1]) + f(a,x,y) * (x[1] - y[1])) ) + +print ( "[0][0][26][221] : %25.15e"%(f(a,x,y) * (x[0] - y[0]) * (x[2] - y[2])) ) +print ( "[1][0][26][221] : %25.15e"%(df(a,x,y,1)* (x[0] - y[0]) * (x[2] - y[2]) + f(a,x,y) * (x[2] - y[2])) ) + +print ( "[0][0][26][222] : %25.15e"%(f(a,x,y) * (x[1] - y[1]) * (x[1] - y[1])) ) +print ( "[1][0][26][222] : %25.15e"%(df(a,x,y,1)* (x[1] - y[1]) * (x[1] - y[1])) ) + +print ( "[0][0][26][223] : %25.15e"%(f(a,x,y) * (x[1] - y[1]) * (x[2] - y[2])) ) +print ( "[1][0][26][223] : %25.15e"%(df(a,x,y,1)* (x[1] - y[1]) * (x[2] - y[2])) ) + +print ( "[0][0][26][224] : %25.15e"%(f(a,x,y) * (x[2] - y[2]) * (x[2] - y[2])) ) +print ( "[1][0][26][224] : %25.15e"%(df(a,x,y,1)* (x[2] - y[2]) * (x[2] - y[2])) ) + + #+end_src + + #+RESULTS: + #+begin_example + [0][0][26][219] : 1.020302912653649e-08 + [1][0][26][219] : -4.153046808203204e-08 + [0][0][26][220] : 8.756380857379661e-09 + [1][0][26][220] : -4.460176677299534e-08 + [0][0][26][221] : -2.705688401075445e-09 + [1][0][26][221] : 1.378177639720419e-08 + [0][0][26][222] : 7.514847283937212e-09 + [1][0][26][222] : -4.025905373647693e-08 + [0][0][26][223] : -2.322059246071533e-09 + [1][0][26][223] : 1.243989457599443e-08 + [0][0][26][224] : 7.175074806631758e-10 + [1][0][26][224] : -3.843880138733679e-09 + #+end_example + +*** 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]); + +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); + + +double ao_vgl[5][walk_num][elec_num][ao_num]; + +rc = qmckl_get_ao_vgl(context, &(ao_vgl[0][0][0][0])); +assert (rc == QMCKL_SUCCESS); + +printf("\n"); +printf(" ao_vgl ao_vgl[0][0][26][219] %25.15e\n", ao_vgl[0][0][26][219]); +printf(" ao_vgl ao_vgl[1][0][26][219] %25.15e\n", ao_vgl[1][0][26][219]); +printf(" ao_vgl ao_vgl[0][0][26][220] %25.15e\n", ao_vgl[0][0][26][220]); +printf(" ao_vgl ao_vgl[1][0][26][220] %25.15e\n", ao_vgl[1][0][26][220]); +printf(" ao_vgl ao_vgl[0][0][26][221] %25.15e\n", ao_vgl[0][0][26][221]); +printf(" ao_vgl ao_vgl[1][0][26][221] %25.15e\n", ao_vgl[1][0][26][221]); +printf(" ao_vgl ao_vgl[0][0][26][222] %25.15e\n", ao_vgl[0][0][26][222]); +printf(" ao_vgl ao_vgl[1][0][26][222] %25.15e\n", ao_vgl[1][0][26][222]); +printf(" ao_vgl ao_vgl[0][0][26][223] %25.15e\n", ao_vgl[0][0][26][223]); +printf(" ao_vgl ao_vgl[1][0][26][223] %25.15e\n", ao_vgl[1][0][26][223]); +printf(" ao_vgl ao_vgl[0][0][26][224] %25.15e\n", ao_vgl[0][0][26][224]); +printf(" ao_vgl ao_vgl[1][0][26][224] %25.15e\n", ao_vgl[1][0][26][224]); +printf("\n"); + +assert( fabs(ao_vgl[0][0][26][219] - ( 1.020298798341620e-08)) < 1.e-14 ); +assert( fabs(ao_vgl[1][0][26][219] - ( -4.928035238010602e-08)) < 1.e-14 ); +assert( fabs(ao_vgl[0][0][26][220] - ( 8.756345547784206e-09)) < 1.e-14 ); +assert( fabs(ao_vgl[1][0][26][220] - ( -4.460158690983819e-08)) < 1.e-14 ); +assert( fabs(ao_vgl[0][0][26][221] - ( -2.705677490544664e-09)) < 1.e-14 ); +assert( fabs(ao_vgl[1][0][26][221] - ( 1.378172082017231e-08)) < 1.e-14 ); +assert( fabs(ao_vgl[0][0][26][222] - ( 7.514816980753531e-09)) < 1.e-14 ); +assert( fabs(ao_vgl[1][0][26][222] - ( -4.025889138635182e-08)) < 1.e-14 ); +assert( fabs(ao_vgl[0][0][26][223] - ( -2.322049882502961e-09)) < 1.e-14 ); +assert( fabs(ao_vgl[1][0][26][223] - ( 1.243984441042288e-08)) < 1.e-14 ); +assert( fabs(ao_vgl[0][0][26][224] - ( 7.175045873560788e-10)) < 1.e-14 ); +assert( fabs(ao_vgl[1][0][26][224] - ( -3.843864637762753e-09)) < 1.e-14 ); +} + + #+end_src + * End of files :noexport: #+begin_src c :tangle (eval h_private_type) diff --git a/org/qmckl_context.org b/org/qmckl_context.org index 11eb235..d2ca467 100644 --- a/org/qmckl_context.org +++ b/org/qmckl_context.org @@ -31,6 +31,7 @@ int main() { #include "qmckl_nucleus_private_type.h" #include "qmckl_electron_private_type.h" #include "qmckl_ao_private_type.h" +#include "qmckl_jastrow_private_type.h" #include "qmckl_nucleus_private_func.h" #include "qmckl_electron_private_func.h" #include "qmckl_ao_private_func.h" @@ -118,6 +119,7 @@ typedef struct qmckl_context_struct { qmckl_nucleus_struct nucleus; qmckl_electron_struct electron; qmckl_ao_basis_struct ao_basis; + qmckl_jastrow_struct jastrow; /* To be implemented: qmckl_mo_struct mo; diff --git a/org/qmckl_distance.org b/org/qmckl_distance.org index 1ea822f..1af78f6 100644 --- a/org/qmckl_distance.org +++ b/org/qmckl_distance.org @@ -1004,7 +1004,7 @@ integer function qmckl_distance_rescaled_f(context, transa, transb, m, n, & if (transb == 'N' .or. transb == 'n') then continue - else if (transa == 'T' .or. transa == 't') then + else if (transb == 'T' .or. transb == 't') then transab = transab + 2 else transab = -100 diff --git a/org/qmckl_electron.org b/org/qmckl_electron.org index b4b6624..945a214 100644 --- a/org/qmckl_electron.org +++ b/org/qmckl_electron.org @@ -63,30 +63,29 @@ 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][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 | + | ~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 | ** Data structure @@ -860,6 +859,20 @@ for (int64_t i=0 ; i<3*elec_num ; ++i) { qmckl_exit_code qmckl_get_electron_ee_distance(qmckl_context context, double* const distance); #+end_src + #+begin_src f90 :tangle (eval fh_func) :comments org :exports none +interface + integer(c_int32_t) function qmckl_get_electron_ee_distance(context, distance) & + bind(C) + use, intrinsic :: iso_c_binding + import + implicit none + integer (c_int64_t) , intent(in) , value :: context + real (c_double ) , intent(out) :: distance(*) + end function +end interface + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_get_electron_ee_distance(qmckl_context context, double* const distance) { @@ -1552,7 +1565,6 @@ rc = qmckl_get_electron_ee_distance_rescaled_deriv_e(context, ee_distance_rescal #+end_src - ** Electron-nucleus distances *** Get @@ -1561,6 +1573,19 @@ rc = qmckl_get_electron_ee_distance_rescaled_deriv_e(context, ee_distance_rescal qmckl_exit_code qmckl_get_electron_en_distance(qmckl_context context, double* distance); #+end_src + #+begin_src f90 :tangle (eval fh_func) :comments org :exports none +interface + integer(c_int32_t) function qmckl_get_electron_en_distance(context, distance) & + bind(C) + use, intrinsic :: iso_c_binding + import + implicit none + integer (c_int64_t) , intent(in) , value :: context + real (c_double ) , intent(out) :: distance(*) + end function +end interface + #+end_src + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_get_electron_en_distance(qmckl_context context, double* distance) { @@ -2113,12 +2138,12 @@ assert(fabs(en_distance_rescaled[1][0][1] - 0.9584331688679852) < 1.e-12); The rescaled distances which is given as $R = (1 - \exp{-\kappa r})/\kappa$ needs to be perturbed with respect to the nuclear coordinates. This data is stored in the ~en_distance_rescaled_deriv_e~ tensor. The - The first three elements of this three index tensor ~[4][num][num]~ gives the + The first three elements of this three index tensor ~[4][nucl_num][elec_num]~ gives the derivatives in the x, y, and z directions $dx, dy, dz$ and the last index gives the Laplacian $\partial x^2 + \partial y^2 + \partial z^2$. *** Get - + #+begin_src c :comments org :tangle (eval h_func) :noweb yes qmckl_exit_code qmckl_get_electron_en_distance_rescaled_deriv_e(qmckl_context context, double* distance_rescaled_deriv_e); #+end_src diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org new file mode 100644 index 0000000..27aab31 --- /dev/null +++ b/org/qmckl_jastrow.org @@ -0,0 +1,5508 @@ +#+TITLE: Jastrow Factor +#+SETUPFILE: ../tools/theme.setup +#+INCLUDE: ../tools/lib.org + +Functions for the calculation of the Jastrow factor \(f_{ee}, f_{en}, f_{een}\). +These are stored in the ~factor_ee~, ~factor_en~, and ~factor_een~ variables. +The ~jastrow~ structure contains all the information required to build +these factors along with their derivatives. + +* 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_JASTROW_HPT +#define QMCKL_JASTROW_HPT +#include + #+end_src + + #+begin_src c :tangle (eval c_test) :noweb yes +#include "qmckl.h" +#include +#include +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include +#include "n2.h" + +int main() { + qmckl_context context; + context = qmckl_context_create(); + #+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 + +#include + +#include "qmckl.h" +#include "qmckl_context_private_type.h" +#include "qmckl_memory_private_type.h" +#include "qmckl_memory_private_func.h" +#include "qmckl_jastrow_private_func.h" +#include "qmckl_jastrow_private_type.h" + #+end_src + +* Context + :PROPERTIES: + :Name: qmckl_jastrow + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + The following data stored in the context: + + #+NAME: qmckl_jastrow_args + |------------+--------------------------------------------+-----+-------------------------------------------------------------------| + | ~int32_t~ | ~uninitialized~ | in | Keeps bit set for uninitialized data | + | ~int64_t~ | ~aord_num~ | in | The number of a coeffecients | + | ~int64_t~ | ~bord_num~ | in | The number of b coeffecients | + | ~int64_t~ | ~cord_num~ | in | The number of c coeffecients | + | ~int64_t~ | ~type_nucl_num~ | in | Number of Nucleii types | + | ~int64_t~ | ~type_nucl_vector[nucl_num]~ | in | IDs of types of Nucleii | + | ~double~ | ~aord_vector[aord_num + 1][type_nucl_num]~ | in | Order of a polynomial coefficients | + | ~double~ | ~bord_vector[bord_num + 1]~ | in | Order of b polynomial coefficients | + | ~double~ | ~cord_vector[cord_num][type_nucl_num]~ | in | Order of c polynomial coefficients | + | ~double~ | ~factor_ee[walk_num]~ | out | Jastrow factor: electron-electron part | + | ~uint64_t~ | ~factor_ee_date~ | out | Jastrow factor: electron-electron part | + | ~double~ | ~factor_en[walk_num]~ | out | Jastrow factor: electron-nucleus part | + | ~uint64_t~ | ~factor_en_date~ | out | Jastrow factor: electron-nucleus part | + | ~double~ | ~factor_een[walk_num]~ | out | Jastrow factor: electron-electron-nucleus part | + | ~uint64_t~ | ~factor_een_date~ | out | Jastrow factor: electron-electron-nucleus part | + | ~double~ | ~factor_ee_deriv_e[4][nelec][walk_num]~ | out | Derivative of the Jastrow factor: electron-electron-nucleus part | + | ~uint64_t~ | ~factor_ee_deriv_e_date~ | out | Keep track of the date for the derivative | + | ~double~ | ~factor_en_deriv_e[4][nelec][walk_num]~ | out | Derivative of the Jastrow factor: electron-electron-nucleus part | + | ~uint64_t~ | ~factor_en_deriv_e_date~ | out | Keep track of the date for the en derivative | + | ~double~ | ~factor_een_deriv_e[4][nelec][walk_num]~ | out | Derivative of the Jastrow factor: electron-electron-nucleus part | + | ~uint64_t~ | ~factor_een_deriv_e_date~ | out | Keep track of the date for the een derivative | + + computed data: + + |------------+-----------------------------------------------------------------------+---------------------------------------------------------------------------------------------------------| + | ~int64_t~ | ~dim_cord_vect~ | Number of unique C coefficients | + | ~uint64_t~ | ~dim_cord_vect_date~ | Number of unique C coefficients | + | ~double~ | ~asymp_jasb[2]~ | Asymptotic component | + | ~uint64_t~ | ~asymp_jasb_date~ | Asymptotic component | + | ~double~ | ~cord_vect_full[dim_cord_vect][nucl_num]~ | vector of non-zero coefficients | + | ~uint64_t~ | ~cord_vect_full_date~ | Keep track of changes here | + | ~int64_t~ | ~lkpm_combined_index[4][dim_cord_vect]~ | Transform l,k,p, and m into consecutive indices | + | ~uint64_t~ | ~lkpm_combined_index_date~ | Transform l,k,p, and m into consecutive indices | + | ~double~ | ~tmp_c[elec_num][nucl_num][ncord + 1][ncord][walk_num]~ | vector of non-zero coefficients | + | ~double~ | ~dtmp_c[elec_num][4][nucl_num][ncord + 1][ncord][walk_num]~ | vector of non-zero coefficients | + | ~double~ | ~een_rescaled_e[walk_num][elec_num][elec_num][0:cord_num]~ | The electron-electron rescaled distances raised to the powers defined by cord | + | ~uint64_t~ | ~een_rescaled_e_date~ | Keep track of the date of creation | + | ~double~ | ~een_rescaled_n[walk_num][elec_num][nucl_num][0:cord_num]~ | The electron-electron rescaled distances raised to the powers defined by cord | + | ~uint64_t~ | ~een_rescaled_n_date~ | Keep track of the date of creation | + | ~double~ | ~een_rescaled_e_deriv_e[walk_num][elec_num][4][elec_num][0:cord_num]~ | The electron-electron rescaled distances raised to the powers defined by cord derivatives wrt electrons | + | ~uint64_t~ | ~een_rescaled_e_deriv_e_date~ | Keep track of the date of creation | + | ~double~ | ~een_rescaled_n_deriv_e[walk_num][elec_num][4][nucl_num][0:cord_num]~ | The electron-electron rescaled distances raised to the powers defined by cord derivatives wrt electrons | + | ~uint64_t~ | ~een_rescaled_n_deriv_e_date~ | Keep track of the date of creation | + + For H2O we have the following data: + + #+NAME: jastrow_data + #+BEGIN_SRC python :results output +import numpy as np + +elec_num = 10 +nucl_num = 2 +up_num = 5 +down_num = 5 +nucl_coord = np.array([ [0.000000, 0.000000 ], + [0.000000, 0.000000 ], + [0.000000, 2.059801 ] ]) + +elec_coord = [[[-0.250655104764153 , 0.503070975550133 , -0.166554344502303], + [-0.587812193472177 , -0.128751981129274 , 0.187773606533075], + [ 1.61335569047166 , -0.615556732874863 , -1.43165470979934 ], + [-4.901239896295210E-003 , -1.120440036458986E-002 , 1.99761909330422 ], + [ 0.766647499681200 , -0.293515395797937 , 3.66454589201239 ], + [-0.127732483187947 , -0.138975497694196 , -8.669850480215846E-002], + [-0.232271834949124 , -1.059321673434182E-002 , -0.504862241464867], + [ 1.09360863531826 , -2.036103063808752E-003 , -2.702796910818986E-002], + [-0.108090166832043 , 0.189161729653261 , 2.15398313919894], + [ 0.397978144318712 , -0.254277292595981 , 2.54553335476344]]]; + +ee_distance_rescaled = [ +[ 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, + 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, + 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, + 0.000000000000000E+000], +[ 0.550227800352402 ,0.000000000000000E+000 ,0.000000000000000E+000, + 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, + 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, + 0.000000000000000E+000], +[ 0.919155060185168 ,0.937695909123175 ,0.000000000000000E+000, + 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, + 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, + 0.000000000000000E+000], +[ 0.893325429242815 ,0.851181978173561 ,0.978501685226877 , + 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, + 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, + 0.000000000000000E+000], +[ 0.982457268305353 ,0.976125002619471 ,0.994349933143149 , + 0.844077311588328 ,0.000000000000000E+000 ,0.000000000000000E+000, + 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, + 0.000000000000000E+000], +[ 0.482407528408731 ,0.414816073699124 ,0.894716035479343 , + 0.876540187084407 ,0.978921170036895 ,0.000000000000000E+000, + 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, + 0.000000000000000E+000], +[ 0.459541909660400 ,0.545007215761510 ,0.883752955884551 , + 0.918958134888791 ,0.986386936267237 ,0.362209822236419 , + 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, + 0.000000000000000E+000], +[ 0.763732576854455 ,0.817282762358449 ,0.801802919535959 , + 0.900089095449775 ,0.975704636491453 ,0.707836537586060 , + 0.755705808346586 ,0.000000000000000E+000 ,0.000000000000000E+000, + 0.000000000000000E+000], +[ 0.904249454052971 ,0.871097965261373 ,0.982717262706270 , + 0.239901207363622 ,0.836519456769083 ,0.896135326270534 , + 0.930694340243023 ,0.917708540815567 ,0.000000000000000E+000, + 0.000000000000000E+000], +[ 0.944400908070716 ,0.922589018494961 ,0.984615718580670 , + 0.514328661540623 ,0.692362267147064 ,0.931894098453677 , + 0.956034127544344 ,0.931221472309472 ,0.540903688625053 , + 0.000000000000000E+000]] + +en_distance_rescaled = np.transpose(np.array([ +[ 0.443570948411811 , 0.467602196999105 , 0.893870160799932 , + 0.864347190364447 , 0.976608182392358 , 0.187563183468210 , + 0.426404699872689 , 0.665107090128166 , 0.885246991424583 , + 0.924902909715270 ], +[ 0.899360150637444 , 0.860035135365386 , 0.979659405613798 , + 6.140678415933776E-002, 0.835118398056681 , 0.884071658981068 , + 0.923860000907362 , 0.905203414522289 , 0.211286300932359 , + 0.492104840907350 ]])) + +# symmetrize it +for i in range(elec_num): + for j in range(elec_num): + ee_distance_rescaled[i][j] = ee_distance_rescaled[j][i] + +type_nucl_num = 1 +aord_num = 5 +bord_num = 5 +cord_num = 23 +dim_cord_vect= 23 +type_nucl_vector = [ 1, 1] +aord_vector = [ +[0.000000000000000E+000], +[0.000000000000000E+000], +[-0.380512000000000E+000], +[-0.157996000000000E+000], +[-3.155800000000000E-002], +[2.151200000000000E-002]] + +bord_vector = [ 0.500000000000000E-000, 0.153660000000000E-000, 6.722620000000000E-002, + 2.157000000000000E-002, 7.309600000000000E-003, 2.866000000000000E-003] +cord_vector = [ 0.571702000000000E-000, -0.514253000000000E-000, -0.513043000000000E-000, + 9.486000000000000E-003, -4.205000000000000E-003, 0.426325800000000E-000, + 8.288150000000000E-002, 5.118600000000000E-003, -2.997800000000000E-003, + -5.270400000000000E-003, -7.499999999999999E-005, -8.301649999999999E-002, + 1.454340000000000E-002, 5.143510000000000E-002, 9.250000000000000E-004, + -4.099100000000000E-003, 4.327600000000000E-003, -1.654470000000000E-003, + 2.614000000000000E-003, -1.477000000000000E-003, -1.137000000000000E-003, + -4.010475000000000E-002, 6.106710000000000E-003 ] +cord_vector_full = [ +[ 0.571702000000000E-000, -0.514253000000000E-000, -0.513043000000000E-000, + 9.486000000000000E-003, -4.205000000000000E-003, 0.426325800000000E-000, + 8.288150000000000E-002, 5.118600000000000E-003, -2.997800000000000E-003, + -5.270400000000000E-003, -7.499999999999999E-005, -8.301649999999999E-002, + 1.454340000000000E-002, 5.143510000000000E-002, 9.250000000000000E-004, + -4.099100000000000E-003, 4.327600000000000E-003, -1.654470000000000E-003, + 2.614000000000000E-003, -1.477000000000000E-003, -1.137000000000000E-003, + -4.010475000000000E-002, 6.106710000000000E-003 ], +[ 0.571702000000000E-000, -0.514253000000000E-000, -0.513043000000000E-000, + 9.486000000000000E-003, -4.205000000000000E-003, 0.426325800000000E-000, + 8.288150000000000E-002, 5.118600000000000E-003, -2.997800000000000E-003, + -5.270400000000000E-003, -7.499999999999999E-005, -8.301649999999999E-002, + 1.454340000000000E-002, 5.143510000000000E-002, 9.250000000000000E-004, + -4.099100000000000E-003, 4.327600000000000E-003, -1.654470000000000E-003, + 2.614000000000000E-003, -1.477000000000000E-003, -1.137000000000000E-003, + -4.010475000000000E-002, 6.106710000000000E-003 ], +] +lkpm_combined_index = [[1 , 1 , 2 , 0], + [0 , 0 , 2 , 1], + [1 , 2 , 3 , 0], + [2 , 1 , 3 , 0], + [0 , 1 , 3 , 1], + [1 , 0 , 3 , 1], + [1 , 3 , 4 , 0], + [2 , 2 , 4 , 0], + [0 , 2 , 4 , 1], + [3 , 1 , 4 , 0], + [1 , 1 , 4 , 1], + [2 , 0 , 4 , 1], + [0 , 0 , 4 , 2], + [1 , 4 , 5 , 0], + [2 , 3 , 5 , 0], + [0 , 3 , 5 , 1], + [3 , 2 , 5 , 0], + [1 , 2 , 5 , 1], + [4 , 1 , 5 , 0], + [2 , 1 , 5 , 1], + [0 , 1 , 5 , 2], + [3 , 0 , 5 , 1], + [1 , 0 , 5 , 2]] + +kappa = 1.0 +kappa_inv = 1.0/kappa + #+END_SRC + + #+RESULTS: jastrow_data + +** Data structure + + #+begin_src c :comments org :tangle (eval h_private_type) +typedef struct qmckl_jastrow_struct{ + int32_t uninitialized; + int64_t aord_num; + int64_t bord_num; + int64_t cord_num; + int64_t type_nucl_num; + uint64_t asymp_jasb_date; + uint64_t tmp_c_date; + uint64_t dtmp_c_date; + uint64_t factor_ee_date; + uint64_t factor_en_date; + uint64_t factor_een_date; + uint64_t factor_ee_deriv_e_date; + uint64_t factor_en_deriv_e_date; + uint64_t factor_een_deriv_e_date; + int64_t* type_nucl_vector; + double * aord_vector; + double * bord_vector; + double * cord_vector; + double * asymp_jasb; + double * factor_ee; + double * factor_en; + double * factor_een; + double * factor_ee_deriv_e; + double * factor_en_deriv_e; + double * factor_een_deriv_e; + int64_t dim_cord_vect; + uint64_t dim_cord_vect_date; + double * cord_vect_full; + uint64_t cord_vect_full_date; + int64_t* lkpm_combined_index; + uint64_t lkpm_combined_index_date; + double * tmp_c; + double * dtmp_c; + double * een_rescaled_e; + double * een_rescaled_n; + uint64_t een_rescaled_e_date; + uint64_t een_rescaled_n_date; + double * een_rescaled_e_deriv_e; + double * een_rescaled_n_deriv_e; + uint64_t een_rescaled_e_deriv_e_date; + uint64_t een_rescaled_n_deriv_e_date; + bool provided; + char * type; +} qmckl_jastrow_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. + + #+begin_src c :comments org :tangle (eval h_func) +qmckl_exit_code qmckl_init_jastrow(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) +qmckl_exit_code qmckl_init_jastrow(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->jastrow.uninitialized = (1 << 6) - 1; + + /* Default values */ + + return QMCKL_SUCCESS; +} + #+end_src + +** Access functions + + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code qmckl_get_jastrow_aord_num (qmckl_context context, int64_t* const aord_num); +qmckl_exit_code qmckl_get_jastrow_bord_num (qmckl_context context, int64_t* const bord_num); +qmckl_exit_code qmckl_get_jastrow_cord_num (qmckl_context context, int64_t* const bord_num); +qmckl_exit_code qmckl_get_jastrow_type_nucl_num (qmckl_context context, int64_t* const type_nucl_num); +qmckl_exit_code qmckl_get_jastrow_type_nucl_vector (qmckl_context context, int64_t* const type_nucl_num); +qmckl_exit_code qmckl_get_jastrow_aord_vector (qmckl_context context, double * const aord_vector); +qmckl_exit_code qmckl_get_jastrow_bord_vector (qmckl_context context, double * const bord_vector); +qmckl_exit_code qmckl_get_jastrow_cord_vector (qmckl_context context, double * const cord_vector); + #+end_src + + Along with these core functions, calculation of the jastrow factor + requires the following additional information to be set: + + + When all the data for the AOs have been provided, the following + function returns ~true~. + + #+begin_src c :comments org :tangle (eval h_func) +bool qmckl_jastrow_provided (const qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +bool qmckl_jastrow_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->jastrow.provided; +} + #+end_src + + #+NAME:post + #+begin_src c :exports none +if ( (ctx->jastrow.uninitialized & mask) != 0) { + return NULL; +} + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_jastrow_aord_num (const qmckl_context context, int64_t* const aord_num) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (char) 0; + } + + if (aord_num == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_jastrow_aord_num", + "aord_num is a null pointer"); + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 0; + + if ( (ctx->jastrow.uninitialized & mask) != 0) { + return QMCKL_NOT_PROVIDED; + } + + assert (ctx->jastrow.aord_num > 0); + *aord_num = ctx->jastrow.aord_num; + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_get_jastrow_bord_num (const qmckl_context context, int64_t* const bord_num) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (char) 0; + } + + if (bord_num == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_jastrow_bord_num", + "aord_num is a null pointer"); + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 0; + + if ( (ctx->jastrow.uninitialized & mask) != 0) { + return QMCKL_NOT_PROVIDED; + } + + assert (ctx->jastrow.bord_num > 0); + *bord_num = ctx->jastrow.bord_num; + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_get_jastrow_cord_num (const qmckl_context context, int64_t* const cord_num) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (char) 0; + } + + if (cord_num == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_jastrow_cord_num", + "aord_num is a null pointer"); + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 0; + + if ( (ctx->jastrow.uninitialized & mask) != 0) { + return QMCKL_NOT_PROVIDED; + } + + assert (ctx->jastrow.cord_num > 0); + *cord_num = ctx->jastrow.cord_num; + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_get_jastrow_type_nucl_num (const qmckl_context context, int64_t* const type_nucl_num) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (char) 0; + } + + if (type_nucl_num == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_jastrow_type_nucl_num", + "type_nucl_num is a null pointer"); + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 1; + + if ( (ctx->jastrow.uninitialized & mask) != 0) { + return QMCKL_NOT_PROVIDED; + } + + assert (ctx->jastrow.type_nucl_num > 0); + *type_nucl_num = ctx->jastrow.type_nucl_num; + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_get_jastrow_type_nucl_vector (const qmckl_context context, int64_t * const type_nucl_vector) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (char) 0; + } + + if (type_nucl_vector == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_jastrow_type_nucl_vector", + "type_nucl_vector is a null pointer"); + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 2; + + if ( (ctx->jastrow.uninitialized & mask) != 0) { + return QMCKL_NOT_PROVIDED; + } + + assert (ctx->jastrow.type_nucl_vector != NULL); + memcpy(type_nucl_vector, ctx->jastrow.type_nucl_vector, ctx->jastrow.type_nucl_num*sizeof(int64_t)); + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_get_jastrow_aord_vector (const qmckl_context context, double * const aord_vector) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (char) 0; + } + + if (aord_vector == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_jastrow_aord_vector", + "aord_vector is a null pointer"); + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 3; + + if ( (ctx->jastrow.uninitialized & mask) != 0) { + return QMCKL_NOT_PROVIDED; + } + + assert (ctx->jastrow.aord_vector != NULL); + memcpy(aord_vector, ctx->jastrow.aord_vector, ctx->jastrow.aord_num*sizeof(double)); + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_get_jastrow_bord_vector (const qmckl_context context, double * const bord_vector) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (char) 0; + } + + if (bord_vector == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_jastrow_bord_vector", + "bord_vector is a null pointer"); + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 4; + + if ( (ctx->jastrow.uninitialized & mask) != 0) { + return QMCKL_NOT_PROVIDED; + } + + assert (ctx->jastrow.bord_vector != NULL); + memcpy(bord_vector, ctx->jastrow.bord_vector, ctx->jastrow.bord_num*sizeof(double)); + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_get_jastrow_cord_vector (const qmckl_context context, double * const cord_vector) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (char) 0; + } + + if (cord_vector == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_jastrow_cord_vector", + "cord_vector is a null pointer"); + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 5; + + if ( (ctx->jastrow.uninitialized & mask) != 0) { + return QMCKL_NOT_PROVIDED; + } + + assert (ctx->jastrow.cord_vector != NULL); + memcpy(cord_vector, ctx->jastrow.cord_vector, ctx->jastrow.cord_num*sizeof(double)); + return QMCKL_SUCCESS; +} + + #+end_src + +** Initialization functions + + To prepare for the Jastrow and its derivative, all the following functions need to be + called. + + #+begin_src c :comments org :tangle (eval h_func) +qmckl_exit_code qmckl_set_jastrow_ord_num (qmckl_context context, const int64_t aord_num, const int64_t bord_num, const int64_t cord_num); +qmckl_exit_code qmckl_set_jastrow_type_nucl_num (qmckl_context context, const int64_t type_nucl_num); +qmckl_exit_code qmckl_set_jastrow_type_nucl_vector (qmckl_context context, const int64_t* type_nucl_vector, const int64_t nucl_num); +qmckl_exit_code qmckl_set_jastrow_aord_vector (qmckl_context context, const double * aord_vector); +qmckl_exit_code qmckl_set_jastrow_bord_vector (qmckl_context context, const double * bord_vector); +qmckl_exit_code qmckl_set_jastrow_cord_vector (qmckl_context context, const double * cord_vector); +qmckl_exit_code qmckl_set_jastrow_dependencies (qmckl_context context); + #+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->jastrow.uninitialized &= ~mask; +ctx->jastrow.provided = (ctx->jastrow.uninitialized == 0); +if (ctx->jastrow.provided) { + //qmckl_exit_code rc_ = qmckl_set_jastrow_dependencies(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_jastrow_ord_num(qmckl_context context, const int64_t aord_num, const int64_t bord_num, const int64_t cord_num) { +<> + + if (aord_num <= 0) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_jastrow_ord_num", + "aord_num <= 0"); + } + + if (bord_num <= 0) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_jastrow_ord_num", + "bord_num <= 0"); + } + + if (cord_num <= 0) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_jastrow_ord_num", + "cord_num <= 0"); + } + + int32_t mask = 1 << 0; + ctx->jastrow.aord_num = aord_num; + ctx->jastrow.bord_num = bord_num; + ctx->jastrow.cord_num = cord_num; + + <> +} + +qmckl_exit_code qmckl_set_jastrow_type_nucl_num(qmckl_context context, const int64_t type_nucl_num) { +<> + + if (type_nucl_num <= 0) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_jastrow_type_nucl_num", + "type_nucl_num < 0"); + } + + int32_t mask = 1 << 1; + ctx->jastrow.type_nucl_num = type_nucl_num; + + <> +} + +qmckl_exit_code qmckl_set_jastrow_type_nucl_vector(qmckl_context context, int64_t const * type_nucl_vector, const int64_t nucl_num) { +<> + + int32_t mask = 1 << 2; + + int64_t type_nucl_num; + qmckl_exit_code rc = qmckl_get_jastrow_type_nucl_num(context, &type_nucl_num); + if (rc != QMCKL_SUCCESS) return rc; + + if (type_nucl_num == 0) { + return qmckl_failwith( context, + QMCKL_FAILURE, + "qmckl_set_jastrow_type_nucl_vector", + "type_nucl_num is not set"); + } + + if (type_nucl_vector == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_jastrow_type_nucl_vector", + "type_nucl_vector = NULL"); + } + + if (ctx->jastrow.type_nucl_vector != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->jastrow.type_nucl_vector); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_set_type_nucl_vector", + NULL); + } + } + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = nucl_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_jastrow_type_nucl_vector", + NULL); + } + + memcpy(new_array, type_nucl_vector, mem_info.size); + + ctx->jastrow.type_nucl_vector = new_array; + + <> +} + +qmckl_exit_code qmckl_set_jastrow_aord_vector(qmckl_context context, double const * aord_vector) { +<> + + int32_t mask = 1 << 3; + + int64_t aord_num; + qmckl_exit_code rc = qmckl_get_jastrow_aord_num(context, &aord_num); + if (rc != QMCKL_SUCCESS) return rc; + + int64_t type_nucl_num; + rc = qmckl_get_jastrow_type_nucl_num(context, &type_nucl_num); + if (rc != QMCKL_SUCCESS) return rc; + + if (aord_num == 0) { + return qmckl_failwith( context, + QMCKL_FAILURE, + "qmckl_set_jastrow_coefficient", + "aord_num is not set"); + } + + if (aord_vector == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_jastrow_aord_vector", + "aord_vector = NULL"); + } + + if (ctx->jastrow.aord_vector != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->jastrow.aord_vector); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_set_ord_vector", + NULL); + } + } + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = (aord_num + 1) * type_nucl_num * sizeof(double); + double* new_array = (double*) qmckl_malloc(context, mem_info); + + if(new_array == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_set_jastrow_coefficient", + NULL); + } + + memcpy(new_array, aord_vector, mem_info.size); + + ctx->jastrow.aord_vector = new_array; + + <> +} + +qmckl_exit_code qmckl_set_jastrow_bord_vector(qmckl_context context, double const * bord_vector) { +<> + + int32_t mask = 1 << 4; + + int64_t bord_num; + qmckl_exit_code rc = qmckl_get_jastrow_bord_num(context, &bord_num); + if (rc != QMCKL_SUCCESS) return rc; + + if (bord_num == 0) { + return qmckl_failwith( context, + QMCKL_FAILURE, + "qmckl_set_jastrow_coefficient", + "bord_num is not set"); + } + + if (bord_vector == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_jastrow_bord_vector", + "bord_vector = NULL"); + } + + if (ctx->jastrow.bord_vector != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->jastrow.bord_vector); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_set_ord_vector", + NULL); + } + } + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = (bord_num + 1) * sizeof(double); + double* new_array = (double*) qmckl_malloc(context, mem_info); + + if(new_array == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_set_jastrow_coefficient", + NULL); + } + + memcpy(new_array, bord_vector, mem_info.size); + + ctx->jastrow.bord_vector = new_array; + + <> +} + +qmckl_exit_code qmckl_set_jastrow_cord_vector(qmckl_context context, double const * cord_vector) { +<> + + int32_t mask = 1 << 5; + + int64_t cord_num; + qmckl_exit_code rc = qmckl_get_jastrow_cord_num(context, &cord_num); + if (rc != QMCKL_SUCCESS) return rc; + + int64_t type_nucl_num; + rc = qmckl_get_jastrow_type_nucl_num(context, &type_nucl_num); + if (rc != QMCKL_SUCCESS) return rc; + + if (cord_num == 0) { + return qmckl_failwith( context, + QMCKL_FAILURE, + "qmckl_set_jastrow_coefficient", + "cord_num is not set"); + } + + if (cord_vector == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_jastrow_cord_vector", + "cord_vector = NULL"); + } + + if (ctx->jastrow.cord_vector != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->jastrow.cord_vector); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_set_ord_vector", + NULL); + } + } + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = cord_num * type_nucl_num * sizeof(double); + double* new_array = (double*) qmckl_malloc(context, mem_info); + + if(new_array == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_set_jastrow_coefficient", + NULL); + } + + memcpy(new_array, cord_vector, mem_info.size); + + ctx->jastrow.cord_vector = new_array; + + <> +} + +qmckl_exit_code qmckl_set_jastrow_dependencies(qmckl_context context) { +<> + + /* Check for electron data */ + if (!(ctx->electron.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_provide_ee_distance", + NULL); + } + + /* Check for nucleus data */ + if (!(ctx->nucleus.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_provide_en_distance", + NULL); + } + + int32_t mask = 1 << 6; + + <> +} + + #+end_src + + When the required information is completely entered, other data structures are + computed to accelerate the calculations. The intermediates factors + are precontracted using BLAS LEVEL 3 operations for an optimal FLOP count. + + #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none +qmckl_exit_code qmckl_finalize_jastrow(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_finalize_jastrow(qmckl_context context) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_INVALID_CONTEXT; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + /* ----------------------------------- */ + /* Check for the necessary information */ + /* ----------------------------------- */ + + /* Check for the electron data + 1. elec_num + 2. ee_distances_rescaled + ,*/ + if (!(ctx->electron.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + /* Check for the nucleus data + 1. nucl_num + 2. en_distances_rescaled + ,*/ + if (!(ctx->nucleus.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_nucleus", + NULL); + } + + qmckl_exit_code rc = QMCKL_FAILURE; + return rc; + + /* ----------------------------------- */ + /* Start calculation of data */ + /* ----------------------------------- */ + + +} + #+end_src + +** Test + #+begin_src c :tangle (eval c_test) +/* Reference input data */ +int64_t walk_num = n2_walk_num; +int64_t elec_num = n2_elec_num; +int64_t elec_up_num = n2_elec_up_num; +int64_t elec_dn_num = n2_elec_dn_num; +double rescale_factor_kappa_ee = 1.0; +double rescale_factor_kappa_en = 1.0; +double nucl_rescale_factor_kappa = 1.0; +double* elec_coord = &(n2_elec_coord[0][0][0]); + +const double* nucl_charge = n2_charge; +int64_t nucl_num = n2_nucl_num; +double* nucl_coord = &(n2_nucl_coord[0][0]); + +/* Provide Electron data */ + +qmckl_exit_code rc; + +assert(!qmckl_electron_provided(context)); + +int64_t n; +rc = qmckl_get_electron_num (context, &n); +assert(rc == QMCKL_NOT_PROVIDED); + +rc = qmckl_get_electron_up_num (context, &n); +assert(rc == QMCKL_NOT_PROVIDED); + +rc = qmckl_get_electron_down_num (context, &n); +assert(rc == QMCKL_NOT_PROVIDED); + + +rc = qmckl_set_electron_num (context, elec_up_num, elec_dn_num); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_electron_provided(context)); + +rc = qmckl_get_electron_up_num (context, &n); +assert(rc == QMCKL_SUCCESS); +assert(n == elec_up_num); + +rc = qmckl_get_electron_down_num (context, &n); +assert(rc == QMCKL_SUCCESS); +assert(n == elec_dn_num); + +rc = qmckl_get_electron_num (context, &n); +assert(rc == QMCKL_SUCCESS); +assert(n == elec_num); + +double k_ee = 0.; +double k_en = 0.; +rc = qmckl_get_electron_rescale_factor_ee (context, &k_ee); +assert(rc == QMCKL_SUCCESS); +assert(k_ee == 1.0); + +rc = qmckl_get_electron_rescale_factor_en (context, &k_en); +assert(rc == QMCKL_SUCCESS); +assert(k_en == 1.0); + +rc = qmckl_set_electron_rescale_factor_en(context, rescale_factor_kappa_en); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_set_electron_rescale_factor_ee(context, rescale_factor_kappa_ee); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_get_electron_rescale_factor_ee (context, &k_ee); +assert(rc == QMCKL_SUCCESS); +assert(k_ee == rescale_factor_kappa_ee); + +rc = qmckl_get_electron_rescale_factor_en (context, &k_en); +assert(rc == QMCKL_SUCCESS); +assert(k_en == rescale_factor_kappa_en); + + +int64_t w; +rc = qmckl_get_electron_walk_num (context, &w); +assert(rc == QMCKL_NOT_PROVIDED); + + +rc = qmckl_set_electron_walk_num (context, walk_num); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_get_electron_walk_num (context, &w); +assert(rc == QMCKL_SUCCESS); +assert(w == walk_num); + +assert(qmckl_electron_provided(context)); + +rc = qmckl_set_electron_coord (context, 'N', elec_coord); +assert(rc == QMCKL_SUCCESS); + +double elec_coord2[walk_num*3*elec_num]; + +rc = qmckl_get_electron_coord (context, 'N', elec_coord2); +assert(rc == QMCKL_SUCCESS); +for (int64_t i=0 ; i<3*elec_num ; ++i) { + assert( elec_coord[i] == elec_coord2[i] ); + } + + +/* Provide Nucleus data */ + +assert(!qmckl_nucleus_provided(context)); + +rc = qmckl_get_nucleus_num (context, &n); +assert(rc == QMCKL_NOT_PROVIDED); + + +rc = qmckl_set_nucleus_num (context, nucl_num); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_nucleus_provided(context)); + +rc = qmckl_get_nucleus_num (context, &n); +assert(rc == QMCKL_SUCCESS); +assert(n == nucl_num); + +double k; +rc = qmckl_get_nucleus_rescale_factor (context, &k); +assert(rc == QMCKL_SUCCESS); +assert(k == 1.0); + + +rc = qmckl_set_nucleus_rescale_factor (context, nucl_rescale_factor_kappa); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_get_nucleus_rescale_factor (context, &k); +assert(rc == QMCKL_SUCCESS); +assert(k == nucl_rescale_factor_kappa); + +double nucl_coord2[3*nucl_num]; + +rc = qmckl_get_nucleus_coord (context, 'T', nucl_coord2); +assert(rc == QMCKL_NOT_PROVIDED); + +rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0])); +assert(rc == QMCKL_SUCCESS); + +assert(!qmckl_nucleus_provided(context)); + +rc = qmckl_get_nucleus_coord (context, 'N', nucl_coord2); +assert(rc == QMCKL_SUCCESS); +for (int64_t k=0 ; k<3 ; ++k) { + for (int64_t i=0 ; ijastrow.asymp_jasb, sze * sizeof(double)); + + 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_asymp_jasb(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_asymp_jasb(qmckl_context context) +{ + + qmckl_exit_code rc; + + 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); + + /* Check if ee kappa is provided */ + double rescale_factor_kappa_ee; + rc = qmckl_get_electron_rescale_factor_ee(context, &rescale_factor_kappa_ee); + if(rc != QMCKL_SUCCESS) return rc; + + /* Compute if necessary */ + if (ctx->date > ctx->jastrow.asymp_jasb_date) { + + /* Allocate array */ + if (ctx->jastrow.asymp_jasb == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = 2 * sizeof(double); + double* asymp_jasb = (double*) qmckl_malloc(context, mem_info); + + if (asymp_jasb == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_asymp_jasb", + NULL); + } + ctx->jastrow.asymp_jasb = asymp_jasb; + } + + qmckl_exit_code rc = + qmckl_compute_asymp_jasb(context, + ctx->jastrow.bord_num, + ctx->jastrow.bord_vector, + rescale_factor_kappa_ee, + ctx->jastrow.asymp_jasb); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->jastrow.asymp_jasb_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute + :PROPERTIES: + :Name: qmckl_compute_asymp_jasb + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_asymp_jasb_args + | qmckl_context | context | in | Global state | + | int64_t | bord_num | in | Number of electrons | + | double | bord_vector[bord_num + 1] | in | Number of walkers | + | double | rescale_factor_kappa_ee | in | Electron coordinates | + | double | asymp_jasb[2] | out | Electron-electron distances | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_asymp_jasb_f(context, bord_num, bord_vector, rescale_factor_kappa_ee, asymp_jasb) & + result(info) + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer*8 , intent(in) :: bord_num + double precision , intent(in) :: bord_vector(bord_num + 1) + double precision , intent(in) :: rescale_factor_kappa_ee + double precision , intent(out) :: asymp_jasb(2) + + integer*8 :: i, p + double precision :: kappa_inv, x, asym_one + kappa_inv = 1.0d0 / rescale_factor_kappa_ee + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (bord_num <= 0) then + info = QMCKL_INVALID_ARG_2 + return + endif + + asym_one = bord_vector(1) * kappa_inv / (1.0d0 + bord_vector(2) * kappa_inv) + asymp_jasb(:) = (/asym_one, 0.5d0 * asym_one/) + + do i = 1, 2 + x = kappa_inv + do p = 2, bord_num + x = x * kappa_inv + asymp_jasb(i) = asymp_jasb(i) + bord_vector(p + 1) * x + end do + end do + +end function qmckl_compute_asymp_jasb_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_asymp_jasb_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_private_func) :comments org + qmckl_exit_code qmckl_compute_asymp_jasb ( + const qmckl_context context, + const int64_t bord_num, + const double* bord_vector, + const double rescale_factor_kappa_ee, + double* const asymp_jasb ); + #+end_src + + + #+CALL: generate_c_interface(table=qmckl_asymp_jasb_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_asymp_jasb & + (context, bord_num, bord_vector, rescale_factor_kappa_ee, asymp_jasb) & + 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 :: bord_num + real (c_double ) , intent(in) :: bord_vector(bord_num + 1) + real (c_double ) , intent(in) , value :: rescale_factor_kappa_ee + real (c_double ) , intent(out) :: asymp_jasb(2) + + integer(c_int32_t), external :: qmckl_compute_asymp_jasb_f + info = qmckl_compute_asymp_jasb_f & + (context, bord_num, bord_vector, rescale_factor_kappa_ee, asymp_jasb) + + end function qmckl_compute_asymp_jasb + #+end_src + +*** Test + #+name: asymp_jasb + #+begin_src python :results output :exports none :noweb yes +import numpy as np + +<> + +asym_one = bord_vector[0] * kappa_inv / (1.0 + bord_vector[1]*kappa_inv) +asymp_jasb = np.array([asym_one, 0.5 * asym_one]) + +for i in range(2): + x = kappa_inv + for p in range(1,bord_num): + x = x * kappa_inv + asymp_jasb[i] += bord_vector[p + 1] * x + +print("asym_one : ", asym_one) +print("asymp_jasb[0] : ", asymp_jasb[0]) +print("asymp_jasb[1] : ", asymp_jasb[1]) + #+end_src + + #+RESULTS: asymp_jasb + : asym_one : 0.6634291325000664 + : asymp_jasb[0] : 1.043287918508297 + : asymp_jasb[1] : 0.7115733522582638 + + #+RESULTS: + : asym_one : 0.43340325572525706 + : asymp_jasb[0] : 0.5323750557252571 + : asymp_jasb[1] : 0.31567342786262853 + + #+begin_src c :tangle (eval c_test) +assert(qmckl_electron_provided(context)); + +int64_t type_nucl_num = n2_type_nucl_num; +int64_t* type_nucl_vector = &(n2_type_nucl_vector[0]); +int64_t aord_num = n2_aord_num; +int64_t bord_num = n2_bord_num; +int64_t cord_num = n2_cord_num; +double* aord_vector = &(n2_aord_vector[0][0]); +double* bord_vector = &(n2_bord_vector[0]); +double* cord_vector = &(n2_cord_vector[0][0]); + +/* Initialize the Jastrow data */ +rc = qmckl_init_jastrow(context); +assert(!qmckl_jastrow_provided(context)); + +/* Set the data */ +rc = qmckl_set_jastrow_ord_num(context, aord_num, bord_num, cord_num); +assert(rc == QMCKL_SUCCESS); +rc = qmckl_set_jastrow_type_nucl_num(context, type_nucl_num); +assert(rc == QMCKL_SUCCESS); +rc = qmckl_set_jastrow_type_nucl_vector(context, type_nucl_vector, nucl_num); +assert(rc == QMCKL_SUCCESS); +rc = qmckl_set_jastrow_aord_vector(context, aord_vector); +assert(rc == QMCKL_SUCCESS); +rc = qmckl_set_jastrow_bord_vector(context, bord_vector); +assert(rc == QMCKL_SUCCESS); +rc = qmckl_set_jastrow_cord_vector(context, cord_vector); +assert(rc == QMCKL_SUCCESS); +rc = qmckl_set_jastrow_dependencies(context); +assert(rc == QMCKL_SUCCESS); + +/* Check if Jastrow is properly initialized */ +assert(qmckl_jastrow_provided(context)); + +double asymp_jasb[2]; +rc = qmckl_get_jastrow_asymp_jasb(context, asymp_jasb); + +// calculate asymp_jasb +assert(fabs(asymp_jasb[0]-0.5323750557252571) < 1.e-12); +assert(fabs(asymp_jasb[1]-0.31567342786262853) < 1.e-12); + + #+end_src + +** Electron-electron component \(f_{ee}\) + + Calculate the electron-electron jastrow component ~factor_ee~ using the ~asymp_jasb~ + componenet and the electron-electron rescaled distances ~ee_distance_rescaled~. + + \[ +f_{ee} = \sum_{i,jjastrow.factor_ee, ctx->electron.walk_num*sizeof(double)); + + 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_factor_ee(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_factor_ee(qmckl_context context) +{ + + qmckl_exit_code rc; + + 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); + + /* Check if ee rescaled distance is provided */ + rc = qmckl_provide_ee_distance_rescaled(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Compute if necessary */ + if (ctx->date > ctx->jastrow.factor_ee_date) { + + /* Allocate array */ + if (ctx->jastrow.factor_ee == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.walk_num * sizeof(double); + double* factor_ee = (double*) qmckl_malloc(context, mem_info); + + if (factor_ee == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_provide_factor_ee", + NULL); + } + ctx->jastrow.factor_ee = factor_ee; + } + + qmckl_exit_code rc = + qmckl_compute_factor_ee(context, + ctx->electron.walk_num, + ctx->electron.num, + ctx->electron.up_num, + ctx->jastrow.bord_num, + ctx->jastrow.bord_vector, + ctx->electron.ee_distance_rescaled, + ctx->jastrow.asymp_jasb, + ctx->jastrow.factor_ee); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->jastrow.factor_ee_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute + :PROPERTIES: + :Name: qmckl_compute_factor_ee + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_factor_ee_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 | up_num | in | Number of alpha electrons | + | int64_t | bord_num | in | Number of coefficients | + | double | bord_vector[bord_num + 1] | in | List of coefficients | + | double | ee_distance_rescaled[walk_num][elec_num][elec_num] | in | Electron-electron distances | + | double | asymp_jasb[2] | in | Electron-electron distances | + | double | factor_ee[walk_num] | out | Electron-electron distances | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_factor_ee_f(context, walk_num, elec_num, up_num, bord_num, & + bord_vector, ee_distance_rescaled, asymp_jasb, factor_ee) & + result(info) + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer*8 , intent(in) :: walk_num, elec_num, bord_num, up_num + double precision , intent(in) :: bord_vector(bord_num + 1) + double precision , intent(in) :: ee_distance_rescaled(walk_num, elec_num, elec_num) + double precision , intent(in) :: asymp_jasb(2) + double precision , intent(out) :: factor_ee(walk_num) + + integer*8 :: i, j, p, ipar, nw + double precision :: pow_ser, x, spin_fact, power_ser + + 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 + + if (bord_num <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + factor_ee = 0.0d0 + + do nw =1, walk_num + do j = 1, elec_num + do i = 1, j - 1 + x = ee_distance_rescaled(nw,i,j) + power_ser = 0.0d0 + spin_fact = 1.0d0 + ipar = 1 + + do p = 2, bord_num + x = x * ee_distance_rescaled(nw,i,j) + power_ser = power_ser + bord_vector(p + 1) * x + end do + + if(j .LE. up_num .OR. i .GT. up_num) then + spin_fact = 0.5d0 + ipar = 2 + endif + + factor_ee(nw) = factor_ee(nw) + spin_fact * bord_vector(1) * & + ee_distance_rescaled(nw,i,j) / & + (1.0d0 + bord_vector(2) * & + ee_distance_rescaled(nw,i,j)) & + -asymp_jasb(ipar) + power_ser + + end do + end do + end do + +end function qmckl_compute_factor_ee_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_factor_ee_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_factor_ee ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const int64_t up_num, + const int64_t bord_num, + const double* bord_vector, + const double* ee_distance_rescaled, + const double* asymp_jasb, + double* const factor_ee ); + #+end_src + + + #+CALL: generate_c_interface(table=qmckl_factor_ee_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_factor_ee & + (context, & + walk_num, & + elec_num, & + up_num, & + bord_num, & + bord_vector, & + ee_distance_rescaled, & + asymp_jasb, & + factor_ee) & + 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 :: up_num + integer (c_int64_t) , intent(in) , value :: bord_num + real (c_double ) , intent(in) :: bord_vector(bord_num + 1) + real (c_double ) , intent(in) :: ee_distance_rescaled(elec_num,elec_num,walk_num) + real (c_double ) , intent(in) :: asymp_jasb(2) + real (c_double ) , intent(out) :: factor_ee(walk_num) + + integer(c_int32_t), external :: qmckl_compute_factor_ee_f + info = qmckl_compute_factor_ee_f & + (context, & + walk_num, & + elec_num, & + up_num, & + bord_num, & + bord_vector, & + ee_distance_rescaled, & + asymp_jasb, & + factor_ee) + + end function qmckl_compute_factor_ee + #+end_src + +*** Test + #+begin_src python :results output :exports none :noweb yes +import numpy as np + +<> + +<> + +factor_ee = 0.0 +for i in range(0,elec_num): + for j in range(0,i): + x = ee_distance_rescaled[i][j] + pow_ser = 0.0 + spin_fact = 1.0 + ipar = 0 + + for p in range(1,bord_num): + x = x * ee_distance_rescaled[i][j] + pow_ser = pow_ser + bord_vector[p + 1] * x + + if(i < up_num or j >= up_num): + spin_fact = 0.5 + ipar = 1 + + factor_ee = factor_ee + spin_fact * bord_vector[0] * ee_distance_rescaled[i][j] \ + / (1.0 + bord_vector[1] * ee_distance_rescaled[i][j]) \ + - asymp_jasb[ipar] + pow_ser +print("factor_ee :",factor_ee) + + #+end_src + + #+RESULTS: + : asym_one : 0.43340325572525706 + : asymp_jasb[0] : 0.5323750557252571 + : asymp_jasb[1] : 0.31567342786262853 + : factor_ee : -4.282760865958113 + + + #+begin_src c :tangle (eval c_test) +/* Check if Jastrow is properly initialized */ +assert(qmckl_jastrow_provided(context)); + +double factor_ee[walk_num]; +rc = qmckl_get_jastrow_factor_ee(context, factor_ee); + +// calculate factor_ee +assert(fabs(factor_ee[0]+4.282760865958113) < 1.e-12); + + #+end_src + +** Electron-electron component derivative \(f'_{ee}\) + + Calculate the derivative of the ~factor_ee~ using the ~ee_distance_rescaled~ and + the electron-electron rescaled distances derivatives ~ee_distance_rescaled_deriv_e~. + There are four components, the gradient which has 3 components in the \(x, y, z\) + directions and the laplacian as the last component. + + TODO: Add equation + + +*** Get + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context, double* const factor_ee_deriv_e); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context, double* const factor_ee_deriv_e) +{ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_factor_ee_deriv_e(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int64_t sze = ctx->electron.walk_num * 4 * ctx->electron.num; + memcpy(factor_ee_deriv_e, ctx->jastrow.factor_ee_deriv_e, sze * sizeof(double)); + + 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_factor_ee_deriv_e(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_factor_ee_deriv_e(qmckl_context context) +{ + + qmckl_exit_code rc; + + 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); + + /* Check if ee rescaled distance is provided */ + rc = qmckl_provide_ee_distance_rescaled(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Check if ee rescaled distance deriv e is provided */ + rc = qmckl_provide_ee_distance_rescaled_deriv_e(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Compute if necessary */ + if (ctx->date > ctx->jastrow.factor_ee_deriv_e_date) { + + /* Allocate array */ + if (ctx->jastrow.factor_ee_deriv_e == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.walk_num * 4 * ctx->electron.num * sizeof(double); + double* factor_ee_deriv_e = (double*) qmckl_malloc(context, mem_info); + + if (factor_ee_deriv_e == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_provide_factor_ee_deriv_e", + NULL); + } + ctx->jastrow.factor_ee_deriv_e = factor_ee_deriv_e; + } + + qmckl_exit_code rc = + qmckl_compute_factor_ee_deriv_e(context, + ctx->electron.walk_num, + ctx->electron.num, + ctx->electron.up_num, + ctx->jastrow.bord_num, + ctx->jastrow.bord_vector, + ctx->electron.ee_distance_rescaled, + ctx->electron.ee_distance_rescaled_deriv_e, + ctx->jastrow.asymp_jasb, + ctx->jastrow.factor_ee_deriv_e); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->jastrow.factor_ee_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute + :PROPERTIES: + :Name: qmckl_compute_factor_ee_deriv_e + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_factor_ee_deriv_e_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 | up_num | in | Number of alpha electrons | + | int64_t | bord_num | in | Number of coefficients | + | double | bord_vector[bord_num + 1] | in | List of coefficients | + | double | ee_distance_rescaled[walk_num][elec_num][elec_num] | in | Electron-electron distances | + | double | ee_distance_rescaled_deriv_e[walk_num][4][elec_num][elec_num] | in | Electron-electron distances | + | double | asymp_jasb[2] | in | Electron-electron distances | + | double | factor_ee_deriv_e[walk_num][4][elec_num] | out | Electron-electron distances | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_factor_ee_deriv_e_f(context, walk_num, elec_num, up_num, bord_num, & + bord_vector, ee_distance_rescaled, ee_distance_rescaled_deriv_e, & + asymp_jasb, factor_ee_deriv_e) & + result(info) + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer*8 , intent(in) :: walk_num, elec_num, bord_num, up_num + double precision , intent(in) :: bord_vector(bord_num + 1) + double precision , intent(in) :: ee_distance_rescaled(walk_num, elec_num, elec_num) + double precision , intent(in) :: ee_distance_rescaled_deriv_e(walk_num, 4, elec_num, elec_num) + double precision , intent(in) :: asymp_jasb(2) + double precision , intent(out) :: factor_ee_deriv_e(elec_num,4,walk_num) + + integer*8 :: i, j, p, ipar, nw, ii + double precision :: x, spin_fact, y + double precision :: den, invden, invden2, invden3, xinv + double precision :: lap1, lap2, lap3, third + double precision, dimension(3) :: pow_ser_g + double precision, dimension(4) :: dx + + 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 + + if (bord_num <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + factor_ee_deriv_e = 0.0d0 + third = 1.0d0 / 3.0d0 + + do nw =1, walk_num + do j = 1, elec_num + do i = 1, elec_num + x = ee_distance_rescaled(nw, i, j) + if(abs(x) < 1.0d-18) cycle + pow_ser_g = 0.0d0 + spin_fact = 1.0d0 + den = 1.0d0 + bord_vector(2) * x + invden = 1.0d0 / den + invden2 = invden * invden + invden3 = invden2 * invden + xinv = 1.0d0 / (x + 1.0d-18) + ipar = 1 + + do ii = 1, 4 + dx(ii) = ee_distance_rescaled_deriv_e(nw, ii, i, j) + end do + + if((i .LE. up_num .AND. j .LE. up_num ) .OR. & + (i .GT. up_num .AND. j .GT. up_num)) then + spin_fact = 0.5d0 + endif + + lap1 = 0.0d0 + lap2 = 0.0d0 + lap3 = 0.0d0 + do ii = 1, 3 + x = ee_distance_rescaled(nw, i, j) + if(abs(x) < 1.0d-18) cycle + do p = 2, bord_num + y = p * bord_vector(p + 1) * x + pow_ser_g(ii) = pow_ser_g(ii) + y * dx(ii) + lap1 = lap1 + (p - 1) * y * xinv * dx(ii) * dx(ii) + lap2 = lap2 + y + x = x * ee_distance_rescaled(nw, i, j) + end do + + lap3 = lap3 - 2.0d0 * bord_vector(2) * dx(ii) * dx(ii) + + factor_ee_deriv_e( j, ii, nw) = factor_ee_deriv_e( j, ii, nw) + spin_fact * bord_vector(1) * & + dx(ii) * invden2 + pow_ser_g(ii) + end do + + ii = 4 + lap2 = lap2 * dx(ii) * third + lap3 = lap3 + den * dx(ii) + lap3 = lap3 * (spin_fact * bord_vector(1) * invden3) + factor_ee_deriv_e( j, ii, nw) = factor_ee_deriv_e( j, ii, nw) + lap1 + lap2 + lap3 + + end do + end do + end do + +end function qmckl_compute_factor_ee_deriv_e_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_factor_ee_deriv_e_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_factor_ee_deriv_e ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const int64_t up_num, + const int64_t bord_num, + const double* bord_vector, + const double* ee_distance_rescaled, + const double* ee_distance_rescaled_deriv_e, + const double* asymp_jasb, + double* const factor_ee_deriv_e ); + #+end_src + + + #+CALL: generate_c_interface(table=qmckl_factor_ee_deriv_e_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_factor_ee_deriv_e & + (context, & + walk_num, & + elec_num, & + up_num, & + bord_num, & + bord_vector, & + ee_distance_rescaled, & + ee_distance_rescaled_deriv_e, & + asymp_jasb, & + factor_ee_deriv_e) & + 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 :: up_num + integer (c_int64_t) , intent(in) , value :: bord_num + real (c_double ) , intent(in) :: bord_vector(bord_num + 1) + real (c_double ) , intent(in) :: ee_distance_rescaled(elec_num,elec_num,walk_num) + real (c_double ) , intent(in) :: ee_distance_rescaled_deriv_e(elec_num,elec_num,4,walk_num) + real (c_double ) , intent(in) :: asymp_jasb(2) + real (c_double ) , intent(out) :: factor_ee_deriv_e(elec_num,4,walk_num) + + integer(c_int32_t), external :: qmckl_compute_factor_ee_deriv_e_f + info = qmckl_compute_factor_ee_deriv_e_f & + (context, & + walk_num, & + elec_num, & + up_num, & + bord_num, & + bord_vector, & + ee_distance_rescaled, & + ee_distance_rescaled_deriv_e, & + asymp_jasb, & + factor_ee_deriv_e) + + end function qmckl_compute_factor_ee_deriv_e + #+end_src + +*** Test + #+begin_src python :results output :exports none :noweb yes +import numpy as np + +<> + +<> + +kappa = 1.0 + +elec_coord = np.array(elec_coord)[0] +elec_dist = np.zeros(shape=(elec_num, elec_num),dtype=float) +for i in range(elec_num): + for j in range(elec_num): + elec_dist[i, j] = np.linalg.norm(elec_coord[i] - elec_coord[j]) + +elec_dist_deriv_e = np.zeros(shape=(4,elec_num, elec_num),dtype=float) +for j in range(elec_num): + for i in range(elec_num): + rij_inv = 1.0 / elec_dist[i, j] + for ii in range(3): + elec_dist_deriv_e[ii, i, j] = (elec_coord[j][ii] - elec_coord[i][ii]) * rij_inv + elec_dist_deriv_e[3, i, j] = 2.0 * rij_inv + elec_dist_deriv_e[:, j, j] = 0.0 + +ee_distance_rescaled_deriv_e = np.zeros(shape=(4,elec_num,elec_num),dtype=float) +for j in range(elec_num): + for i in range(elec_num): + f = 1.0 - kappa * ee_distance_rescaled[i][j] + for ii in range(4): + ee_distance_rescaled_deriv_e[ii][i][j] = elec_dist_deriv_e[ii][i][j] + ee_distance_rescaled_deriv_e[3][i][j] = ee_distance_rescaled_deriv_e[3][i][j] + \ + (-kappa * ee_distance_rescaled_deriv_e[0][i][j] * ee_distance_rescaled_deriv_e[0][i][j]) + \ + (-kappa * ee_distance_rescaled_deriv_e[1][i][j] * ee_distance_rescaled_deriv_e[1][i][j]) + \ + (-kappa * ee_distance_rescaled_deriv_e[2][i][j] * ee_distance_rescaled_deriv_e[2][i][j]) + for ii in range(4): + ee_distance_rescaled_deriv_e[ii][i][j] = ee_distance_rescaled_deriv_e[ii][i][j] * f + +third = 1.0 / 3.0 +factor_ee_deriv_e = np.zeros(shape=(4,elec_num),dtype=float) +dx = np.zeros(shape=(4),dtype=float) +pow_ser_g = np.zeros(shape=(4),dtype=float) +for j in range(elec_num): + for i in range(elec_num): + x = ee_distance_rescaled[j][i] + if abs(x) < 1e-18: + continue + pow_ser_g = np.zeros(shape=(4),dtype=float) + spin_fact = 1.0 + den = 1.0 + bord_vector[1] * ee_distance_rescaled[j][i] + invden = 1.0 / den + invden2 = invden * invden + invden3 = invden2 * invden + xinv = 1.0 / (ee_distance_rescaled[j][i] + 1.0E-18) + ipar = 1 + + for ii in range(4): + dx[ii] = ee_distance_rescaled_deriv_e[ii][j][i] + + if((i <= (up_num-1) and j <= (up_num-1) ) or \ + (i > (up_num-1) and j > (up_num-1))): + spin_fact = 0.5 + + lap1 = 0.0 + lap2 = 0.0 + lap3 = 0.0 + for ii in range(3): + x = ee_distance_rescaled[j][i] + if x < 1e-18: + continue + for p in range(2,bord_num+1): + y = p * bord_vector[(p-1) + 1] * x + pow_ser_g[ii] = pow_ser_g[ii] + y * dx[ii] + lap1 = lap1 + (p - 1) * y * xinv * dx[ii] * dx[ii] + lap2 = lap2 + y + x = x * ee_distance_rescaled[j][i] + + lap3 = lap3 - 2.0 * bord_vector[1] * dx[ii] * dx[ii] + + factor_ee_deriv_e[ii][j] = factor_ee_deriv_e[ii][j] + spin_fact * bord_vector[0] * \ + dx[ii] * invden2 + pow_ser_g[ii] + + ii = 3 + lap2 = lap2 * dx[ii] * third + lap3 = lap3 + den * dx[ii] + lap3 = lap3 * (spin_fact * bord_vector[0] * invden3) + factor_ee_deriv_e[ii][j] = factor_ee_deriv_e[ii][j] + lap1 + lap2 + lap3 + +print("factor_ee_deriv_e[0][0]:",factor_ee_deriv_e[0][0]) +print("factor_ee_deriv_e[1][0]:",factor_ee_deriv_e[1][0]) +print("factor_ee_deriv_e[2][0]:",factor_ee_deriv_e[2][0]) +print("factor_ee_deriv_e[3][0]:",factor_ee_deriv_e[3][0]) +print(factor_ee_deriv_e) + + #+end_src + + #+RESULTS: + #+begin_example + asym_one : 0.43340325572525706 + asymp_jasb[0] : 0.5323750557252571 + asymp_jasb[1] : 0.31567342786262853 + factor_ee_deriv_e[0][0]: 0.16364894652107934 + factor_ee_deriv_e[1][0]: -0.6927548119830084 + factor_ee_deriv_e[2][0]: 0.073267755223968 + factor_ee_deriv_e[3][0]: 1.5111672803213185 + [[ 0.16364895 0.60354957 -0.19825547 0.02359797 -0.13123153 -0.18789233 + 0.07762515 -0.42459184 0.27920265 -0.2056531 ] + [-0.69275481 0.15690393 0.09831069 0.18490587 0.04361723 0.3250686 + 0.12657961 -0.01736522 -0.40149005 0.17622416] + [ 0.07326776 -0.27532276 0.22396943 0.18771633 -0.34506246 0.07298062 + 0.63302352 -0.00910198 -0.30238713 -0.25908332] + [ 1.51116728 1.5033247 0.00325003 2.89377255 0.1338393 2.15893795 + 1.74732003 0.23561147 2.67455607 0.82810434]] + #+end_example + + + #+begin_src c :tangle (eval c_test) +/* Check if Jastrow is properly initialized */ +assert(qmckl_jastrow_provided(context)); + +// calculate factor_ee_deriv_e +double factor_ee_deriv_e[walk_num][4][elec_num]; +rc = qmckl_get_jastrow_factor_ee_deriv_e(context, &(factor_ee_deriv_e[0][0][0])); + +// check factor_ee_deriv_e +assert(fabs(factor_ee_deriv_e[0][0][0]-0.16364894652107934) < 1.e-12); +assert(fabs(factor_ee_deriv_e[0][1][0]+0.6927548119830084 ) < 1.e-12); +assert(fabs(factor_ee_deriv_e[0][2][0]-0.073267755223968 ) < 1.e-12); +assert(fabs(factor_ee_deriv_e[0][3][0]-1.5111672803213185 ) < 1.e-12); + + #+end_src + +** Electron-nucleus component \(f_{en}\) + + Calculate the electron-electron jastrow component ~factor_en~ using the ~aord_vector~ + coeffecients and the electron-nucleus rescaled distances ~en_distance_rescaled~. + + \[ +f_{en} = \sum_{i,jjastrow.factor_en, ctx->electron.walk_num*sizeof(double)); + + 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_factor_en(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_factor_en(qmckl_context context) +{ + + qmckl_exit_code rc; + + 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); + + /* Check if en rescaled distance is provided */ + rc = qmckl_provide_en_distance_rescaled(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Compute if necessary */ + if (ctx->date > ctx->jastrow.factor_en_date) { + + /* Allocate array */ + if (ctx->jastrow.factor_en == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.walk_num * sizeof(double); + double* factor_en = (double*) qmckl_malloc(context, mem_info); + + if (factor_en == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_provide_factor_en", + NULL); + } + ctx->jastrow.factor_en = factor_en; + } + + qmckl_exit_code rc = + qmckl_compute_factor_en(context, + ctx->electron.walk_num, + ctx->electron.num, + ctx->nucleus.num, + ctx->jastrow.type_nucl_num, + ctx->jastrow.type_nucl_vector, + ctx->jastrow.aord_num, + ctx->jastrow.aord_vector, + ctx->electron.en_distance_rescaled, + ctx->jastrow.factor_en); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->jastrow.factor_en_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute + :PROPERTIES: + :Name: qmckl_compute_factor_en + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_factor_en_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 nucleii | + | int64_t | type_nucl_num | in | Number of unique nuclei | + | int64_t | type_nucl_vector[nucl_num] | in | IDs of unique nucleii | + | int64_t | aord_num | in | Number of coefficients | + | double | aord_vector[aord_num + 1][type_nucl_num] | in | List of coefficients | + | double | en_distance_rescaled[walk_num][nucl_num][elec_num] | in | Electron-nucleus distances | + | double | factor_en[walk_num] | out | Electron-nucleus jastrow | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_factor_en_f(context, walk_num, elec_num, nucl_num, type_nucl_num, & + type_nucl_vector, aord_num, aord_vector, & + en_distance_rescaled, factor_en) & + result(info) + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer*8 , intent(in) :: walk_num, elec_num, aord_num, nucl_num, type_nucl_num + integer*8 , intent(in) :: type_nucl_vector(nucl_num) + double precision , intent(in) :: aord_vector(aord_num + 1, type_nucl_num) + double precision , intent(in) :: en_distance_rescaled(walk_num, nucl_num, elec_num) + double precision , intent(out) :: factor_en(walk_num) + + integer*8 :: i, a, p, ipar, nw + double precision :: x, spin_fact, power_ser + + 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 + + if (nucl_num <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + if (aord_num <= 0) then + info = QMCKL_INVALID_ARG_7 + return + endif + + factor_en = 0.0d0 + + do nw =1, walk_num + do a = 1, nucl_num + do i = 1, elec_num + x = en_distance_rescaled(nw, a, i) + power_ser = 0.0d0 + + do p = 2, aord_num + x = x * en_distance_rescaled(nw, a, i) + power_ser = power_ser + aord_vector(p + 1, type_nucl_vector(a)) * x + end do + + factor_en(nw) = factor_en(nw) + aord_vector(1, type_nucl_vector(a)) * & + en_distance_rescaled(nw, a, i) / & + (1.0d0 + aord_vector(2, type_nucl_vector(a)) * & + en_distance_rescaled(nw, a, i)) & + + power_ser + + end do + end do + end do + +end function qmckl_compute_factor_en_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_factor_en_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_factor_en ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const int64_t nucl_num, + const int64_t type_nucl_num, + const int64_t* type_nucl_vector, + const int64_t aord_num, + const double* aord_vector, + const double* en_distance_rescaled, + double* const factor_en ); + #+end_src + + + #+CALL: generate_c_interface(table=qmckl_factor_en_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_factor_en & + (context, & + walk_num, & + elec_num, & + nucl_num, & + type_nucl_num, & + type_nucl_vector, & + aord_num, & + aord_vector, & + en_distance_rescaled, & + factor_en) & + 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 + integer (c_int64_t) , intent(in) , value :: type_nucl_num + integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num) + integer (c_int64_t) , intent(in) , value :: aord_num + real (c_double ) , intent(in) :: aord_vector(aord_num + 1, type_nucl_num) + real (c_double ) , intent(in) :: en_distance_rescaled(walk_num, nucl_num, elec_num) + real (c_double ) , intent(out) :: factor_en(walk_num) + + integer(c_int32_t), external :: qmckl_compute_factor_en_f + info = qmckl_compute_factor_en_f & + (context, & + walk_num, & + elec_num, & + nucl_num, & + type_nucl_num, & + type_nucl_vector, & + aord_num, & + aord_vector, & + en_distance_rescaled, & + factor_en) + + end function qmckl_compute_factor_en + #+end_src + +*** Test + #+begin_src python :results output :exports none :noweb yes +import numpy as np + +<> + +factor_en = 0.0 +for a in range(0,nucl_num): + for i in range(0,elec_num): + x = en_distance_rescaled[i][a] + pow_ser = 0.0 + + for p in range(2,aord_num+1): + x = x * en_distance_rescaled[i][a] + pow_ser = pow_ser + aord_vector[(p-1) + 1][type_nucl_vector[a]-1] * x + + factor_en = factor_en + aord_vector[0][type_nucl_vector[a]-1] * en_distance_rescaled[i][a] \ + / (1.0 + aord_vector[1][type_nucl_vector[a]-1] * en_distance_rescaled[i][a]) \ + + pow_ser +print("factor_en :",factor_en) + + #+end_src + + #+RESULTS: + : factor_en : -5.865822569188727 + + + #+begin_src c :tangle (eval c_test) +/* Check if Jastrow is properly initialized */ +assert(qmckl_jastrow_provided(context)); + +double factor_en[walk_num]; +rc = qmckl_get_jastrow_factor_en(context, factor_en); + +// calculate factor_en +assert(fabs(factor_en[0]+5.865822569188727) < 1.e-12); + + #+end_src + +** Electron-nucleus component derivative \(f'_{en}\) + Calculate the electron-electron jastrow component ~factor_en_deriv_e~ derivative + with respect to the electron coordinates using the ~en_distance_rescaled~ and + ~en_distance_rescaled_deriv_e~ which are already calculated previously. + + TODO: write equations. + +*** Get + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_jastrow_factor_en_deriv_e(qmckl_context context, double* const factor_en_deriv_e); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_jastrow_factor_en_deriv_e(qmckl_context context, double* const factor_en_deriv_e) +{ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_factor_en_deriv_e(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int64_t sze = ctx->electron.walk_num * 4 * ctx->electron.num; + memcpy(factor_en_deriv_e, ctx->jastrow.factor_en_deriv_e, sze*sizeof(double)); + + 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_factor_en_deriv_e(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_factor_en_deriv_e(qmckl_context context) +{ + + qmckl_exit_code rc; + + 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); + + /* Check if en rescaled distance is provided */ + rc = qmckl_provide_en_distance_rescaled(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Check if en rescaled distance derivatives is provided */ + rc = qmckl_provide_en_distance_rescaled_deriv_e(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Compute if necessary */ + if (ctx->date > ctx->jastrow.factor_en_deriv_e_date) { + + /* Allocate array */ + if (ctx->jastrow.factor_en_deriv_e == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.walk_num * 4 * ctx->electron.num * sizeof(double); + double* factor_en_deriv_e = (double*) qmckl_malloc(context, mem_info); + + if (factor_en_deriv_e == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_provide_factor_en_deriv_e", + NULL); + } + ctx->jastrow.factor_en_deriv_e = factor_en_deriv_e; + } + + qmckl_exit_code rc = + qmckl_compute_factor_en_deriv_e(context, + ctx->electron.walk_num, + ctx->electron.num, + ctx->nucleus.num, + ctx->jastrow.type_nucl_num, + ctx->jastrow.type_nucl_vector, + ctx->jastrow.aord_num, + ctx->jastrow.aord_vector, + ctx->electron.en_distance_rescaled, + ctx->electron.en_distance_rescaled_deriv_e, + ctx->jastrow.factor_en_deriv_e); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->jastrow.factor_en_deriv_e_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute + :PROPERTIES: + :Name: qmckl_compute_factor_en_deriv_e + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_factor_en_deriv_e_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 nucleii | + | int64_t | type_nucl_num | in | Number of unique nuclei | + | int64_t | type_nucl_vector[nucl_num] | in | IDs of unique nucleii | + | int64_t | aord_num | in | Number of coefficients | + | double | aord_vector[aord_num + 1][type_nucl_num] | in | List of coefficients | + | double | en_distance_rescaled[walk_num][nucl_num][elec_num] | in | Electron-nucleus distances | + | double | en_distance_rescaled_deriv_e[walk_num][4][nucl_num][elec_num] | in | Electron-nucleus distance derivatives | + | double | factor_en_deriv_e[walk_num][4][elec_num] | out | Electron-nucleus jastrow | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_factor_en_deriv_e_f(context, walk_num, elec_num, nucl_num, type_nucl_num, & + type_nucl_vector, aord_num, aord_vector, & + en_distance_rescaled, en_distance_rescaled_deriv_e, factor_en_deriv_e) & + result(info) + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer*8 , intent(in) :: walk_num, elec_num, aord_num, nucl_num, type_nucl_num + integer*8 , intent(in) :: type_nucl_vector(nucl_num) + double precision , intent(in) :: aord_vector(aord_num + 1, type_nucl_num) + double precision , intent(in) :: en_distance_rescaled(walk_num, elec_num, nucl_num) + double precision , intent(in) :: en_distance_rescaled_deriv_e(walk_num, 4, elec_num, nucl_num) + double precision , intent(out) :: factor_en_deriv_e(elec_num,4,walk_num) + + integer*8 :: i, a, p, ipar, nw, ii + double precision :: x, spin_fact, den, invden, invden2, invden3, xinv + double precision :: y, lap1, lap2, lap3, third + double precision, dimension(3) :: power_ser_g + double precision, dimension(4) :: dx + + 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 + + if (nucl_num <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + if (aord_num <= 0) then + info = QMCKL_INVALID_ARG_7 + return + endif + + factor_en_deriv_e = 0.0d0 + third = 1.0d0 / 3.0d0 + + do nw =1, walk_num + do a = 1, nucl_num + do i = 1, elec_num + x = en_distance_rescaled(nw, i, a) + if(abs(x) < 1.0d-18) continue + power_ser_g = 0.0d0 + den = 1.0d0 + aord_vector(2, type_nucl_vector(a)) * x + invden = 1.0d0 / den + invden2 = invden * invden + invden3 = invden2 * invden + xinv = 1.0d0 / x + + do ii = 1, 4 + dx(ii) = en_distance_rescaled_deriv_e(nw, ii, i, a) + end do + + lap1 = 0.0d0 + lap2 = 0.0d0 + lap3 = 0.0d0 + do ii = 1, 3 + x = en_distance_rescaled(nw, i, a) + do p = 2, aord_num + y = p * aord_vector(p + 1, type_nucl_vector(a)) * x + power_ser_g(ii) = power_ser_g(ii) + y * dx(ii) + lap1 = lap1 + (p - 1) * y * xinv * dx(ii) * dx(ii) + lap2 = lap2 + y + x = x * en_distance_rescaled(nw, i, a) + end do + + lap3 = lap3 - 2.0d0 * aord_vector(2, type_nucl_vector(a)) * dx(ii) * dx(ii) + + factor_en_deriv_e(i, ii, nw) = factor_en_deriv_e(i, ii, nw) + aord_vector(1, type_nucl_vector(a)) & + * dx(ii) * invden2 & + + power_ser_g(ii) + + end do + + ii = 4 + lap2 = lap2 * dx(ii) * third + lap3 = lap3 + den * dx(ii) + lap3 = lap3 * aord_vector(1, type_nucl_vector(a)) * invden3 + factor_en_deriv_e(i, ii, nw) = factor_en_deriv_e(i, ii, nw) + lap1 + lap2 + lap3 + + end do + end do + end do + +end function qmckl_compute_factor_en_deriv_e_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_factor_en_deriv_e_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_factor_en_deriv_e ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const int64_t nucl_num, + const int64_t type_nucl_num, + const int64_t* type_nucl_vector, + const int64_t aord_num, + const double* aord_vector, + const double* en_distance_rescaled, + const double* en_distance_rescaled_deriv_e, + double* const factor_en_deriv_e ); + #+end_src + + + #+CALL: generate_c_interface(table=qmckl_factor_en_deriv_e_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_factor_en_deriv_e & + (context, & + walk_num, & + elec_num, & + nucl_num, & + type_nucl_num, & + type_nucl_vector, & + aord_num, & + aord_vector, & + en_distance_rescaled, & + en_distance_rescaled_deriv_e, & + factor_en_deriv_e) & + 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 + integer (c_int64_t) , intent(in) , value :: type_nucl_num + integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num) + integer (c_int64_t) , intent(in) , value :: aord_num + real (c_double ) , intent(in) :: aord_vector(aord_num + 1, type_nucl_num) + real (c_double ) , intent(in) :: en_distance_rescaled(elec_num,nucl_num,walk_num) + real (c_double ) , intent(in) :: en_distance_rescaled_deriv_e(elec_num,nucl_num,4,walk_num) + real (c_double ) , intent(out) :: factor_en_deriv_e(elec_num,4,walk_num) + + integer(c_int32_t), external :: qmckl_compute_factor_en_deriv_e_f + info = qmckl_compute_factor_en_deriv_e_f & + (context, & + walk_num, & + elec_num, & + nucl_num, & + type_nucl_num, & + type_nucl_vector, & + aord_num, & + aord_vector, & + en_distance_rescaled, & + en_distance_rescaled_deriv_e, & + factor_en_deriv_e) + + end function qmckl_compute_factor_en_deriv_e + #+end_src + +*** Test + #+begin_src python :results output :exports none :noweb yes +import numpy as np + +<> + +kappa = 1.0 + +elec_coord = np.array(elec_coord)[0] +nucl_coord = np.array(nucl_coord) +elnuc_dist = np.zeros(shape=(elec_num, nucl_num),dtype=float) +for i in range(elec_num): + for j in range(nucl_num): + elnuc_dist[i, j] = np.linalg.norm(elec_coord[i] - nucl_coord[:,j]) + +elnuc_dist_deriv_e = np.zeros(shape=(4, elec_num, nucl_num),dtype=float) +for a in range(nucl_num): + for i in range(elec_num): + rij_inv = 1.0 / elnuc_dist[i, a] + for ii in range(3): + elnuc_dist_deriv_e[ii, i, a] = (elec_coord[i][ii] - nucl_coord[ii][a]) * rij_inv + elnuc_dist_deriv_e[3, i, a] = 2.0 * rij_inv + +en_distance_rescaled_deriv_e = np.zeros(shape=(4,elec_num,nucl_num),dtype=float) +for a in range(nucl_num): + for i in range(elec_num): + f = 1.0 - kappa * en_distance_rescaled[i][a] + for ii in range(4): + en_distance_rescaled_deriv_e[ii][i][a] = elnuc_dist_deriv_e[ii][i][a] + en_distance_rescaled_deriv_e[3][i][a] = en_distance_rescaled_deriv_e[3][i][a] + \ + (-kappa * en_distance_rescaled_deriv_e[0][i][a] * en_distance_rescaled_deriv_e[0][i][a]) + \ + (-kappa * en_distance_rescaled_deriv_e[1][i][a] * en_distance_rescaled_deriv_e[1][i][a]) + \ + (-kappa * en_distance_rescaled_deriv_e[2][i][a] * en_distance_rescaled_deriv_e[2][i][a]) + for ii in range(4): + en_distance_rescaled_deriv_e[ii][i][a] = en_distance_rescaled_deriv_e[ii][i][a] * f + +third = 1.0 / 3.0 +factor_en_deriv_e = np.zeros(shape=(4,elec_num),dtype=float) +dx = np.zeros(shape=(4),dtype=float) +pow_ser_g = np.zeros(shape=(3),dtype=float) +for a in range(nucl_num): + for i in range(elec_num): + x = en_distance_rescaled[i][a] + if abs(x) < 1e-18: + continue + pow_ser_g = np.zeros(shape=(3),dtype=float) + den = 1.0 + aord_vector[1][type_nucl_vector[a]-1] * x + invden = 1.0 / den + invden2 = invden * invden + invden3 = invden2 * invden + xinv = 1.0 / (x + 1.0E-18) + + for ii in range(4): + dx[ii] = en_distance_rescaled_deriv_e[ii][i][a] + + lap1 = 0.0 + lap2 = 0.0 + lap3 = 0.0 + for ii in range(3): + x = en_distance_rescaled[i][a] + if x < 1e-18: + continue + for p in range(2,aord_num+1): + y = p * aord_vector[(p-1) + 1][type_nucl_vector[a]-1] * x + pow_ser_g[ii] = pow_ser_g[ii] + y * dx[ii] + lap1 = lap1 + (p - 1) * y * xinv * dx[ii] * dx[ii] + lap2 = lap2 + y + x = x * en_distance_rescaled[i][a] + + lap3 = lap3 - 2.0 * aord_vector[1][type_nucl_vector[a]-1] * dx[ii] * dx[ii] + + factor_en_deriv_e[ii][i] = factor_en_deriv_e[ii][i] + aord_vector[0][type_nucl_vector[a]-1] * \ + dx[ii] * invden2 + pow_ser_g[ii] + + ii = 3 + lap2 = lap2 * dx[ii] * third + lap3 = lap3 + den * dx[ii] + lap3 = lap3 * (aord_vector[0][type_nucl_vector[a]-1] * invden3) + factor_en_deriv_e[ii][i] = factor_en_deriv_e[ii][i] + lap1 + lap2 + lap3 + +print("factor_en_deriv_e[0][0]:",factor_en_deriv_e[0][0]) +print("factor_en_deriv_e[1][0]:",factor_en_deriv_e[1][0]) +print("factor_en_deriv_e[2][0]:",factor_en_deriv_e[2][0]) +print("factor_en_deriv_e[3][0]:",factor_en_deriv_e[3][0]) + + + #+end_src + + #+RESULTS: + : factor_en_deriv_e[0][0]: 0.11609919541763383 + : factor_en_deriv_e[1][0]: -0.23301394780804574 + : factor_en_deriv_e[2][0]: 0.17548337641865783 + : factor_en_deriv_e[3][0]: -0.9667363412285741 + + + #+begin_src c :tangle (eval c_test) +/* Check if Jastrow is properly initialized */ +assert(qmckl_jastrow_provided(context)); + +// calculate factor_en_deriv_e +double factor_en_deriv_e[walk_num][4][elec_num]; +rc = qmckl_get_jastrow_factor_en_deriv_e(context, &(factor_en_deriv_e[0][0][0])); + +// check factor_en_deriv_e +assert(fabs(factor_en_deriv_e[0][0][0]-0.11609919541763383) < 1.e-12); +assert(fabs(factor_en_deriv_e[0][1][0]+0.23301394780804574) < 1.e-12); +assert(fabs(factor_en_deriv_e[0][2][0]-0.17548337641865783) < 1.e-12); +assert(fabs(factor_en_deriv_e[0][3][0]+0.9667363412285741 ) < 1.e-12); + + #+end_src + +** Electron-electron rescaled distances for each order + + ~een_rescaled_e~ stores the table of the rescaled distances between all + pairs of electrons and raised to the power \(p\) defined by ~cord_num~: + + \[ + C_{ij,p} = \left( 1 - \exp{-\kappa C_{ij}} \right)^p + \] + + where \(C_{ij}\) is the matrix of electron-electron distances. + +*** Get + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_jastrow_een_rescaled_e(qmckl_context context, double* const distance_rescaled); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_jastrow_een_rescaled_e(qmckl_context context, double* const distance_rescaled) +{ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_een_rescaled_e(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.num * ctx->electron.num * ctx->electron.walk_num * (ctx->jastrow.cord_num + 1); + memcpy(distance_rescaled, ctx->jastrow.een_rescaled_e, sze * sizeof(double)); + + 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_een_rescaled_e(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_een_rescaled_e(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); + + /* Check if ee distance is provided */ + qmckl_exit_code rc = qmckl_provide_ee_distance(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Compute if necessary */ + if (ctx->date > ctx->jastrow.een_rescaled_e_date) { + + /* Allocate array */ + if (ctx->jastrow.een_rescaled_e == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.num * ctx->electron.num * + ctx->electron.walk_num * (ctx->jastrow.cord_num + 1) * sizeof(double); + double* een_rescaled_e = (double*) qmckl_malloc(context, mem_info); + + if (een_rescaled_e == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_een_rescaled_e", + NULL); + } + ctx->jastrow.een_rescaled_e = een_rescaled_e; + } + + qmckl_exit_code rc = + qmckl_compute_een_rescaled_e(context, + ctx->electron.walk_num, + ctx->electron.num, + ctx->jastrow.cord_num, + ctx->electron.rescale_factor_kappa_ee, + ctx->electron.ee_distance, + ctx->jastrow.een_rescaled_e); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->jastrow.een_rescaled_e_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute + :PROPERTIES: + :Name: qmckl_compute_een_rescaled_e + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_factor_een_rescaled_e_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 | cord_num | in | Order of polynomials | + | double | rescale_factor_kappa_ee | in | Factor to rescale ee distances | + | double | ee_distance[walk_num][elec_num][elec_num] | in | Electron-electron distances | + | double | een_rescaled_e[walk_num][elec_num][elec_num][0:cord_num] | out | Electron-electron rescaled distances | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_een_rescaled_e_f(context, walk_num, elec_num, cord_num, rescale_factor_kappa_ee, & + ee_distance, een_rescaled_e) & + 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) :: cord_num + double precision , intent(in) :: rescale_factor_kappa_ee + double precision , intent(in) :: ee_distance(elec_num,elec_num,walk_num) + double precision , intent(out) :: een_rescaled_e(0:cord_num,elec_num,elec_num,walk_num) + double precision,dimension(:,:),allocatable :: een_rescaled_e_ij + double precision :: x + integer*8 :: i, j, k, l, nw + + allocate(een_rescaled_e_ij(elec_num * (elec_num - 1) / 2, cord_num + 1)) + + + 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 + + if (cord_num <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + ! Prepare table of exponentiated distances raised to appropriate power + een_rescaled_e = 0.0d0 + do nw = 1, walk_num + een_rescaled_e_ij = 0.0d0 + een_rescaled_e_ij(:, 1) = 1.0d0 + + k = 0 + do j = 1, elec_num + do i = 1, j - 1 + k = k + 1 + een_rescaled_e_ij(k, 2) = dexp(-rescale_factor_kappa_ee * ee_distance(i, j, nw)) + end do + end do + + do l = 2, cord_num + do k = 1, elec_num * (elec_num - 1)/2 + een_rescaled_e_ij(k, l + 1) = een_rescaled_e_ij(k, l + 1 - 1) * een_rescaled_e_ij(k, 2) + end do + end do + + ! prepare the actual een table + een_rescaled_e(0, :, :, nw) = 1.0d0 + do l = 1, cord_num + k = 0 + do j = 1, elec_num + do i = 1, j - 1 + k = k + 1 + x = een_rescaled_e_ij(k, l + 1) + een_rescaled_e(l, i, j, nw) = x + een_rescaled_e(l, j, i, nw) = x + end do + end do + end do + end do + +end function qmckl_compute_een_rescaled_e_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_factor_een_rescaled_e_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_een_rescaled_e ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const int64_t cord_num, + const double rescale_factor_kappa_ee, + const double* ee_distance, + double* const een_rescaled_e ); + #+end_src + + #+CALL: generate_c_interface(table=qmckl_factor_een_rescaled_e_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_een_rescaled_e & + (context, walk_num, elec_num, cord_num, rescale_factor_kappa_ee, ee_distance, een_rescaled_e) & + 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 :: cord_num + real (c_double ) , intent(in) , value :: rescale_factor_kappa_ee + real (c_double ) , intent(in) :: ee_distance(elec_num,elec_num,walk_num) + real (c_double ) , intent(out) :: een_rescaled_e(0:cord_num,elec_num,elec_num,walk_num) + + integer(c_int32_t), external :: qmckl_compute_een_rescaled_e_f + info = qmckl_compute_een_rescaled_e_f & + (context, walk_num, elec_num, cord_num, rescale_factor_kappa_ee, ee_distance, een_rescaled_e) + + end function qmckl_compute_een_rescaled_e + #+end_src + +*** Test + + #+begin_src python :results output :exports none :noweb yes +import numpy as np + +<> + +elec_coord = np.array(elec_coord)[0] +elec_dist = np.zeros(shape=(elec_num, elec_num),dtype=float) +for i in range(elec_num): + for j in range(elec_num): + elec_dist[i, j] = np.linalg.norm(elec_coord[i] - elec_coord[j]) + +kappa = 1.0 + +een_rescaled_e_ij = np.zeros(shape=(elec_num * (elec_num - 1)//2, cord_num+1), dtype=float) +een_rescaled_e_ij[:,0] = 1.0 + +k = 0 +for j in range(elec_num): + for i in range(j): + een_rescaled_e_ij[k, 1] = np.exp(-kappa * elec_dist[i, j]) + k = k + 1 + +for l in range(2, cord_num + 1): + for k in range(elec_num * (elec_num - 1)//2): + een_rescaled_e_ij[k, l] = een_rescaled_e_ij[k, l - 1] * een_rescaled_e_ij[k, 1] + +een_rescaled_e = np.zeros(shape=(elec_num, elec_num, cord_num + 1), dtype=float) +een_rescaled_e[:,:,0] = 1.0 + +for l in range(1,cord_num+1): + k = 0 + for j in range(elec_num): + for i in range(j): + x = een_rescaled_e_ij[k, l] + een_rescaled_e[i, j, l] = x + een_rescaled_e[j, i, l] = x + k = k + 1 + +print(" een_rescaled_e[0, 2, 1] = ",een_rescaled_e[0, 2, 1]) +print(" een_rescaled_e[0, 3, 1] = ",een_rescaled_e[0, 3, 1]) +print(" een_rescaled_e[0, 4, 1] = ",een_rescaled_e[0, 4, 1]) +print(" een_rescaled_e[1, 3, 2] = ",een_rescaled_e[1, 3, 2]) +print(" een_rescaled_e[1, 4, 2] = ",een_rescaled_e[1, 4, 2]) +print(" een_rescaled_e[1, 5, 2] = ",een_rescaled_e[1, 5, 2]) + #+end_src + + #+RESULTS: + : een_rescaled_e[0, 2, 1] = 0.08084493981483197 + : een_rescaled_e[0, 3, 1] = 0.1066745707571846 + : een_rescaled_e[0, 4, 1] = 0.01754273169464735 + : een_rescaled_e[1, 3, 2] = 0.02214680362033448 + : een_rescaled_e[1, 4, 2] = 0.0005700154999202759 + : een_rescaled_e[1, 5, 2] = 0.3424402276009091 + + #+begin_src c :tangle (eval c_test) +assert(qmckl_electron_provided(context)); + + +double een_rescaled_e[walk_num][elec_num][elec_num][(cord_num + 1)]; +rc = qmckl_get_jastrow_een_rescaled_e(context, &(een_rescaled_e[0][0][0][0])); + +// value of (0,2,1) +assert(fabs(een_rescaled_e[0][0][2][1]-0.08084493981483197) < 1.e-12); +assert(fabs(een_rescaled_e[0][0][3][1]-0.1066745707571846) < 1.e-12); +assert(fabs(een_rescaled_e[0][0][4][1]-0.01754273169464735) < 1.e-12); +assert(fabs(een_rescaled_e[0][1][3][2]-0.02214680362033448) < 1.e-12); +assert(fabs(een_rescaled_e[0][1][4][2]-0.0005700154999202759) < 1.e-12); +assert(fabs(een_rescaled_e[0][1][5][2]-0.3424402276009091) < 1.e-12); + + #+end_src + +** Electron-electron rescaled distances for each order and derivatives + + ~een_rescaled_e~ stores the table of the rescaled distances between all + pairs of electrons and raised to the power \(p\) defined by ~cord_num~. + Here we take its derivatives required for the een jastrow. + + TODO: write formulae + + +*** Get + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_jastrow_een_rescaled_e_deriv_e(qmckl_context context, double* const distance_rescaled); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_jastrow_een_rescaled_e_deriv_e(qmckl_context context, double* const distance_rescaled) +{ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_een_rescaled_e_deriv_e(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.num * 4 * ctx->electron.num * ctx->electron.walk_num * (ctx->jastrow.cord_num + 1); + memcpy(distance_rescaled, ctx->jastrow.een_rescaled_e_deriv_e, sze * sizeof(double)); + + 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_een_rescaled_e_deriv_e(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_een_rescaled_e_deriv_e(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); + + /* Check if ee distance is provided */ + qmckl_exit_code rc = qmckl_provide_een_rescaled_e(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Compute if necessary */ + if (ctx->date > ctx->jastrow.een_rescaled_e_deriv_e_date) { + + /* Allocate array */ + if (ctx->jastrow.een_rescaled_e_deriv_e == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.num * 4 * ctx->electron.num * + ctx->electron.walk_num * (ctx->jastrow.cord_num + 1) * sizeof(double); + double* een_rescaled_e_deriv_e = (double*) qmckl_malloc(context, mem_info); + + if (een_rescaled_e_deriv_e == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_een_rescaled_e_deriv_e", + NULL); + } + ctx->jastrow.een_rescaled_e_deriv_e = een_rescaled_e_deriv_e; + } + + qmckl_exit_code rc = + qmckl_compute_factor_een_rescaled_e_deriv_e(context, + ctx->electron.walk_num, + ctx->electron.num, + ctx->jastrow.cord_num, + ctx->electron.rescale_factor_kappa_ee, + ctx->electron.coord_new, + ctx->electron.ee_distance, + ctx->jastrow.een_rescaled_e, + ctx->jastrow.een_rescaled_e_deriv_e); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->jastrow.een_rescaled_e_deriv_e_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute + :PROPERTIES: + :Name: qmckl_compute_een_rescaled_e_deriv_e + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_factor_een_rescaled_e_deriv_e_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 | cord_num | in | Order of polynomials | + | double | rescale_factor_kappa_ee | in | Factor to rescale ee distances | + | double | coord_new[walk_num][3][elec_num] | in | Electron coordinates | + | double | ee_distance[walk_num][elec_num][elec_num] | in | Electron-electron distances | + | double | een_rescaled_e[walk_num][elec_num][elec_num][0:cord_num] | in | Electron-electron distances | + | double | een_rescaled_e_deriv_e[walk_num][elec_num][4][elec_num][0:cord_num] | out | Electron-electron rescaled distances | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_factor_een_rescaled_e_deriv_e_f(context, walk_num, elec_num, cord_num, rescale_factor_kappa_ee, & + coord_new, ee_distance, een_rescaled_e, een_rescaled_e_deriv_e) & + 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) :: cord_num + double precision , intent(in) :: rescale_factor_kappa_ee + double precision , intent(in) :: coord_new(elec_num,3,walk_num) + double precision , intent(in) :: ee_distance(elec_num,elec_num,walk_num) + double precision , intent(in) :: een_rescaled_e(0:cord_num,elec_num,elec_num,walk_num) + double precision , intent(out) :: een_rescaled_e_deriv_e(0:cord_num,elec_num,4,elec_num,walk_num) + double precision,dimension(:,:,:),allocatable :: elec_dist_deriv_e + double precision :: x, rij_inv, kappa_l + integer*8 :: i, j, k, l, nw, ii + + allocate(elec_dist_deriv_e(4,elec_num,elec_num)) + + 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 + + if (cord_num <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + ! Prepare table of exponentiated distances raised to appropriate power + een_rescaled_e_deriv_e = 0.0d0 + do nw = 1, walk_num + do j = 1, elec_num + do i = 1, elec_num + rij_inv = 1.0d0 / ee_distance(i, j, nw) + do ii = 1, 3 + elec_dist_deriv_e(ii, i, j) = (coord_new(i, ii, nw) - coord_new(j, ii, nw)) * rij_inv + end do + elec_dist_deriv_e(4, i, j) = 2.0d0 * rij_inv + end do + elec_dist_deriv_e(:, j, j) = 0.0d0 + end do + + ! prepare the actual een table + do l = 1, cord_num + kappa_l = - dble(l) * rescale_factor_kappa_ee + do j = 1, elec_num + do i = 1, elec_num + do ii = 1, 4 + een_rescaled_e_deriv_e(l, i, ii, j, nw) = kappa_l * elec_dist_deriv_e(ii, i, j) + end do + + een_rescaled_e_deriv_e(l, i, 4, j, nw) = een_rescaled_e_deriv_e(l, i, 4, j, nw) & + + een_rescaled_e_deriv_e(l, i, 1, j, nw) * een_rescaled_e_deriv_e(l, i, 1, j, nw) & + + een_rescaled_e_deriv_e(l, i, 2, j, nw) * een_rescaled_e_deriv_e(l, i, 2, j, nw) & + + een_rescaled_e_deriv_e(l, i, 3, j, nw) * een_rescaled_e_deriv_e(l, i, 3, j, nw) + + do ii = 1, 4 + een_rescaled_e_deriv_e(l, i, ii, j, nw) = een_rescaled_e_deriv_e(l, i, ii, j, nw) * & + een_rescaled_e(l, i, j, nw) + end do + end do + end do + end do + end do + +end function qmckl_compute_factor_een_rescaled_e_deriv_e_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_factor_een_rescaled_e_deriv_e_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_factor_een_rescaled_e_deriv_e ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const int64_t cord_num, + const double rescale_factor_kappa_ee, + const double* coord_new, + const double* ee_distance, + const double* een_rescaled_e, + double* const een_rescaled_e_deriv_e ); + #+end_src + + + #+CALL: generate_c_interface(table=qmckl_factor_een_rescaled_e_deriv_e_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_factor_een_rescaled_e_deriv_e & + (context, & + walk_num, & + elec_num, & + cord_num, & + rescale_factor_kappa_ee, & + coord_new, & + ee_distance, & + een_rescaled_e, & + een_rescaled_e_deriv_e) & + 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 :: cord_num + real (c_double ) , intent(in) , value :: rescale_factor_kappa_ee + real (c_double ) , intent(in) :: coord_new(elec_num,3,walk_num) + real (c_double ) , intent(in) :: ee_distance(elec_num,elec_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_e(0:cord_num,elec_num,elec_num,walk_num) + real (c_double ) , intent(out) :: een_rescaled_e_deriv_e(0:cord_num,elec_num,4,elec_num,walk_num) + + integer(c_int32_t), external :: qmckl_compute_factor_een_rescaled_e_deriv_e_f + info = qmckl_compute_factor_een_rescaled_e_deriv_e_f & + (context, & + walk_num, & + elec_num, & + cord_num, & + rescale_factor_kappa_ee, & + coord_new, & + ee_distance, & + een_rescaled_e, & + een_rescaled_e_deriv_e) + + end function qmckl_compute_factor_een_rescaled_e_deriv_e + #+end_src + +*** Test + + #+begin_src python :results output :exports none :noweb yes +import numpy as np + +<> + +elec_coord = np.array(elec_coord)[0] +elec_dist = np.zeros(shape=(elec_num, elec_num),dtype=float) +for i in range(elec_num): + for j in range(elec_num): + elec_dist[i, j] = np.linalg.norm(elec_coord[i] - elec_coord[j]) + +kappa = 1.0 + +een_rescaled_e_ij = np.zeros(shape=(elec_num * (elec_num - 1)//2, cord_num+1), dtype=float) +een_rescaled_e_ij[:,0] = 1.0 + +k = 0 +for j in range(elec_num): + for i in range(j): + een_rescaled_e_ij[k, 1] = np.exp(-kappa * elec_dist[i, j]) + k = k + 1 + +for l in range(2, cord_num + 1): + for k in range(elec_num * (elec_num - 1)//2): + een_rescaled_e_ij[k, l] = een_rescaled_e_ij[k, l - 1] * een_rescaled_e_ij[k, 1] + +een_rescaled_e = np.zeros(shape=(elec_num, elec_num, cord_num + 1), dtype=float) +een_rescaled_e[:,:,0] = 1.0 + +for l in range(1,cord_num+1): + k = 0 + for j in range(elec_num): + for i in range(j): + x = een_rescaled_e_ij[k, l] + een_rescaled_e[i, j, l] = x + een_rescaled_e[j, i, l] = x + k = k + 1 + +print(" een_rescaled_e[0, 2, 1] = ",een_rescaled_e[0, 2, 1]) +print(" een_rescaled_e[0, 3, 1] = ",een_rescaled_e[0, 3, 1]) +print(" een_rescaled_e[0, 4, 1] = ",een_rescaled_e[0, 4, 1]) +print(" een_rescaled_e[1, 3, 2] = ",een_rescaled_e[1, 3, 2]) +print(" een_rescaled_e[1, 4, 2] = ",een_rescaled_e[1, 4, 2]) +print(" een_rescaled_e[1, 5, 2] = ",een_rescaled_e[1, 5, 2]) + #+end_src + + #+RESULTS: + : een_rescaled_e[0, 2, 1] = 0.08084493981483197 + : een_rescaled_e[0, 3, 1] = 0.1066745707571846 + : een_rescaled_e[0, 4, 1] = 0.01754273169464735 + : een_rescaled_e[1, 3, 2] = 0.02214680362033448 + : een_rescaled_e[1, 4, 2] = 0.0005700154999202759 + : een_rescaled_e[1, 5, 2] = 0.3424402276009091 + + #+begin_src c :tangle (eval c_test) +//assert(qmckl_electron_provided(context)); + + #+end_src + +** Electron-nucleus rescaled distances for each order + + ~een_rescaled_n~ stores the table of the rescaled distances between + electrons and nucleii raised to the power \(p\) defined by ~cord_num~: + + \[ + C_{ia,p} = \left( 1 - \exp{-\kappa C_{ia}} \right)^p + \] + + where \(C_{ia}\) is the matrix of electron-nucleus distances. + +*** Get + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_jastrow_een_rescaled_n(qmckl_context context, double* const distance_rescaled); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_jastrow_een_rescaled_n(qmckl_context context, double* const distance_rescaled) +{ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_een_rescaled_n(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.num * ctx->nucleus.num * ctx->electron.walk_num * (ctx->jastrow.cord_num + 1); + memcpy(distance_rescaled, ctx->jastrow.een_rescaled_n, sze * sizeof(double)); + + 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_een_rescaled_n(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_een_rescaled_n(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); + + /* Check if ee distance is provided */ + qmckl_exit_code rc = qmckl_provide_en_distance(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Compute if necessary */ + if (ctx->date > ctx->jastrow.een_rescaled_n_date) { + + /* Allocate array */ + if (ctx->jastrow.een_rescaled_n == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.num * ctx->nucleus.num * + ctx->electron.walk_num * (ctx->jastrow.cord_num + 1) * sizeof(double); + double* een_rescaled_n = (double*) qmckl_malloc(context, mem_info); + + if (een_rescaled_n == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_een_rescaled_n", + NULL); + } + ctx->jastrow.een_rescaled_n = een_rescaled_n; + } + + qmckl_exit_code rc = + qmckl_compute_een_rescaled_n(context, + ctx->electron.walk_num, + ctx->electron.num, + ctx->nucleus.num, + ctx->jastrow.cord_num, + ctx->electron.rescale_factor_kappa_en, + ctx->electron.en_distance, + ctx->jastrow.een_rescaled_n); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->jastrow.een_rescaled_n_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute + :PROPERTIES: + :Name: qmckl_compute_een_rescaled_n + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_factor_een_rescaled_n_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 atoms | + | int64_t | cord_num | in | Order of polynomials | + | double | rescale_factor_kappa_en | in | Factor to rescale ee distances | + | double | en_distance[walk_num][elec_num][nucl_num] | in | Electron-nucleus distances | + | double | een_rescaled_n[walk_num][elec_num][nucl_num][0:cord_num] | out | Electron-nucleus rescaled distances | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_een_rescaled_n_f(context, walk_num, elec_num, nucl_num, cord_num, rescale_factor_kappa_en, & + en_distance, een_rescaled_n) & + 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 + integer*8 , intent(in) :: cord_num + double precision , intent(in) :: rescale_factor_kappa_en + double precision , intent(in) :: en_distance(elec_num,nucl_num,walk_num) + double precision , intent(out) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num) + double precision :: x + integer*8 :: i, a, k, l, nw + + 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 + + if (nucl_num <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + if (cord_num <= 0) then + info = QMCKL_INVALID_ARG_5 + return + endif + + ! Prepare table of exponentiated distances raised to appropriate power + een_rescaled_n = 0.0d0 + do nw = 1, walk_num + + ! prepare the actual een table + een_rescaled_n(0, :, :, nw) = 1.0d0 + + do a = 1, nucl_num + do i = 1, elec_num + een_rescaled_n(1, a, i, nw) = dexp(-rescale_factor_kappa_en * en_distance(i, a, nw)) + end do + end do + + do l = 2, cord_num + do a = 1, nucl_num + do i = 1, elec_num + een_rescaled_n(l, a, i, nw) = een_rescaled_n(l - 1, a, i, nw) * een_rescaled_n(1, a, i, nw) + end do + end do + end do + end do + +end function qmckl_compute_een_rescaled_n_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_factor_een_rescaled_n_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_een_rescaled_n ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const int64_t nucl_num, + const int64_t cord_num, + const double rescale_factor_kappa_en, + const double* en_distance, + double* const een_rescaled_n ); + #+end_src + + #+CALL: generate_c_interface(table=qmckl_factor_een_rescaled_n_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_een_rescaled_n & + (context, & + walk_num, & + elec_num, & + nucl_num, & + cord_num, & + rescale_factor_kappa_en, & + en_distance, & + een_rescaled_n) & + 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 + integer (c_int64_t) , intent(in) , value :: cord_num + real (c_double ) , intent(in) , value :: rescale_factor_kappa_en + real (c_double ) , intent(in) :: en_distance(nucl_num,elec_num,walk_num) + real (c_double ) , intent(out) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num) + + integer(c_int32_t), external :: qmckl_compute_een_rescaled_n_f + info = qmckl_compute_een_rescaled_n_f & + (context, & + walk_num, & + elec_num, & + nucl_num, & + cord_num, & + rescale_factor_kappa_en, & + en_distance, & + een_rescaled_n) + + end function qmckl_compute_een_rescaled_n + #+end_src + +*** Test + + #+begin_src python :results output :exports none :noweb yes +import numpy as np + +<> + +elec_coord = np.array(elec_coord)[0] +nucl_coord = np.array(nucl_coord) +elnuc_dist = np.zeros(shape=(elec_num, nucl_num),dtype=float) +for i in range(elec_num): + for a in range(nucl_num): + elnuc_dist[i, a] = np.linalg.norm(elec_coord[i] - nucl_coord[:,a]) + +kappa = 1.0 + +een_rescaled_n = np.zeros(shape=(nucl_num, elec_num, cord_num + 1), dtype=float) +een_rescaled_n[:,:,0] = 1.0 + +for a in range(nucl_num): + for i in range(elec_num): + een_rescaled_n[a, i, 1] = np.exp(-kappa * elnuc_dist[i, a]) + +for l in range(2,cord_num+1): + for a in range(nucl_num): + for i in range(elec_num): + een_rescaled_n[a, i, l] = een_rescaled_n[a, i, l - 1] * een_rescaled_n[a, i, 1] + +print(" een_rescaled_n[0, 2, 1] = ",een_rescaled_n[0, 2, 1]) +print(" een_rescaled_n[0, 3, 1] = ",een_rescaled_n[0, 3, 1]) +print(" een_rescaled_n[0, 4, 1] = ",een_rescaled_n[0, 4, 1]) +print(" een_rescaled_n[1, 3, 2] = ",een_rescaled_n[1, 3, 2]) +print(" een_rescaled_n[1, 4, 2] = ",een_rescaled_n[1, 4, 2]) +print(" een_rescaled_n[1, 5, 2] = ",een_rescaled_n[1, 5, 2]) + #+end_src + + #+RESULTS: + : een_rescaled_n[0, 2, 1] = 0.10612983920006765 + : een_rescaled_n[0, 3, 1] = 0.135652809635553 + : een_rescaled_n[0, 4, 1] = 0.023391817607642338 + : een_rescaled_n[1, 3, 2] = 0.880957224822116 + : een_rescaled_n[1, 4, 2] = 0.027185942659395074 + : een_rescaled_n[1, 5, 2] = 0.01343938025140174 + + #+begin_src c :tangle (eval c_test) +assert(qmckl_electron_provided(context)); + +double een_rescaled_n[walk_num][elec_num][nucl_num][(cord_num + 1)]; +rc = qmckl_get_jastrow_een_rescaled_n(context, &(een_rescaled_n[0][0][0][0])); + +// value of (0,2,1) +assert(fabs(een_rescaled_n[0][2][0][1]-0.10612983920006765) < 1.e-12); +assert(fabs(een_rescaled_n[0][3][0][1]-0.135652809635553) < 1.e-12); +assert(fabs(een_rescaled_n[0][4][0][1]-0.023391817607642338) < 1.e-12); +assert(fabs(een_rescaled_n[0][3][1][2]-0.880957224822116) < 1.e-12); +assert(fabs(een_rescaled_n[0][4][1][2]-0.027185942659395074) < 1.e-12); +assert(fabs(een_rescaled_n[0][5][1][2]-0.01343938025140174) < 1.e-12); + + #+end_src + +** Electron-nucleus rescaled distances for each order and derivatives + + ~een_rescaled_n_deriv_e~ stores the table of the rescaled distances between + electrons and nucleii raised to the power \(p\) defined by ~cord_num~: + + +*** Get + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_jastrow_een_rescaled_n_deriv_e(qmckl_context context, double* const distance_rescaled); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_jastrow_een_rescaled_n_deriv_e(qmckl_context context, double* const distance_rescaled) +{ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_een_rescaled_n_deriv_e(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.num * 4 * ctx->nucleus.num * ctx->electron.walk_num * (ctx->jastrow.cord_num + 1); + memcpy(distance_rescaled, ctx->jastrow.een_rescaled_n_deriv_e, sze * sizeof(double)); + + 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_een_rescaled_n_deriv_e(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_een_rescaled_n_deriv_e(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); + + /* Check if ee distance is provided */ + qmckl_exit_code rc = qmckl_provide_en_distance(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Check if ee distance is provided */ + rc = qmckl_provide_een_rescaled_n(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Compute if necessary */ + if (ctx->date > ctx->jastrow.een_rescaled_n_deriv_e_date) { + + /* Allocate array */ + if (ctx->jastrow.een_rescaled_n_deriv_e == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.num * 4 * ctx->nucleus.num * + ctx->electron.walk_num * (ctx->jastrow.cord_num + 1) * sizeof(double); + double* een_rescaled_n_deriv_e = (double*) qmckl_malloc(context, mem_info); + + if (een_rescaled_n_deriv_e == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_een_rescaled_n_deriv_e", + NULL); + } + ctx->jastrow.een_rescaled_n_deriv_e = een_rescaled_n_deriv_e; + } + + qmckl_exit_code rc = + qmckl_compute_factor_een_rescaled_n_deriv_e(context, + ctx->electron.walk_num, + ctx->electron.num, + ctx->nucleus.num, + ctx->jastrow.cord_num, + ctx->electron.rescale_factor_kappa_en, + ctx->electron.coord_new, + ctx->nucleus.coord, + ctx->electron.en_distance, + ctx->jastrow.een_rescaled_n, + ctx->jastrow.een_rescaled_n_deriv_e); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->jastrow.een_rescaled_n_deriv_e_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute + :PROPERTIES: + :Name: qmckl_compute_factor_een_rescaled_n_deriv_e + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_compute_factor_een_rescaled_n_deriv_e_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 atoms | + | int64_t | cord_num | in | Order of polynomials | + | double | rescale_factor_kappa_en | in | Factor to rescale ee distances | + | double | coord_new[walk_num][3][elec_num] | in | Electron coordinates | + | double | coord[3][nucl_num] | in | Nuclear coordinates | + | double | en_distance[walk_num][elec_num][nucl_num] | in | Electron-nucleus distances | + | double | een_rescaled_n[walk_num][elec_num][nucl_num][0:cord_num] | in | Electron-nucleus distances | + | double | een_rescaled_n_deriv_e[walk_num][elec_num][4][nucl_num][0:cord_num] | out | Electron-nucleus rescaled distances | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_factor_een_rescaled_n_deriv_e_f(context, walk_num, elec_num, nucl_num, & + cord_num, rescale_factor_kappa_en, & + coord_new, coord, en_distance, een_rescaled_n, een_rescaled_n_deriv_e) & + 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 + integer*8 , intent(in) :: cord_num + double precision , intent(in) :: rescale_factor_kappa_en + double precision , intent(in) :: coord_new(elec_num,3,walk_num) + double precision , intent(in) :: coord(nucl_num,3) + double precision , intent(in) :: en_distance(elec_num,nucl_num,walk_num) + double precision , intent(in) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num) + double precision , intent(out) :: een_rescaled_n_deriv_e(0:cord_num,nucl_num,4,elec_num,walk_num) + double precision,dimension(:,:,:),allocatable :: elnuc_dist_deriv_e + double precision :: x, ria_inv, kappa_l + integer*8 :: i, a, k, l, nw, ii + + allocate(elnuc_dist_deriv_e(4, elec_num, nucl_num)) + + 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 + + if (nucl_num <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + if (cord_num <= 0) then + info = QMCKL_INVALID_ARG_5 + return + endif + + ! Prepare table of exponentiated distances raised to appropriate power + een_rescaled_n_deriv_e = 0.0d0 + do nw = 1, walk_num + + ! prepare the actual een table + do a = 1, nucl_num + do i = 1, elec_num + ria_inv = 1.0d0 / en_distance(i, a, nw) + do ii = 1, 3 + elnuc_dist_deriv_e(ii, i, a) = (coord_new(i, ii, nw) - coord(a, ii)) * ria_inv + end do + elnuc_dist_deriv_e(4, i, a) = 2.0d0 * ria_inv + end do + end do + + do l = 0, cord_num + kappa_l = - dble(l) * rescale_factor_kappa_en + do a = 1, nucl_num + do i = 1, elec_num + do ii = 1, 4 + een_rescaled_n_deriv_e(l, a, ii, i, nw) = kappa_l * elnuc_dist_deriv_e(ii, i, a) + end do + + een_rescaled_n_deriv_e(l, a, 4, i, nw) = een_rescaled_n_deriv_e(l, a, 4, i, nw) & + + een_rescaled_n_deriv_e(l, a, 1, i, nw) * een_rescaled_n_deriv_e(l, a, 1, i, nw) & + + een_rescaled_n_deriv_e(l, a, 2, i, nw) * een_rescaled_n_deriv_e(l, a, 2, i, nw) & + + een_rescaled_n_deriv_e(l, a, 3, i, nw) * een_rescaled_n_deriv_e(l, a, 3, i, nw) + + do ii = 1, 4 + een_rescaled_n_deriv_e(l, a, ii, i, nw) = een_rescaled_n_deriv_e(l, a, ii, i, nw) * & + een_rescaled_n(l, a, i, nw) + end do + end do + end do + end do + end do + +end function qmckl_compute_factor_een_rescaled_n_deriv_e_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_compute_factor_een_rescaled_n_deriv_e_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_factor_een_rescaled_n_deriv_e ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const int64_t nucl_num, + const int64_t cord_num, + const double rescale_factor_kappa_en, + const double* coord_new, + const double* coord, + const double* en_distance, + const double* een_rescaled_n, + double* const een_rescaled_n_deriv_e ); + #+end_src + + #+CALL: generate_c_interface(table=qmckl_compute_factor_een_rescaled_n_deriv_e_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_factor_een_rescaled_n_deriv_e & + (context, & + walk_num, & + elec_num, & + nucl_num, & + cord_num, & + rescale_factor_kappa_en, & + coord_new, & + coord, & + en_distance, & + een_rescaled_n, & + een_rescaled_n_deriv_e) & + 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 + integer (c_int64_t) , intent(in) , value :: cord_num + real (c_double ) , intent(in) , value :: rescale_factor_kappa_en + real (c_double ) , intent(in) :: coord_new(elec_num,3,walk_num) + real (c_double ) , intent(in) :: coord(nucl_num,3) + real (c_double ) , intent(in) :: en_distance(nucl_num,elec_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num) + real (c_double ) , intent(out) :: een_rescaled_n_deriv_e(0:cord_num,nucl_num,4,elec_num,walk_num) + + integer(c_int32_t), external :: qmckl_compute_factor_een_rescaled_n_deriv_e_f + info = qmckl_compute_factor_een_rescaled_n_deriv_e_f & + (context, & + walk_num, & + elec_num, & + nucl_num, & + cord_num, & + rescale_factor_kappa_en, & + coord_new, & + coord, & + en_distance, & + een_rescaled_n, & + een_rescaled_n_deriv_e) + + end function qmckl_compute_factor_een_rescaled_n_deriv_e + #+end_src + +*** Test + + #+begin_src python :results output :exports none :noweb yes +import numpy as np + +<> + +elec_coord = np.array(elec_coord)[0] +nucl_coord = np.array(nucl_coord) +elnuc_dist = np.zeros(shape=(elec_num, nucl_num),dtype=float) +for i in range(elec_num): + for a in range(nucl_num): + elnuc_dist[i, a] = np.linalg.norm(elec_coord[i] - nucl_coord[:,a]) + +kappa = 1.0 + +een_rescaled_n = np.zeros(shape=(nucl_num, elec_num, cord_num + 1), dtype=float) +een_rescaled_n[:,:,0] = 1.0 + +for a in range(nucl_num): + for i in range(elec_num): + een_rescaled_n[a, i, 1] = np.exp(-kappa * elnuc_dist[i, a]) + +for l in range(2,cord_num+1): + for a in range(nucl_num): + for i in range(elec_num): + een_rescaled_n[a, i, l] = een_rescaled_n[a, i, l - 1] * een_rescaled_n[a, i, 1] + +print(" een_rescaled_n[0, 2, 1] = ",een_rescaled_n[0, 2, 1]) +print(" een_rescaled_n[0, 3, 1] = ",een_rescaled_n[0, 3, 1]) +print(" een_rescaled_n[0, 4, 1] = ",een_rescaled_n[0, 4, 1]) +print(" een_rescaled_n[1, 3, 2] = ",een_rescaled_n[1, 3, 2]) +print(" een_rescaled_n[1, 4, 2] = ",een_rescaled_n[1, 4, 2]) +print(" een_rescaled_n[1, 5, 2] = ",een_rescaled_n[1, 5, 2]) + #+end_src + + #+RESULTS: + : een_rescaled_n[0, 2, 1] = 0.10612983920006765 + : een_rescaled_n[0, 3, 1] = 0.135652809635553 + : een_rescaled_n[0, 4, 1] = 0.023391817607642338 + : een_rescaled_n[1, 3, 2] = 0.880957224822116 + : een_rescaled_n[1, 4, 2] = 0.027185942659395074 + : een_rescaled_n[1, 5, 2] = 0.01343938025140174 + + #+begin_src c :tangle (eval c_test) +//assert(qmckl_electron_provided(context)); + + #+end_src + +** Prepare for electron-electron-nucleus Jastrow \(f_{een}\) + + Prepare ~cord_vect_full~ and ~lkpm_combined_index~ tables required for the + calculation of the three-body jastrow ~factor_een~ and its derivative + ~factor_een_deriv_e~. + +*** Get + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_jastrow_dim_cord_vect(qmckl_context context, int64_t* const dim_cord_vect); +qmckl_exit_code qmckl_get_jastrow_cord_vect_full(qmckl_context context, double* const cord_vect_full); +qmckl_exit_code qmckl_get_jastrow_lkpm_combined_index(qmckl_context context, int64_t* const lkpm_combined_index); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_jastrow_dim_cord_vect(qmckl_context context, int64_t* const dim_cord_vect) +{ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_dim_cord_vect(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + *dim_cord_vect = ctx->jastrow.dim_cord_vect; + + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_get_jastrow_cord_vect_full(qmckl_context context, double* const cord_vect_full) +{ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_dim_cord_vect(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_cord_vect_full(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->jastrow.dim_cord_vect * ctx->nucleus.num; + memcpy(cord_vect_full, ctx->jastrow.cord_vect_full, sze * sizeof(double)); + + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_get_jastrow_lkpm_combined_index(qmckl_context context, int64_t* const lkpm_combined_index) +{ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_dim_cord_vect(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_cord_vect_full(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->jastrow.dim_cord_vect * 4; + memcpy(lkpm_combined_index, ctx->jastrow.lkpm_combined_index, sze * sizeof(double)); + + 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_dim_cord_vect(qmckl_context context); +qmckl_exit_code qmckl_provide_cord_vect_full(qmckl_context context); +qmckl_exit_code qmckl_provide_lkpm_combined_index(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_dim_cord_vect(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); + + /* Compute if necessary */ + if (ctx->date > ctx->jastrow.dim_cord_vect_date) { + + qmckl_exit_code rc = + qmckl_compute_dim_cord_vect(context, + ctx->jastrow.cord_num, + &(ctx->jastrow.dim_cord_vect)); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->jastrow.dim_cord_vect_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_provide_cord_vect_full(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); + + /* Check if dim_cord_vect is provided */ + qmckl_exit_code rc = qmckl_provide_dim_cord_vect(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Compute if necessary */ + if (ctx->date > ctx->jastrow.cord_vect_full_date) { + + /* Allocate array */ + if (ctx->jastrow.cord_vect_full == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->jastrow.dim_cord_vect * ctx->nucleus.num * sizeof(double); + double* cord_vect_full = (double*) qmckl_malloc(context, mem_info); + + if (cord_vect_full == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_provide_cord_vect_full", + NULL); + } + ctx->jastrow.cord_vect_full = cord_vect_full; + } + + qmckl_exit_code rc = + qmckl_compute_cord_vect_full(context, + ctx->nucleus.num, + ctx->jastrow.cord_num, + ctx->jastrow.dim_cord_vect, + ctx->jastrow.type_nucl_num, + ctx->jastrow.type_nucl_vector, + ctx->jastrow.cord_vector, + ctx->jastrow.cord_vect_full); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->jastrow.cord_vect_full_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_provide_lkpm_combined_index(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); + + /* Check if dim_cord_vect is provided */ + qmckl_exit_code rc = qmckl_provide_dim_cord_vect(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Compute if necessary */ + if (ctx->date > ctx->jastrow.lkpm_combined_index_date) { + + /* Allocate array */ + if (ctx->jastrow.lkpm_combined_index == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = 4 * ctx->jastrow.dim_cord_vect * sizeof(int64_t); + int64_t* lkpm_combined_index = (int64_t*) qmckl_malloc(context, mem_info); + + if (lkpm_combined_index == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_provide_lkpm_combined_index", + NULL); + } + ctx->jastrow.lkpm_combined_index = lkpm_combined_index; + } + + qmckl_exit_code rc = + qmckl_compute_lkpm_combined_index(context, + ctx->jastrow.cord_num, + ctx->jastrow.dim_cord_vect, + ctx->jastrow.lkpm_combined_index); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->jastrow.lkpm_combined_index_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute dim_cord_vect + :PROPERTIES: + :Name: qmckl_compute_dim_cord_vect + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_factor_dim_cord_vect_args + | qmckl_context | context | in | Global state | + | int64_t | cord_num | in | Order of polynomials | + | int64_t | dim_cord_vect | out | dimension of cord_vect_full table | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_dim_cord_vect_f(context, cord_num, dim_cord_vect) & + result(info) + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer*8 , intent(in) :: cord_num + integer*8 , intent(out) :: dim_cord_vect + double precision :: x + integer*8 :: i, a, k, l, p, lmax + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (cord_num <= 0) then + info = QMCKL_INVALID_ARG_2 + return + endif + + dim_cord_vect = 0 + + do p = 2, cord_num + do k = p - 1, 0, -1 + if (k .ne. 0) then + lmax = p - k + else + lmax = p - k - 2 + endif + do l = lmax, 0, -1 + if (iand(p - k - l, 1_8) == 1) cycle + dim_cord_vect = dim_cord_vect + 1 + end do + end do + end do + +end function qmckl_compute_dim_cord_vect_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_factor_dim_cord_vect_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_dim_cord_vect ( + const qmckl_context context, + const int64_t cord_num, + int64_t* const dim_cord_vect ); + #+end_src + + + #+CALL: generate_c_interface(table=qmckl_factor_dim_cord_vect_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_dim_cord_vect & + (context, cord_num, dim_cord_vect) & + 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 :: cord_num + integer (c_int64_t) , intent(out) :: dim_cord_vect + + integer(c_int32_t), external :: qmckl_compute_dim_cord_vect_f + info = qmckl_compute_dim_cord_vect_f & + (context, cord_num, dim_cord_vect) + + end function qmckl_compute_dim_cord_vect + #+end_src + +*** Compute cord_vect_full + :PROPERTIES: + :Name: qmckl_compute_cord_vect_full + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_factor_cord_vect_full_args + | qmckl_context | context | in | Global state | + | int64_t | nucl_num | in | Number of atoms | + | int64_t | cord_num | in | Order of polynomials | + | int64_t | dim_cord_vect | in | dimension of cord full table | + | int64_t | type_nucl_num | in | dimension of cord full table | + | int64_t | type_nucl_vector[nucl_num] | in | dimension of cord full table | + | double | cord_vector[cord_num][type_nucl_num] | in | dimension of cord full table | + | double | cord_vect_full[dim_cord_vect][nucl_num] | out | Full list of coefficients | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_cord_vect_full_f(context, nucl_num, cord_num, dim_cord_vect, type_nucl_num, & + type_nucl_vector, cord_vector, cord_vect_full) & + result(info) + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer*8 , intent(in) :: nucl_num + integer*8 , intent(in) :: cord_num + integer*8 , intent(in) :: dim_cord_vect + integer*8 , intent(in) :: type_nucl_num + integer*8 , intent(in) :: type_nucl_vector(nucl_num) + double precision , intent(in) :: cord_vector(cord_num, type_nucl_num) + double precision , intent(out) :: cord_vect_full(nucl_num,dim_cord_vect) + double precision :: x + integer*8 :: i, a, k, l, nw + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (nucl_num <= 0) then + info = QMCKL_INVALID_ARG_2 + return + endif + + if (cord_num <= 0) then + info = QMCKL_INVALID_ARG_3 + return + endif + + if (type_nucl_num <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + if (dim_cord_vect <= 0) then + info = QMCKL_INVALID_ARG_5 + return + endif + + + do a = 1, nucl_num + cord_vect_full(1:dim_cord_vect,a) = cord_vector(1:dim_cord_vect,type_nucl_vector(a)) + end do + +end function qmckl_compute_cord_vect_full_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_factor_cord_vect_full_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_cord_vect_full ( + const qmckl_context context, + const int64_t nucl_num, + const int64_t cord_num, + const int64_t dim_cord_vect, + const int64_t type_nucl_num, + const int64_t* type_nucl_vector, + const double* cord_vector, + double* const cord_vect_full ); + #+end_src + + + #+CALL: generate_c_interface(table=qmckl_factor_cord_vect_full_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_cord_vect_full & + (context, & + nucl_num, & + cord_num, & + dim_cord_vect, & + type_nucl_num, & + type_nucl_vector, & + cord_vector, & + cord_vect_full) & + 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 :: nucl_num + integer (c_int64_t) , intent(in) , value :: cord_num + integer (c_int64_t) , intent(in) , value :: dim_cord_vect + integer (c_int64_t) , intent(in) , value :: type_nucl_num + integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num) + real (c_double ) , intent(in) :: cord_vector(type_nucl_num,cord_num) + real (c_double ) , intent(out) :: cord_vect_full(nucl_num,dim_cord_vect) + + integer(c_int32_t), external :: qmckl_compute_cord_vect_full_f + info = qmckl_compute_cord_vect_full_f & + (context, & + nucl_num, & + cord_num, & + dim_cord_vect, & + type_nucl_num, & + type_nucl_vector, & + cord_vector, & + cord_vect_full) + + end function qmckl_compute_cord_vect_full + #+end_src + +*** Compute lkpm_combined_index + :PROPERTIES: + :Name: qmckl_compute_lkpm_combined_index + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_factor_lkpm_combined_index_args + | qmckl_context | context | in | Global state | + | int64_t | cord_num | in | Order of polynomials | + | int64_t | dim_cord_vect | in | dimension of cord full table | + | int64_t | lpkm_combined_index[4][dim_cord_vect] | out | Full list of combined indices | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_lkpm_combined_index_f(context, cord_num, dim_cord_vect, & + lkpm_combined_index) & + result(info) + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer*8 , intent(in) :: cord_num + integer*8 , intent(in) :: dim_cord_vect + integer*8 , intent(out) :: lkpm_combined_index(dim_cord_vect, 4) + double precision :: x + integer*8 :: i, a, k, l, kk, p, lmax, m + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (cord_num <= 0) then + info = QMCKL_INVALID_ARG_2 + return + endif + + if (dim_cord_vect <= 0) then + info = QMCKL_INVALID_ARG_3 + return + endif + + + kk = 0 + do p = 2, cord_num + do k = p - 1, 0, -1 + if (k .ne. 0) then + lmax = p - k + else + lmax = p - k - 2 + end if + do l = lmax, 0, -1 + if (iand(p - k - l, 1_8) .eq. 1) cycle + m = (p - k - l)/2 + kk = kk + 1 + lkpm_combined_index(kk, 1) = l + lkpm_combined_index(kk, 2) = k + lkpm_combined_index(kk, 3) = p + lkpm_combined_index(kk, 4) = m + end do + end do + end do + +end function qmckl_compute_lkpm_combined_index_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_factor_lkpm_combined_index_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_lkpm_combined_index ( + const qmckl_context context, + const int64_t cord_num, + const int64_t dim_cord_vect, + int64_t* const lpkm_combined_index ); + #+end_src + + + #+CALL: generate_c_interface(table=qmckl_factor_lkpm_combined_index_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_lkpm_combined_index & + (context, cord_num, dim_cord_vect, lpkm_combined_index) & + 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 :: cord_num + integer (c_int64_t) , intent(in) , value :: dim_cord_vect + integer (c_int64_t) , intent(out) :: lpkm_combined_index(dim_cord_vect,4) + + integer(c_int32_t), external :: qmckl_compute_lkpm_combined_index_f + info = qmckl_compute_lkpm_combined_index_f & + (context, cord_num, dim_cord_vect, lpkm_combined_index) + + end function qmckl_compute_lkpm_combined_index + #+end_src + + +*** Test + + #+begin_src python :results output :exports none :noweb yes +import numpy as np + +<> + +elec_coord = np.array(elec_coord)[0] +nucl_coord = np.array(nucl_coord) +elnuc_dist = np.zeros(shape=(elec_num, nucl_num),dtype=float) +for i in range(elec_num): + for a in range(nucl_num): + elnuc_dist[i, a] = np.linalg.norm(elec_coord[i] - nucl_coord[:,a]) + +kappa = 1.0 + +een_rescaled_n = np.zeros(shape=(nucl_num, elec_num, cord_num + 1), dtype=float) +een_rescaled_n[:,:,0] = 1.0 + +for a in range(nucl_num): + for i in range(elec_num): + een_rescaled_n[a, i, 1] = np.exp(-kappa * elnuc_dist[i, a]) + +for l in range(2,cord_num+1): + for a in range(nucl_num): + for i in range(elec_num): + een_rescaled_n[a, i, l] = een_rescaled_n[a, i, l - 1] * een_rescaled_n[a, i, 1] + +print(" een_rescaled_n[0, 2, 1] = ",een_rescaled_n[0, 2, 1]) +print(" een_rescaled_n[0, 3, 1] = ",een_rescaled_n[0, 3, 1]) +print(" een_rescaled_n[0, 4, 1] = ",een_rescaled_n[0, 4, 1]) +print(" een_rescaled_n[1, 3, 2] = ",een_rescaled_n[1, 3, 2]) +print(" een_rescaled_n[1, 4, 2] = ",een_rescaled_n[1, 4, 2]) +print(" een_rescaled_n[1, 5, 2] = ",een_rescaled_n[1, 5, 2]) + #+end_src + + #+RESULTS: + : een_rescaled_n[0, 2, 1] = 0.10612983920006765 + : een_rescaled_n[0, 3, 1] = 0.135652809635553 + : een_rescaled_n[0, 4, 1] = 0.023391817607642338 + : een_rescaled_n[1, 3, 2] = 0.880957224822116 + : een_rescaled_n[1, 4, 2] = 0.027185942659395074 + : een_rescaled_n[1, 5, 2] = 0.01343938025140174 + + #+begin_src c :tangle (eval c_test) +//assert(qmckl_electron_provided(context)); +// + + #+end_src + +** Electron-electron-nucleus Jastrow \(f_{een}\) + + Calculate the electron-electron-nuclear three-body jastrow component ~factor_een~ + using the above prepared tables. + + TODO: write equations. + +*** Get + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_jastrow_factor_een(qmckl_context context, double* const factor_een); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_jastrow_factor_een(qmckl_context context, double* const factor_een) +{ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_factor_een(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int64_t sze = ctx->electron.walk_num * ctx->electron.num; + memcpy(factor_een, ctx->jastrow.factor_een, sze*sizeof(double)); + + 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_factor_een(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_factor_een(qmckl_context context) +{ + + qmckl_exit_code rc; + + 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); + + /* Check if en rescaled distance is provided */ + rc = qmckl_provide_een_rescaled_e(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Check if en rescaled distance derivatives is provided */ + rc = qmckl_provide_een_rescaled_n(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Check if en rescaled distance derivatives is provided */ + rc = qmckl_provide_cord_vect_full(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Check if en rescaled distance derivatives is provided */ + rc = qmckl_provide_lkpm_combined_index(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Compute if necessary */ + if (ctx->date > ctx->jastrow.factor_een_date) { + + /* Allocate array */ + if (ctx->jastrow.factor_een == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.walk_num * sizeof(double); + double* factor_een = (double*) qmckl_malloc(context, mem_info); + + if (factor_een == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_provide_factor_een", + NULL); + } + ctx->jastrow.factor_een = factor_een; + } + + qmckl_exit_code rc = + qmckl_compute_factor_een(context, + ctx->electron.walk_num, + ctx->electron.num, + ctx->nucleus.num, + ctx->jastrow.cord_num, + ctx->jastrow.dim_cord_vect, + ctx->jastrow.cord_vect_full, + ctx->jastrow.lkpm_combined_index, + ctx->jastrow.een_rescaled_e, + ctx->jastrow.een_rescaled_n, + ctx->jastrow.factor_een); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->jastrow.factor_een_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute + :PROPERTIES: + :Name: qmckl_compute_factor_een + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_factor_een_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 nucleii | + | int64_t | cord_num | in | order of polynomials | + | int64_t | dim_cord_vect | in | dimension of full coefficient vector | + | double | cord_vect_full[dim_cord_vect][nucl_num] | in | full coefficient vector | + | int64_t | lkpm_combined_index[4][dim_cord_vect] | in | combined indices | + | double | een_rescaled_e[walk_num][elec_num][elec_num][0:cord_num] | in | Electron-nucleus rescaled | + | double | een_rescaled_n[walk_num][elec_num][nucl_num][0:cord_num] | in | Electron-nucleus rescaled factor | + | double | factor_een[walk_num] | out | Electron-nucleus jastrow | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_factor_een_f(context, walk_num, elec_num, nucl_num, cord_num, dim_cord_vect, & + cord_vect_full, lkpm_combined_index, & + een_rescaled_e, een_rescaled_n, factor_een) & + result(info) + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer*8 , intent(in) :: walk_num, elec_num, cord_num, nucl_num, dim_cord_vect + integer*8 , intent(in) :: lkpm_combined_index(4,dim_cord_vect) + double precision , intent(in) :: cord_vect_full(dim_cord_vect, nucl_num) + double precision , intent(in) :: een_rescaled_e(walk_num, elec_num, elec_num, 0:cord_num) + double precision , intent(in) :: een_rescaled_n(walk_num, elec_num, nucl_num, 0:cord_num) + double precision , intent(out) :: factor_een(walk_num) + + integer*8 :: i, a, j, l, k, p, m, n, nw + double precision :: accu, accu2, cn + + 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 + + if (nucl_num <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + if (cord_num <= 0) then + info = QMCKL_INVALID_ARG_5 + return + endif + + factor_een = 0.0d0 + + do nw =1, walk_num + do n = 1, dim_cord_vect + l = lkpm_combined_index(1, n) + k = lkpm_combined_index(2, n) + p = lkpm_combined_index(3, n) + m = lkpm_combined_index(4, n) + + do a = 1, nucl_num + accu2 = 0.0d0 + cn = cord_vect_full(n, a) + do j = 1, elec_num + accu = 0.0d0 + do i = 1, elec_num + accu = accu + een_rescaled_e(nw, i, j, k) * & + een_rescaled_n(nw, i, a, m) + end do + accu2 = accu2 + accu * een_rescaled_n(nw, j, a, m + l) + end do + factor_een(nw) = factor_een(nw) + accu2 + cn + end do + end do + end do + +end function qmckl_compute_factor_een_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_factor_een_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_factor_een ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const int64_t nucl_num, + const int64_t cord_num, + const int64_t dim_cord_vect, + const double* cord_vect_full, + const int64_t* lkpm_combined_index, + const double* een_rescaled_e, + const double* een_rescaled_n, + double* const factor_een ); + #+end_src + + + #+CALL: generate_c_interface(table=qmckl_factor_een_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_factor_een & + (context, & + walk_num, & + elec_num, & + nucl_num, & + cord_num, & + dim_cord_vect, & + cord_vect_full, & + lkpm_combined_index, & + een_rescaled_e, & + een_rescaled_n, & + factor_een) & + 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 + integer (c_int64_t) , intent(in) , value :: cord_num + integer (c_int64_t) , intent(in) , value :: dim_cord_vect + real (c_double ) , intent(in) :: cord_vect_full(nucl_num,dim_cord_vect) + integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_cord_vect,4) + real (c_double ) , intent(in) :: een_rescaled_e(0:cord_num,elec_num,elec_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num) + real (c_double ) , intent(out) :: factor_een(walk_num) + + integer(c_int32_t), external :: qmckl_compute_factor_een_f + info = qmckl_compute_factor_een_f & + (context, & + walk_num, & + elec_num, & + nucl_num, & + cord_num, & + dim_cord_vect, & + cord_vect_full, & + lkpm_combined_index, & + een_rescaled_e, & + een_rescaled_n, & + factor_een) + + end function qmckl_compute_factor_een + #+end_src + +*** Test + #+begin_src python :results output :exports none :noweb yes +import numpy as np + +<> + +kappa = 1.0 + +elec_coord = np.array(elec_coord)[0] +nucl_coord = np.array(nucl_coord) +elnuc_dist = np.zeros(shape=(elec_num, nucl_num),dtype=float) +for i in range(elec_num): + for j in range(nucl_num): + elnuc_dist[i, j] = np.linalg.norm(elec_coord[i] - nucl_coord[:,j]) + +elnuc_dist_deriv_e = np.zeros(shape=(4, elec_num, nucl_num),dtype=float) +for a in range(nucl_num): + for i in range(elec_num): + rij_inv = 1.0 / elnuc_dist[i, a] + for ii in range(3): + elnuc_dist_deriv_e[ii, i, a] = (elec_coord[i][ii] - nucl_coord[ii][a]) * rij_inv + elnuc_dist_deriv_e[3, i, a] = 2.0 * rij_inv + +en_distance_rescaled_deriv_e = np.zeros(shape=(4,elec_num,nucl_num),dtype=float) +for a in range(nucl_num): + for i in range(elec_num): + f = 1.0 - kappa * en_distance_rescaled[i][a] + for ii in range(4): + en_distance_rescaled_deriv_e[ii][i][a] = elnuc_dist_deriv_e[ii][i][a] + en_distance_rescaled_deriv_e[3][i][a] = en_distance_rescaled_deriv_e[3][i][a] + \ + (-kappa * en_distance_rescaled_deriv_e[0][i][a] * en_distance_rescaled_deriv_e[0][i][a]) + \ + (-kappa * en_distance_rescaled_deriv_e[1][i][a] * en_distance_rescaled_deriv_e[1][i][a]) + \ + (-kappa * en_distance_rescaled_deriv_e[2][i][a] * en_distance_rescaled_deriv_e[2][i][a]) + for ii in range(4): + en_distance_rescaled_deriv_e[ii][i][a] = en_distance_rescaled_deriv_e[ii][i][a] * f + +third = 1.0 / 3.0 +factor_en_deriv_e = np.zeros(shape=(4,elec_num),dtype=float) +dx = np.zeros(shape=(4),dtype=float) +pow_ser_g = np.zeros(shape=(3),dtype=float) +for a in range(nucl_num): + for i in range(elec_num): + x = en_distance_rescaled[i][a] + if abs(x) < 1e-18: + continue + pow_ser_g = np.zeros(shape=(3),dtype=float) + den = 1.0 + aord_vector[1][type_nucl_vector[a]-1] * x + invden = 1.0 / den + invden2 = invden * invden + invden3 = invden2 * invden + xinv = 1.0 / (x + 1.0E-18) + + for ii in range(4): + dx[ii] = en_distance_rescaled_deriv_e[ii][i][a] + + lap1 = 0.0 + lap2 = 0.0 + lap3 = 0.0 + for ii in range(3): + x = en_distance_rescaled[i][a] + if x < 1e-18: + continue + for p in range(2,aord_num+1): + y = p * aord_vector[(p-1) + 1][type_nucl_vector[a]-1] * x + pow_ser_g[ii] = pow_ser_g[ii] + y * dx[ii] + lap1 = lap1 + (p - 1) * y * xinv * dx[ii] * dx[ii] + lap2 = lap2 + y + x = x * en_distance_rescaled[i][a] + + lap3 = lap3 - 2.0 * aord_vector[1][type_nucl_vector[a]-1] * dx[ii] * dx[ii] + + factor_en_deriv_e[ii][i] = factor_en_deriv_e[ii][i] + aord_vector[0][type_nucl_vector[a]-1] * \ + dx[ii] * invden2 + pow_ser_g[ii] + + ii = 3 + lap2 = lap2 * dx[ii] * third + lap3 = lap3 + den * dx[ii] + lap3 = lap3 * (aord_vector[0][type_nucl_vector[a]-1] * invden3) + factor_en_deriv_e[ii][i] = factor_en_deriv_e[ii][i] + lap1 + lap2 + lap3 + +print("factor_en_deriv_e[0][0]:",factor_en_deriv_e[0][0]) +print("factor_en_deriv_e[1][0]:",factor_en_deriv_e[1][0]) +print("factor_en_deriv_e[2][0]:",factor_en_deriv_e[2][0]) +print("factor_en_deriv_e[3][0]:",factor_en_deriv_e[3][0]) + + + #+end_src + + #+RESULTS: + : factor_en_deriv_e[0][0]: 0.11609919541763383 + : factor_en_deriv_e[1][0]: -0.23301394780804574 + : factor_en_deriv_e[2][0]: 0.17548337641865783 + : factor_en_deriv_e[3][0]: -0.9667363412285741 + + + #+begin_src c :tangle (eval c_test) +/* Check if Jastrow is properly initialized */ +//assert(qmckl_jastrow_provided(context)); +// + + #+end_src + +** Electron-electron-nucleus Jastrow \(f_{een}\) derivative + + Calculate the electron-electron-nuclear three-body jastrow component ~factor_een_deriv_e~ + using the above prepared tables. + + TODO: write equations. + +*** Get + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_jastrow_factor_een_deriv_e(qmckl_context context, double* const factor_een_deriv_e); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_jastrow_factor_een_deriv_e(qmckl_context context, double* const factor_een_deriv_e) +{ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_factor_een_deriv_e(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int64_t sze = ctx->electron.walk_num * ctx->electron.num; + memcpy(factor_een_deriv_e, ctx->jastrow.factor_een_deriv_e, sze*sizeof(double)); + + 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_factor_een_deriv_e(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_factor_een_deriv_e(qmckl_context context) +{ + + qmckl_exit_code rc; + + 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); + + /* Check if en rescaled distance is provided */ + rc = qmckl_provide_een_rescaled_e(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Check if en rescaled distance derivatives is provided */ + rc = qmckl_provide_een_rescaled_n(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Check if en rescaled distance is provided */ + rc = qmckl_provide_een_rescaled_e_deriv_e(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Check if en rescaled distance derivatives is provided */ + rc = qmckl_provide_een_rescaled_n_deriv_e(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Check if en rescaled distance derivatives is provided */ + rc = qmckl_provide_cord_vect_full(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Check if en rescaled distance derivatives is provided */ + rc = qmckl_provide_lkpm_combined_index(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Compute if necessary */ + if (ctx->date > ctx->jastrow.factor_een_deriv_e_date) { + + /* Allocate array */ + if (ctx->jastrow.factor_een_deriv_e == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = 4 * ctx->electron.num * ctx->electron.walk_num * sizeof(double); + double* factor_een_deriv_e = (double*) qmckl_malloc(context, mem_info); + + if (factor_een_deriv_e == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_provide_factor_een_deriv_e", + NULL); + } + ctx->jastrow.factor_een_deriv_e = factor_een_deriv_e; + } + + qmckl_exit_code rc = + qmckl_compute_factor_een_deriv_e(context, + ctx->electron.walk_num, + ctx->electron.num, + ctx->nucleus.num, + ctx->jastrow.cord_num, + ctx->jastrow.dim_cord_vect, + ctx->jastrow.cord_vect_full, + ctx->jastrow.lkpm_combined_index, + ctx->jastrow.een_rescaled_e, + ctx->jastrow.een_rescaled_n, + ctx->jastrow.een_rescaled_e_deriv_e, + ctx->jastrow.een_rescaled_n_deriv_e, + ctx->jastrow.factor_een_deriv_e); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->jastrow.factor_een_deriv_e_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute + :PROPERTIES: + :Name: qmckl_compute_factor_een_deriv_e + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_factor_een_deriv_e_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 nucleii | + | int64_t | cord_num | in | order of polynomials | + | int64_t | dim_cord_vect | in | dimension of full coefficient vector | + | double | cord_vect_full[dim_cord_vect][nucl_num] | in | full coefficient vector | + | int64_t | lkpm_combined_index[4][dim_cord_vect] | in | combined indices | + | double | een_rescaled_e[walk_num][elec_num][elec_num][0:cord_num] | in | Electron-nucleus rescaled | + | double | een_rescaled_n[walk_num][elec_num][nucl_num][0:cord_num] | in | Electron-nucleus rescaled factor | + | double | een_rescaled_e_deriv_e[walk_num][elec_num][4][elec_num][0:cord_num] | in | Electron-nucleus rescaled | + | double | een_rescaled_n_deriv_e[walk_num][elec_num][4][nucl_num][0:cord_num] | in | Electron-nucleus rescaled factor | + | double | factor_een_deriv_e[walk_num][4][elec_num] | out | Electron-nucleus jastrow | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_factor_een_deriv_e_f(context, walk_num, elec_num, nucl_num, cord_num, dim_cord_vect, & + cord_vect_full, lkpm_combined_index, & + een_rescaled_e, een_rescaled_n, & + een_rescaled_e_deriv_e, een_rescaled_n_deriv_e, factor_een_deriv_e) & + result(info) + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer*8 , intent(in) :: walk_num, elec_num, cord_num, nucl_num, dim_cord_vect + integer*8 , intent(in) :: lkpm_combined_index(4,dim_cord_vect) + double precision , intent(in) :: cord_vect_full(dim_cord_vect, nucl_num) + double precision , intent(in) :: een_rescaled_e(walk_num, elec_num, elec_num, 0:cord_num) + double precision , intent(in) :: een_rescaled_n(walk_num, elec_num, nucl_num, 0:cord_num) + double precision , intent(in) :: een_rescaled_e_deriv_e(walk_num, elec_num, 4, elec_num, 0:cord_num) + double precision , intent(in) :: een_rescaled_n_deriv_e(walk_num, elec_num, 4, nucl_num, 0:cord_num) + double precision , intent(out) :: factor_een_deriv_e(elec_num, 4, walk_num) + + integer*8 :: i, a, j, l, k, p, m, n, nw + double precision :: accu, accu2, cn + double precision :: daccu(1:4), daccu2(1:4) + + 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 + + if (nucl_num <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + if (cord_num <= 0) then + info = QMCKL_INVALID_ARG_5 + return + endif + + factor_een_deriv_e = 0.0d0 + + do nw =1, walk_num + do n = 1, dim_cord_vect + l = lkpm_combined_index(1, n) + k = lkpm_combined_index(2, n) + p = lkpm_combined_index(3, n) + m = lkpm_combined_index(4, n) + + do a = 1, nucl_num + cn = cord_vect_full(n, a) + do j = 1, elec_num + accu = 0.0d0 + accu2 = 0.0d0 + daccu = 0.0d0 + daccu2 = 0.0d0 + do i = 1, elec_num + accu = accu + een_rescaled_e(nw, i, j, k) * & + een_rescaled_n(nw, i, a, m) + accu2 = accu2 + een_rescaled_e(nw, i, j, k) * & + een_rescaled_n(nw, i, a, m + l) + daccu(1:4) = daccu(1:4) + een_rescaled_e_deriv_e(nw, j, 1:4, i, k) * & + een_rescaled_n(nw, i, a, m) + daccu2(1:4) = daccu2(1:4) + een_rescaled_e_deriv_e(nw, j, 1:4, i, k) * & + een_rescaled_n(nw, i, a, m + l) + end do + factor_een_deriv_e(j, 1:4, nw) = factor_een_deriv_e(j, 1:4, nw) + & + (accu * een_rescaled_n_deriv_e(nw, j, 1:4, a, m + l) & + + daccu(1:4) * een_rescaled_n(nw, j, a, m + l) & + + daccu2(1:4) * een_rescaled_n(nw, j, a, m) & + + accu2 * een_rescaled_n_deriv_e(nw, j, 1:4, a, m)) * cn + + factor_een_deriv_e(j, 4, nw) = factor_een_deriv_e(j, 4, nw) + 2.0d0 * ( & + daccu (1) * een_rescaled_n_deriv_e(nw, j, 1, a, m + l) + & + daccu (2) * een_rescaled_n_deriv_e(nw, j, 2, a, m + l) + & + daccu (3) * een_rescaled_n_deriv_e(nw, j, 3, a, m + l) + & + daccu2(1) * een_rescaled_n_deriv_e(nw, j, 1, a, m ) + & + daccu2(2) * een_rescaled_n_deriv_e(nw, j, 2, a, m ) + & + daccu2(3) * een_rescaled_n_deriv_e(nw, j, 3, a, m ) ) * cn + + end do + end do + end do + end do + +end function qmckl_compute_factor_een_deriv_e_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_factor_een_deriv_e_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_factor_een_deriv_e ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const int64_t nucl_num, + const int64_t cord_num, + const int64_t dim_cord_vect, + const double* cord_vect_full, + const int64_t* lkpm_combined_index, + const double* een_rescaled_e, + const double* een_rescaled_n, + const double* een_rescaled_e_deriv_e, + const double* een_rescaled_n_deriv_e, + double* const factor_een_deriv_e ); + #+end_src + + + #+CALL: generate_c_interface(table=qmckl_factor_een_deriv_e_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_factor_een_deriv_e & + (context, & + walk_num, & + elec_num, & + nucl_num, & + cord_num, & + dim_cord_vect, & + cord_vect_full, & + lkpm_combined_index, & + een_rescaled_e, & + een_rescaled_n, & + een_rescaled_e_deriv_e, & + een_rescaled_n_deriv_e, & + factor_een_deriv_e) & + 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 + integer (c_int64_t) , intent(in) , value :: cord_num + integer (c_int64_t) , intent(in) , value :: dim_cord_vect + real (c_double ) , intent(in) :: cord_vect_full(nucl_num,dim_cord_vect) + integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_cord_vect,4) + real (c_double ) , intent(in) :: een_rescaled_e(0:cord_num,elec_num,elec_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_e_deriv_e(0:cord_num,elec_num,4,elec_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n_deriv_e(0:cord_num,nucl_num,4,elec_num,walk_num) + real (c_double ) , intent(out) :: factor_een_deriv_e(elec_num,4,walk_num) + + integer(c_int32_t), external :: qmckl_compute_factor_een_deriv_e_f + info = qmckl_compute_factor_een_deriv_e_f & + (context, & + walk_num, & + elec_num, & + nucl_num, & + cord_num, & + dim_cord_vect, & + cord_vect_full, & + lkpm_combined_index, & + een_rescaled_e, & + een_rescaled_n, & + een_rescaled_e_deriv_e, & + een_rescaled_n_deriv_e, & + factor_een_deriv_e) + + end function qmckl_compute_factor_een_deriv_e + #+end_src + +*** Test + #+begin_src python :results output :exports none :noweb yes +import numpy as np + +<> + +kappa = 1.0 + +elec_coord = np.array(elec_coord)[0] +nucl_coord = np.array(nucl_coord) +elnuc_dist = np.zeros(shape=(elec_num, nucl_num),dtype=float) +for i in range(elec_num): + for j in range(nucl_num): + elnuc_dist[i, j] = np.linalg.norm(elec_coord[i] - nucl_coord[:,j]) + +elnuc_dist_deriv_e = np.zeros(shape=(4, elec_num, nucl_num),dtype=float) +for a in range(nucl_num): + for i in range(elec_num): + rij_inv = 1.0 / elnuc_dist[i, a] + for ii in range(3): + elnuc_dist_deriv_e[ii, i, a] = (elec_coord[i][ii] - nucl_coord[ii][a]) * rij_inv + elnuc_dist_deriv_e[3, i, a] = 2.0 * rij_inv + +en_distance_rescaled_deriv_e = np.zeros(shape=(4,elec_num,nucl_num),dtype=float) +for a in range(nucl_num): + for i in range(elec_num): + f = 1.0 - kappa * en_distance_rescaled[i][a] + for ii in range(4): + en_distance_rescaled_deriv_e[ii][i][a] = elnuc_dist_deriv_e[ii][i][a] + en_distance_rescaled_deriv_e[3][i][a] = en_distance_rescaled_deriv_e[3][i][a] + \ + (-kappa * en_distance_rescaled_deriv_e[0][i][a] * en_distance_rescaled_deriv_e[0][i][a]) + \ + (-kappa * en_distance_rescaled_deriv_e[1][i][a] * en_distance_rescaled_deriv_e[1][i][a]) + \ + (-kappa * en_distance_rescaled_deriv_e[2][i][a] * en_distance_rescaled_deriv_e[2][i][a]) + for ii in range(4): + en_distance_rescaled_deriv_e[ii][i][a] = en_distance_rescaled_deriv_e[ii][i][a] * f + +third = 1.0 / 3.0 +factor_en_deriv_e = np.zeros(shape=(4,elec_num),dtype=float) +dx = np.zeros(shape=(4),dtype=float) +pow_ser_g = np.zeros(shape=(3),dtype=float) +for a in range(nucl_num): + for i in range(elec_num): + x = en_distance_rescaled[i][a] + if abs(x) < 1e-18: + continue + pow_ser_g = np.zeros(shape=(3),dtype=float) + den = 1.0 + aord_vector[1][type_nucl_vector[a]-1] * x + invden = 1.0 / den + invden2 = invden * invden + invden3 = invden2 * invden + xinv = 1.0 / (x + 1.0E-18) + + for ii in range(4): + dx[ii] = en_distance_rescaled_deriv_e[ii][i][a] + + lap1 = 0.0 + lap2 = 0.0 + lap3 = 0.0 + for ii in range(3): + x = en_distance_rescaled[i][a] + if x < 1e-18: + continue + for p in range(2,aord_num+1): + y = p * aord_vector[(p-1) + 1][type_nucl_vector[a]-1] * x + pow_ser_g[ii] = pow_ser_g[ii] + y * dx[ii] + lap1 = lap1 + (p - 1) * y * xinv * dx[ii] * dx[ii] + lap2 = lap2 + y + x = x * en_distance_rescaled[i][a] + + lap3 = lap3 - 2.0 * aord_vector[1][type_nucl_vector[a]-1] * dx[ii] * dx[ii] + + factor_en_deriv_e[ii][i] = factor_en_deriv_e[ii][i] + aord_vector[0][type_nucl_vector[a]-1] * \ + dx[ii] * invden2 + pow_ser_g[ii] + + ii = 3 + lap2 = lap2 * dx[ii] * third + lap3 = lap3 + den * dx[ii] + lap3 = lap3 * (aord_vector[0][type_nucl_vector[a]-1] * invden3) + factor_en_deriv_e[ii][i] = factor_en_deriv_e[ii][i] + lap1 + lap2 + lap3 + +print("factor_en_deriv_e[0][0]:",factor_en_deriv_e[0][0]) +print("factor_en_deriv_e[1][0]:",factor_en_deriv_e[1][0]) +print("factor_en_deriv_e[2][0]:",factor_en_deriv_e[2][0]) +print("factor_en_deriv_e[3][0]:",factor_en_deriv_e[3][0]) + + + #+end_src + + #+RESULTS: + : factor_en_deriv_e[0][0]: 0.11609919541763383 + : factor_en_deriv_e[1][0]: -0.23301394780804574 + : factor_en_deriv_e[2][0]: 0.17548337641865783 + : factor_en_deriv_e[3][0]: -0.9667363412285741 + + + #+begin_src c :tangle (eval c_test) +///* Check if Jastrow is properly initialized */ + + #+end_src + +* 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 + + +# -*- mode: org -*- +# vim: syntax=c + + + diff --git a/org/qmckl_tests.org b/org/qmckl_tests.org index a2fbbfe..61f3151 100644 --- a/org/qmckl_tests.org +++ b/org/qmckl_tests.org @@ -38,7 +38,7 @@ Br -1.218470 -0.187436 -0.028227 #+END_example Nuclear coordinates are stored in atomic units in transposed format. - + #+begin_src c :tangle ../tests/chbrclf.h #define chbrclf_nucl_num ((int64_t) 5) @@ -526,15 +526,16 @@ F 1 #+begin_src c :tangle ../tests/chbrclf.h #define chbrclf_shell_num 72 #define chbrclf_prim_num 297 +#define chbrclf_ao_num 263 -int64_t chbrclf_basis_nucleus_index[chbrclf_nucl_num] = {0, 14, 23, 27, 53}; +int64_t chbrclf_basis_nucleus_index[chbrclf_nucl_num] = {0, 14, 23, 37, 53}; int64_t chbrclf_basis_nucleus_shell_num[chbrclf_nucl_num] = {14, 9, 14, 16, 19}; int32_t chbrclf_basis_shell_ang_mom[chbrclf_shell_num] = - {0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 3, 3, 0, 0, 0, 0, 1, 1, 1, 2, 2, 0, + {0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 3, 3, 0, 0, 0, 0, 1, 1, 1, 2, 2, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 3, 3, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, - 2, 2, 2, 3, 3, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3}; + 2, 2, 2, 3, 3, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3}; int64_t chbrclf_basis_shell_prim_num[chbrclf_shell_num] = {10, 10, 1, 1, 1, 5, 1, 1, 1, 1, 1, 1, 1, 1, 5, 1, 1, 1, 1, 1, 1, 1, 1, 10, @@ -553,7 +554,38 @@ double chbrclf_basis_shell_factor[chbrclf_shell_num] = {1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., - 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1.}; + 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1.}; + +double chbrclf_basis_ao_factor[chbrclf_ao_num] = + {1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., + 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., + 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., + 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., + 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., + 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., + 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., + 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., + 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., + 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., + 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., + 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., + 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., + 1., 1., 1.}; + +int64_t chbrclf_basis_ao_shell[chbrclf_ao_num] = + {0, 1, 2, 3, 4, 5, 5, 5, 6, 6, 6, 7, 7, 7, 8, 8, 8, 9, 9, 9, 9, 9, 9, 10, 10, 10, + 10, 10, 10, 11, 11, 11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13, + 13, 13, 13, 13, 13, 13, 13, 13, 13, 14, 15, 16, 17, 18, 18, 18, 19, 19, 19, 20, + 20, 20, 21, 21, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 23, 24, 25, 26, 27, 28, + 28, 28, 29, 29, 29, 30, 30, 30, 31, 31, 31, 32, 32, 32, 32, 32, 32, 33, 33, 33, + 33, 33, 33, 34, 34, 34, 34, 34, 34, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 36, + 36, 36, 36, 36, 36, 36, 36, 36, 36, 37, 38, 39, 40, 41, 42, 43, 43, 43, 44, 44, + 44, 45, 45, 45, 46, 46, 46, 47, 47, 47, 48, 48, 48, 48, 48, 48, 49, 49, 49, 49, + 49, 49, 50, 50, 50, 50, 50, 50, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 52, 52, + 52, 52, 52, 52, 52, 52, 52, 52, 53, 54, 55, 56, 57, 58, 59, 60, 60, 60, 61, 61, + 61, 62, 62, 62, 63, 63, 63, 64, 64, 64, 65, 65, 65, 66, 66, 66, 66, 66, 66, 67, + 67, 67, 67, 67, 67, 68, 68, 68, 68, 68, 68, 69, 69, 69, 69, 69, 69, 70, 70, 70, + 70, 70, 70, 70, 70, 70, 70, 71, 71, 71, 71, 71, 71, 71, 71, 71, 71}; double chbrclf_basis_exponent[chbrclf_prim_num] = {8.2360000000000000e+03, 1.2350000000000000e+03, 2.8080000000000001e+02, @@ -1013,3 +1045,159 @@ double chbrclf_elec_coord[chbrclf_walk_num][chbrclf_elec_num][3] = { { #+END_src + + +* N2 + + This test is mainly for the Jastrow factor and was supplied by + Ramon Panades Baruetta. The coordinates and Jastrow coefficients + have been taken from his fork of IRPJast. The core electrons are + treated by pseudopotentials thus excluded from the actual calculation. + + | Number of atoms | 2 | + | Number of alpha electrons | 5 | + | Number of beta electrons | 5 | + | Number of core electrons | 4 | + +** XYZ coordinates + +#+BEGIN_example + 2 +N2 + N 0.000000 0.000000 0.000000 + N 0.000000 0.000000 2.059801 +#+END_example + + Nuclear coordinates are stored in atomic units in transposed format. + +#+begin_src c :tangle ../tests/n2.h +#define n2_nucl_num ((int64_t) 2) + +double n2_charge[n2_nucl_num] = { 5., 5.}; + +double n2_nucl_coord[3][n2_nucl_num] = +{ {0.000000, 0.000000 }, + {0.000000, 0.000000 }, + {0.000000, 2.059801 } }; +#+end_src + +** Electron coordinates + + + Electron coordinates are stored in atomic units in normal format. + +#+begin_src c :tangle ../tests/n2.h +#define n2_elec_up_num ((int64_t) 5) +#define n2_elec_dn_num ((int64_t) 5) +#define n2_elec_num ((int64_t) 10) +#define n2_walk_num ((int64_t) 1) + +double n2_elec_coord[n2_walk_num][n2_elec_num][3] = { { + {-0.250655104764153 , 0.503070975550133 , -0.166554344502303}, + {-0.587812193472177 , -0.128751981129274 , 0.187773606533075}, + { 1.61335569047166 , -0.615556732874863 , -1.43165470979934 }, + {-4.901239896295210E-003 , -1.120440036458986E-002 , 1.99761909330422 }, + { 0.766647499681200 , -0.293515395797937 , 3.66454589201239 }, + {-0.127732483187947 , -0.138975497694196 , -8.669850480215846E-002}, + {-0.232271834949124 , -1.059321673434182E-002 , -0.504862241464867}, + { 1.09360863531826 , -2.036103063808752E-003 , -2.702796910818986E-002}, + {-0.108090166832043 , 0.189161729653261 , 2.15398313919894}, + { 0.397978144318712 , -0.254277292595981 , 2.54553335476344}}}; + +#+end_src + +** Jastrow related data + + This test is mainly for the Jastrow factor and was supplied by + Ramon Panades Baruetta. + +#+begin_src c :tangle ../tests/n2.h +/* Jastrow related */ + +#define n2_type_nucl_num ((int64_t) 1) +#define n2_aord_num ((int64_t) 5) +#define n2_bord_num ((int64_t) 5) +#define n2_cord_num ((int64_t) 23) +#define n2_dim_cord_vec ((int64_t) 23) + +int64_t n2_type_nucl_vector[n2_nucl_num] = { + 1, + 1}; + +double n2_aord_vector[n2_aord_num + 1][n2_type_nucl_num] = { + { 0. }, + { 0. }, + {-0.380512}, + {-0.157996}, + {-0.031558}, + { 0.021512}}; + +double n2_bord_vector[n2_bord_num + 1] = { + 0.5 , + 0.15366 , + 0.0672262 , + 0.02157 , + 0.0073096 , + 0.002866 }; + +double n2_cord_vector[n2_cord_num][n2_type_nucl_num] = { + { 5.717020e-01}, + {-5.142530e-01}, + {-5.130430e-01}, + { 9.486000e-03}, + {-4.205000e-03}, + { 4.263258e-01}, + { 8.288150e-02}, + { 5.118600e-03}, + {-2.997800e-03}, + {-5.270400e-03}, + {-7.500000e-05}, + {-8.301650e-02}, + { 1.454340e-02}, + { 5.143510e-02}, + { 9.250000e-04}, + {-4.099100e-03}, + { 4.327600e-03}, + {-1.654470e-03}, + { 2.614000e-03}, + {-1.477000e-03}, + {-1.137000e-03}, + {-4.010475e-02}, + { 6.106710e-03}}; + +double n2_cord_vector_full[n2_dim_cord_vec][n2_nucl_num] = { + { 5.717020e-01, 5.717020e-01}, + {-5.142530e-01, -5.142530e-01}, + {-5.130430e-01, -5.130430e-01}, + { 9.486000e-03, 9.486000e-03}, + {-4.205000e-03, -4.205000e-03}, + { 4.263258e-01, 4.263258e-01}, + { 8.288150e-02, 8.288150e-02}, + { 5.118600e-03, 5.118600e-03}, + {-2.997800e-03, -2.997800e-03}, + {-5.270400e-03, -5.270400e-03}, + {-7.500000e-05, -7.500000e-05}, + {-8.301650e-02, -8.301650e-02}, + { 1.454340e-02, 1.454340e-02}, + { 5.143510e-02, 5.143510e-02}, + { 9.250000e-04, 9.250000e-04}, + {-4.099100e-03, -4.099100e-03}, + { 4.327600e-03, 4.327600e-03}, + {-1.654470e-03, -1.654470e-03}, + { 2.614000e-03, 2.614000e-03}, + {-1.477000e-03, -1.477000e-03}, + {-1.137000e-03, -1.137000e-03}, + {-4.010475e-02, -4.010475e-02}, + { 6.106710e-03, 6.106710e-03}}; + +double n2_lkpm_of_cindex[4][n2_dim_cord_vec] = { + {1, 1, 2, 0, 0, 0, 2, 1, 1, 2, 3, 0, 2, 1, 3, 0, 0, 1, 3, 1, 1, 0, 3}, + {1, 1, 3, 4, 0, 2, 2, 4, 0, 0, 2, 4, 1, 3, 1, 4, 0, 1, 1, 4, 1, 2, 0}, + {4, 1, 0, 0, 4, 2, 1, 4, 5, 0, 2, 3, 5, 0, 0, 3, 5, 1, 3, 2, 5, 0, 1}, + {2, 5, 1, 4, 1, 5, 0, 2, 1, 5, 1, 0, 1, 5, 2, 3, 0, 5, 1, 1, 0, 5, 2}}; + +#+end_src + + +# -*- mode: org -*- +# vim: syntax=c diff --git a/org/table_of_contents b/org/table_of_contents index e9e2190..50a6159 100644 --- a/org/table_of_contents +++ b/org/table_of_contents @@ -6,6 +6,7 @@ qmckl_numprec.org qmckl_nucleus.org qmckl_electron.org qmckl_ao.org +qmckl_jastrow.org qmckl_distance.org qmckl_utils.org qmckl_tests.org diff --git a/tools/build_qmckl_h.sh b/tools/build_qmckl_h.sh index fdec31e..3ddeada 100755 --- a/tools/build_qmckl_h.sh +++ b/tools/build_qmckl_h.sh @@ -43,29 +43,29 @@ cat << EOF > ${OUTPUT} * ------------------------------------------ * QMCkl - Quantum Monte Carlo kernel library * ------------------------------------------ - * + * * Documentation : https://trex-coe.github.io/qmckl * Issues : https://github.com/trex-coe/qmckl/issues - * + * * BSD 3-Clause License - * + * * Copyright (c) 2020, TREX Center of Excellence * All rights reserved. - * + * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: - * + * * 1. Redistributions of source code must retain the above copyright notice, this * list of conditions and the following disclaimer. - * + * * 2. Redistributions in binary form must reproduce the above copyright notice, * this list of conditions and the following disclaimer in the documentation * and/or other materials provided with the distribution. - * + * * 3. Neither the name of the copyright holder nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. - * + * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE @@ -76,15 +76,19 @@ cat << EOF > ${OUTPUT} * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * - * - * - * + * + * + * + * */ #ifndef __QMCKL_H__ #define __QMCKL_H__ +#ifdef __cplusplus +extern "C" { +#endif + #include #include #include @@ -92,7 +96,7 @@ EOF for i in ${HEADERS} do - header=${srcdir}/src/$i + header=${srcdir}/src/$i if [[ -f $header ]] ; then echo "/* $header */" >> ${OUTPUT} cat $header >> ${OUTPUT} @@ -100,6 +104,9 @@ do done cat << EOF >> ${OUTPUT} +#ifdef __cplusplus +} +#endif #endif EOF diff --git a/tools/lib.org b/tools/lib.org index 3536c32..d8e642a 100644 --- a/tools/lib.org +++ b/tools/lib.org @@ -96,7 +96,6 @@ def parse_table(table): return result #+END_SRC - *** Generates a C header #+NAME: generate_c_header @@ -124,13 +123,11 @@ for d in parse_table(table): results += [ f" {const}{c_type} {name}" ] results=',\n'.join(results) -template = f"""{rettyp} {fname} ( -{results} ); """ +template = f"""{rettyp} {fname} (\n{results} ); """ return template #+END_SRC - *** Generates a C interface to the Fortran function #+NAME: generate_c_interface @@ -259,3 +256,4 @@ return results #+begin_src f90 :tangle (eval fh_func) :comments org :exports none #+end_src +