diff --git a/.gitignore b/.gitignore index 740b513..9a024c8 100644 --- a/.gitignore +++ b/.gitignore @@ -32,3 +32,4 @@ tools/libtool tools/ltmain.sh tools/missing tools/test-driver +*/*.exported diff --git a/Makefile.am b/Makefile.am index 626ad60..e5461e9 100644 --- a/Makefile.am +++ b/Makefile.am @@ -49,8 +49,6 @@ qmckl_f = include/qmckl_f.F90 qmckl_fo = include/qmckl_f.o include_HEADERS = $(qmckl_h) $(qmckl_f) -header_tests = tests/chbrclf.h tests/n2.h - QMCKL_TEST_DIR = $(abs_srcdir)/share/qmckl/test_data/ AM_CPPFLAGS = -I$(top_builddir)/src -I$(top_builddir)/include @@ -137,9 +135,9 @@ endif EXTRA_DIST += $(ORG_FILES) $(TANGLED_FILES) $(EXPORTED_FILES) -BUILT_SOURCES = $(C_FILES) $(F_FILES) $(FH_FUNC_FILES) $(FH_TYPE_FILES) $(H_FUNC_FILES) $(H_TYPE_FILES) $(H_PRIVATE_FUNC_FILES) $(H_PRIVATE_TYPE_FILES) $(qmckl_f) $(qmckl_h) $(header_tests) $(htmlize_el) +BUILT_SOURCES = $(C_FILES) $(F_FILES) $(FH_FUNC_FILES) $(FH_TYPE_FILES) $(H_FUNC_FILES) $(H_TYPE_FILES) $(H_PRIVATE_FUNC_FILES) $(H_PRIVATE_TYPE_FILES) $(qmckl_f) $(qmckl_h) $(htmlize_el) -CLEANFILES += $(BUILT_SOURCES) $(C_TEST_FILES) $(F_TEST_FILES) $(TANGLED_FILES) $(C_TEST_FILES) $(F_TEST_FILES) $(qmckl_f) $(qmckl_h) $(HTML_FILES) $(TEXT_FILES) $(EXPORTED_FILES) $(header_tests) $(htmlize_el) +CLEANFILES += $(BUILT_SOURCES) $(C_TEST_FILES) $(F_TEST_FILES) $(TANGLED_FILES) $(C_TEST_FILES) $(F_TEST_FILES) $(qmckl_f) $(qmckl_h) $(HTML_FILES) $(TEXT_FILES) $(EXPORTED_FILES) $(htmlize_el) EXTRA_DIST += \ tools/build_doc.sh \ @@ -189,7 +187,7 @@ $(htmlize_el): tests/chbrclf.h: $(qmckl_h) -tests/n2.h: $(qmckl_h) +include/n2.h: $(qmckl_h) cppcheck: cppcheck.out diff --git a/QMCkl.png b/QMCkl.png new file mode 100644 index 0000000..110e6ba Binary files /dev/null and b/QMCkl.png differ diff --git a/configure.ac b/configure.ac index 9ad7633..670c2d2 100644 --- a/configure.ac +++ b/configure.ac @@ -66,7 +66,7 @@ AC_ARG_WITH([icx], AS_IF([test "x$with_icx" = "xyes"], [ CC=icx - CFLAGS="-march=native -Ofast -ftz -finline -g -qmkl=sequential" ]) + CFLAGS="-march=native -Ofast -finline -g -qmkl=sequential" ]) AS_IF([test "x$with_icx.$with_ifort" = "xyes.yes"], [ ax_blas_ok="yes" diff --git a/include/n2.h b/include/n2.h new file mode 100644 index 0000000..a945644 --- /dev/null +++ b/include/n2.h @@ -0,0 +1,109 @@ +#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 } }; + +#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}}}; + +/* 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) 5) +#define n2_dim_c_vec ((int64_t) 23) + +int64_t n2_type_nucl_vector[n2_nucl_num] = { + 0, + 0}; + +double n2_a_vector[n2_aord_num + 1][n2_type_nucl_num] = { + { 0. }, + { 0. }, + {-0.380512}, + {-0.157996}, + {-0.031558}, + { 0.021512}}; + +double n2_b_vector[n2_bord_num + 1] = { + 0.5 , + 0.15366 , + 0.0672262 , + 0.02157 , + 0.0073096 , + 0.002866 }; + +double n2_c_vector[n2_dim_c_vec][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_c_vector_full[n2_dim_c_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_c_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}}; diff --git a/org/qmckl_error.org b/org/qmckl_error.org index 7541d49..a0a5de0 100644 --- a/org/qmckl_error.org +++ b/org/qmckl_error.org @@ -472,18 +472,15 @@ qmckl_get_error(qmckl_context context, qmckl_context_struct* const ctx = (qmckl_context_struct*) context; assert (ctx != NULL); /* Impossible because the context is valid. */ -/* Turn off annoying GCC warning */ -#ifdef __GNUC__ -#pragma GCC diagnostic push -#pragma GCC diagnostic ignored "-Wstringop-truncation" -#endif + size_t sizeCp; - strncpy(function_name, ctx->error.function, QMCKL_MAX_FUN_LEN-1); - strncpy(message , ctx->error.message , QMCKL_MAX_MSG_LEN-1); + sizeCp = strlen(ctx->error.function); + sizeCp = sizeCp > QMCKL_MAX_FUN_LEN ? QMCKL_MAX_FUN_LEN : sizeCp; + memcpy(function_name, ctx->error.function, sizeCp); -#ifdef __GNUC__ -#pragma GCC diagnostic pop -#endif + sizeCp = strlen(ctx->error.message); + sizeCp = sizeCp > QMCKL_MAX_MSG_LEN ? QMCKL_MAX_MSG_LEN : sizeCp; + memcpy(message, ctx->error.message, sizeCp); (*exit_code) = ctx->error.exit_code; } diff --git a/org/qmckl_forces.org b/org/qmckl_forces.org index ac72bbc..c9b9145 100644 --- a/org/qmckl_forces.org +++ b/org/qmckl_forces.org @@ -993,7 +993,7 @@ function qmckl_compute_forces_jastrow_en_g_doc( & integer*8 :: i, a, k, nw, ii, m,l double precision :: x, x1, kf double precision :: denom, invdenom, invdenom2, f, f2, expk, invdist - double precision :: dx(3) + double precision :: dx(4) info = QMCKL_SUCCESS @@ -1409,7 +1409,7 @@ function qmckl_compute_forces_jastrow_en_l_doc( & integer*8 :: i, a, k, nw, ii, m,l double precision :: x, x1, kf double precision :: denom, invdenom, invdenom2, f, f2, expk, invdist - double precision :: dx(3) + double precision :: dx(4) info = QMCKL_SUCCESS diff --git a/org/qmckl_jastrow_champ.org b/org/qmckl_jastrow_champ.org index a0ee7c7..f894908 100644 --- a/org/qmckl_jastrow_champ.org +++ b/org/qmckl_jastrow_champ.org @@ -193,9 +193,12 @@ int main() { | ~factor_en_gl_date~ | ~uint64_t~ | Keep track of the date for the en derivative | | ~factor_een_gl~ | ~double[walk_num][4][elec_num]~ | Derivative of the Jastrow factor: electron-electron-nucleus part | | ~factor_een_gl_date~ | ~uint64_t~ | Keep track of the date for the een derivative | + | ~factor_een_grad~ | ~double[walk_num][3][elec_num]~ | Gradient of the Jastrow factor: electron-electron-nucleus part | + | ~factor_een_grad_date~ | ~uint64_t~ | Keep track of the date for the een derivative | | ~value~ | ~double[walk_num]~ | Value of the Jastrow factor | | ~value_date~ | ~uint64_t~ | Keep track of the date | | ~gl~ | ~double[walk_num][4][elec_num]~ | Gradient and Laplacian of the Jastrow factor | + | ~grad~ | ~double[walk_num][3][elec_num]~ | Gradient of the Jastrow factor | | ~value_date~ | ~uint64_t~ | Keep track of the date | #+NAME: jastrow_data @@ -335,12 +338,14 @@ typedef struct qmckl_jastrow_champ_struct{ double * restrict factor_ee_gl; double * restrict factor_een; double * restrict factor_een_gl; + double * restrict factor_een_grad; double * restrict factor_en; double * restrict factor_en_gl; double * restrict rescale_factor_en; double * restrict tmp_c; double * restrict value; double * restrict gl; + double * restrict grad; int64_t aord_num; int64_t bord_num; int64_t cord_num; @@ -363,12 +368,14 @@ typedef struct qmckl_jastrow_champ_struct{ uint64_t factor_ee_gl_date; uint64_t factor_een_date; uint64_t factor_een_gl_date; + uint64_t factor_een_grad_date; uint64_t factor_en_date; uint64_t factor_en_gl_date; uint64_t lkpm_combined_index_date; uint64_t tmp_c_date; uint64_t value_date; uint64_t gl_date; + uint64_t grad_date; double rescale_factor_ee; int32_t uninitialized; int32_t spin_independent; @@ -4026,17 +4033,19 @@ qmckl_exit_code qmckl_provide_jastrow_champ_asymp_jasa(qmckl_context context) | ~asymp_jasa~ | ~double[type_nucl_num]~ | out | Asymptotic value | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_jastrow_champ_asymp_jasa_f(context, aord_num, type_nucl_num, a_vector, & +function qmckl_compute_jastrow_champ_asymp_jasa(context, aord_num, type_nucl_num, a_vector, & rescale_factor_en, asymp_jasa) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: aord_num - integer*8 , intent(in) :: type_nucl_num - double precision , intent(in) :: a_vector(aord_num + 1, type_nucl_num) - double precision , intent(in) :: rescale_factor_en(type_nucl_num) - double precision , intent(out) :: asymp_jasa(type_nucl_num) + integer(qmckl_context), intent(in) :: context + integer (c_int64_t) , intent(in) , value :: aord_num + integer (c_int64_t) , intent(in) , value :: type_nucl_num + real (c_double ) , intent(in) :: a_vector(aord_num+1,type_nucl_num) + real (c_double ) , intent(in) :: rescale_factor_en(type_nucl_num) + real (c_double ) , intent(out) :: asymp_jasa(type_nucl_num) + integer(qmckl_exit_code) :: info integer*8 :: i, j, p double precision :: kappa_inv, x, asym_one @@ -4067,34 +4076,9 @@ integer function qmckl_compute_jastrow_champ_asymp_jasa_f(context, aord_num, typ end do -end function qmckl_compute_jastrow_champ_asymp_jasa_f +end function qmckl_compute_jastrow_champ_asymp_jasa #+end_src - #+CALL: generate_c_interface(table=qmckl_asymp_jasa_args,rettyp=get_value("CRetType"),fname=get_value("Name")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_jastrow_champ_asymp_jasa & - (context, aord_num, type_nucl_num, a_vector, rescale_factor_en, asymp_jasa) & - 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 :: aord_num - integer (c_int64_t) , intent(in) , value :: type_nucl_num - real (c_double ) , intent(in) :: a_vector(aord_num+1,type_nucl_num) - real (c_double ) , intent(in) :: rescale_factor_en(type_nucl_num) - real (c_double ) , intent(out) :: asymp_jasa(type_nucl_num) - - integer(c_int32_t), external :: qmckl_compute_jastrow_champ_asymp_jasa_f - info = qmckl_compute_jastrow_champ_asymp_jasa_f & - (context, aord_num, type_nucl_num, a_vector, rescale_factor_en, asymp_jasa) - - end function qmckl_compute_jastrow_champ_asymp_jasa - #+end_src - #+CALL: generate_c_header(table=qmckl_asymp_jasa_args,rettyp=get_value("CRetType"),fname=get_value("Name")) #+RESULTS: @@ -4757,7 +4741,7 @@ function qmckl_compute_jastrow_champ_factor_en_gl_doc( & real (c_double ) , intent(in) :: en_distance_rescaled(elec_num,nucl_num,walk_num) real (c_double ) , intent(in) :: en_distance_rescaled_gl(4, elec_num,nucl_num,walk_num) real (c_double ) , intent(out) :: factor_en_gl(elec_num,4,walk_num) - integer(qmckl_exit_code) :: info + integer(qmckl_exit_code) :: info integer*8 :: i, a, k, nw, ii double precision :: x, x1, kf @@ -5271,7 +5255,7 @@ function qmckl_compute_en_distance_rescaled_doc(context, & real (c_double ) , intent(in) :: elec_coord(elec_num,walk_num,3) real (c_double ) , intent(in) :: nucl_coord(nucl_num,3) real (c_double ) , intent(out) :: en_distance_rescaled(elec_num,nucl_num,walk_num) - integer(qmckl_exit_code) :: info + integer(qmckl_exit_code) :: info integer*8 :: i, k double precision :: coord(3) @@ -5619,23 +5603,25 @@ qmckl_exit_code qmckl_provide_en_distance_rescaled_gl(qmckl_context context) | ~en_distance_rescaled_gl~ | ~double[walk_num][nucl_num][elec_num][4]~ | out | Electron-nucleus distance derivatives | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_en_distance_rescaled_gl_doc_f(context, elec_num, nucl_num, & +function qmckl_compute_en_distance_rescaled_gl_doc(context, elec_num, nucl_num, & type_nucl_num, type_nucl_vector, rescale_factor_en, walk_num, elec_coord, & nucl_coord, en_distance_rescaled_gl) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: elec_num - integer*8 , intent(in) :: nucl_num - integer*8 , intent(in) :: type_nucl_num - integer*8 , intent(in) :: type_nucl_vector(nucl_num) - double precision , intent(in) :: rescale_factor_en(nucl_num) - integer*8 , intent(in) :: walk_num - double precision , intent(in) :: elec_coord(elec_num,walk_num,3) - double precision , intent(in) :: nucl_coord(nucl_num,3) - double precision , intent(out) :: en_distance_rescaled_gl(4,elec_num,nucl_num,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) + real (c_double ) , intent(in) :: rescale_factor_en(nucl_num) + integer (c_int64_t) , intent(in) , value :: walk_num + real (c_double ) , intent(in) :: elec_coord(elec_num,walk_num,3) + real (c_double ) , intent(in) :: nucl_coord(elec_num,3) + real (c_double ) , intent(out) :: en_distance_rescaled_gl(4,elec_num,nucl_num,walk_num) + integer(qmckl_exit_code) :: info integer*8 :: i, k double precision :: coord(3) @@ -5673,7 +5659,7 @@ integer function qmckl_compute_en_distance_rescaled_gl_doc_f(context, elec_num, end do end do -end function qmckl_compute_en_distance_rescaled_gl_doc_f +end function qmckl_compute_en_distance_rescaled_gl_doc #+end_src #+begin_src c :tangle (eval h_private_func) :comments org :exports none @@ -5785,52 +5771,6 @@ qmckl_exit_code qmckl_compute_en_distance_rescaled_gl ( walk_num, elec_coord, nucl_coord, en_distance_rescaled_gl ); } #+end_src - #+CALL: generate_c_interface(table=qmckl_en_distance_rescaled_gl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_en_distance_rescaled_gl_doc") - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_en_distance_rescaled_gl_doc & - (context, & - elec_num, & - nucl_num, & - type_nucl_num, & - type_nucl_vector, & - rescale_factor_en, & - walk_num, & - elec_coord, & - nucl_coord, & - en_distance_rescaled_gl) & - bind(C) result(info) - - use, intrinsic :: iso_c_binding - implicit none - - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) , value :: 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) - real (c_double ) , intent(in) :: rescale_factor_en(nucl_num) - integer (c_int64_t) , intent(in) , value :: walk_num - real (c_double ) , intent(in) :: elec_coord(elec_num,walk_num,3) - real (c_double ) , intent(in) :: nucl_coord(elec_num,3) - real (c_double ) , intent(out) :: en_distance_rescaled_gl(4,elec_num,nucl_num,walk_num) - - integer(c_int32_t), external :: qmckl_compute_en_distance_rescaled_gl_doc_f - info = qmckl_compute_en_distance_rescaled_gl_doc_f & - (context, & - elec_num, & - nucl_num, & - type_nucl_num, & - type_nucl_vector, & - rescale_factor_en, & - walk_num, & - elec_coord, & - nucl_coord, & - en_distance_rescaled_gl) - - end function qmckl_compute_en_distance_rescaled_gl_doc - #+end_src **** Test @@ -6018,19 +5958,22 @@ qmckl_exit_code qmckl_provide_een_rescaled_e(qmckl_context context) | ~een_rescaled_e~ | ~double[walk_num][0:cord_num][elec_num][elec_num]~ | out | Electron-electron rescaled distances for each walker | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_een_rescaled_e_doc_f( & +function qmckl_compute_een_rescaled_e_doc( & context, walk_num, elec_num, cord_num, rescale_factor_ee, & ee_distance, een_rescaled_e) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding 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_ee - double precision , intent(in) :: ee_distance(elec_num,elec_num,walk_num) - double precision , intent(out) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) + 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_ee + real (c_double ) , intent(in) :: ee_distance(elec_num,elec_num,walk_num) + real (c_double ) , intent(out) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) + integer(qmckl_exit_code) :: info + double precision,dimension(:,:),allocatable :: een_rescaled_e_ij double precision :: x integer*8 :: i, j, k, l, nw @@ -6102,7 +6045,7 @@ integer function qmckl_compute_een_rescaled_e_doc_f( & end do -end function qmckl_compute_een_rescaled_e_doc_f +end function qmckl_compute_een_rescaled_e_doc #+end_src # #+CALL: generate_c_header(table=qmckl_factor_een_rescaled_e_args,rettyp=get_value("CRetType"),fname=get_value("Name")) @@ -6118,33 +6061,6 @@ end function qmckl_compute_een_rescaled_e_doc_f double* const een_rescaled_e ); #+end_src - #+CALL: generate_c_interface(table=qmckl_factor_een_rescaled_e_args,rettyp=get_value("CRetType"),fname="qmckl_compute_een_rescaled_e_doc") - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_een_rescaled_e_doc & - (context, walk_num, elec_num, cord_num, rescale_factor_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_ee - real (c_double ) , intent(in) :: ee_distance(elec_num,elec_num,walk_num) - real (c_double ) , intent(out) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) - - integer(c_int32_t), external :: qmckl_compute_een_rescaled_e_doc_f - info = qmckl_compute_een_rescaled_e_doc_f & - (context, walk_num, elec_num, cord_num, rescale_factor_ee, ee_distance, een_rescaled_e) - - end function qmckl_compute_een_rescaled_e_doc - #+end_src - #+begin_src c :comments org :tangle (eval c) :noweb yes qmckl_exit_code qmckl_compute_een_rescaled_e_hpc ( const qmckl_context context, @@ -6540,35 +6456,38 @@ qmckl_exit_code qmckl_provide_een_rescaled_e_gl(qmckl_context context) :END: #+NAME: qmckl_factor_een_rescaled_e_gl_args - | Variable | Type | In/Out | Description | - |--------------------------+-------------------------------------------------------+--------+--------------------------------------| - | ~context~ | ~qmckl_context~ | in | Global state | - | ~walk_num~ | ~int64_t~ | in | Number of walkers | - | ~elec_num~ | ~int64_t~ | in | Number of electrons | - | ~cord_num~ | ~int64_t~ | in | Order of polynomials | - | ~rescale_factor_ee~ | ~double~ | in | Factor to rescale ee distances | - | ~coord_ee~ | ~double[walk_num][3][elec_num]~ | in | Electron coordinates | - | ~ee_distance~ | ~double[walk_num][elec_num][elec_num]~ | in | Electron-electron distances | - | ~een_rescaled_e~ | ~double[walk_num][0:cord_num][elec_num][elec_num]~ | in | Electron-electron distances | + | Variable | Type | In/Out | Description | + |---------------------+-------------------------------------------------------+--------+--------------------------------------| + | ~context~ | ~qmckl_context~ | in | Global state | + | ~walk_num~ | ~int64_t~ | in | Number of walkers | + | ~elec_num~ | ~int64_t~ | in | Number of electrons | + | ~cord_num~ | ~int64_t~ | in | Order of polynomials | + | ~rescale_factor_ee~ | ~double~ | in | Factor to rescale ee distances | + | ~coord_ee~ | ~double[walk_num][3][elec_num]~ | in | Electron coordinates | + | ~ee_distance~ | ~double[walk_num][elec_num][elec_num]~ | in | Electron-electron distances | + | ~een_rescaled_e~ | ~double[walk_num][0:cord_num][elec_num][elec_num]~ | in | Electron-electron distances | | ~een_rescaled_e_gl~ | ~double[walk_num][0:cord_num][elec_num][4][elec_num]~ | out | Electron-electron rescaled distances | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_jastrow_champ_factor_een_rescaled_e_gl_f( & +function qmckl_compute_jastrow_champ_factor_een_rescaled_e_gl_doc( & context, walk_num, elec_num, cord_num, rescale_factor_ee, & coord_ee, ee_distance, een_rescaled_e, een_rescaled_e_gl) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding 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_ee - double precision , intent(in) :: coord_ee(elec_num,3,walk_num) - double precision , intent(in) :: ee_distance(elec_num,elec_num,walk_num) - double precision , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) - double precision , intent(out) :: een_rescaled_e_gl(elec_num,4,elec_num,0:cord_num,walk_num) - double precision,dimension(:,:,:),allocatable :: elec_dist_gl + 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_ee + real(c_double) , intent(in) :: coord_ee(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(elec_num,elec_num,0:cord_num,walk_num) + real(c_double) , intent(out) :: een_rescaled_e_gl(elec_num,4,elec_num,0:cord_num,walk_num) + integer(qmckl_exit_code) :: info + + double precision, allocatable :: elec_dist_gl(:,:,:) double precision :: x, rij_inv, kappa_l integer*8 :: i, j, k, l, nw, ii @@ -6598,51 +6517,51 @@ integer function qmckl_compute_jastrow_champ_factor_een_rescaled_e_gl_f( & ! Prepare table of exponentiated distances raised to appropriate power do nw = 1, walk_num - do j = 1, elec_num - do i = 1, j-1 - rij_inv = 1.0d0 / ee_distance(i, j, nw) - do ii = 1, 3 - elec_dist_gl(i, ii, j) = (coord_ee(i, ii, nw) - coord_ee(j, ii, nw)) * rij_inv + do j = 1, elec_num + do i = 1, j-1 + rij_inv = 1.0d0 / ee_distance(i, j, nw) + do ii = 1, 3 + elec_dist_gl(i, ii, j) = (coord_ee(i, ii, nw) - coord_ee(j, ii, nw)) * rij_inv + end do + elec_dist_gl(i, 4, j) = 2.0d0 * rij_inv end do - elec_dist_gl(i, 4, j) = 2.0d0 * rij_inv - end do - elec_dist_gl(j, :, j) = 0.0d0 + elec_dist_gl(j, :, j) = 0.0d0 - do i = j+1, elec_num - rij_inv = 1.0d0 / ee_distance(i, j, nw) - do ii = 1, 3 - elec_dist_gl(i, ii, j) = (coord_ee(i, ii, nw) - coord_ee(j, ii, nw)) * rij_inv + do i = j+1, elec_num + rij_inv = 1.0d0 / ee_distance(i, j, nw) + do ii = 1, 3 + elec_dist_gl(i, ii, j) = (coord_ee(i, ii, nw) - coord_ee(j, ii, nw)) * rij_inv + end do + elec_dist_gl(i, 4, j) = 2.0d0 * rij_inv end do - elec_dist_gl(i, 4, j) = 2.0d0 * rij_inv - end do - end do + end do -! Not necessary: should be set to zero by qmckl_malloc -! een_rescaled_e_gl(:,:,:,0,nw) = 0.d0 + ! Not necessary: should be set to zero by qmckl_malloc + ! een_rescaled_e_gl(:,:,:,0,nw) = 0.d0 - do l = 1, cord_num - kappa_l = - dble(l) * rescale_factor_ee - do j = 1, elec_num - do i = 1, elec_num - een_rescaled_e_gl(i, 1, j, l, nw) = kappa_l * elec_dist_gl(i, 1, j) - een_rescaled_e_gl(i, 2, j, l, nw) = kappa_l * elec_dist_gl(i, 2, j) - een_rescaled_e_gl(i, 3, j, l, nw) = kappa_l * elec_dist_gl(i, 3, j) - een_rescaled_e_gl(i, 4, j, l, nw) = kappa_l * elec_dist_gl(i, 4, j) + do l = 1, cord_num + kappa_l = - dble(l) * rescale_factor_ee + do j = 1, elec_num + do i = 1, elec_num + een_rescaled_e_gl(i, 1, j, l, nw) = kappa_l * elec_dist_gl(i, 1, j) + een_rescaled_e_gl(i, 2, j, l, nw) = kappa_l * elec_dist_gl(i, 2, j) + een_rescaled_e_gl(i, 3, j, l, nw) = kappa_l * elec_dist_gl(i, 3, j) + een_rescaled_e_gl(i, 4, j, l, nw) = kappa_l * elec_dist_gl(i, 4, j) - een_rescaled_e_gl(i, 4, j, l, nw) = een_rescaled_e_gl(i, 4, j, l, nw) + & - kappa_l * kappa_l + een_rescaled_e_gl(i, 4, j, l, nw) = een_rescaled_e_gl(i, 4, j, l, nw) + & + kappa_l * kappa_l - een_rescaled_e_gl(i,1,j,l,nw) = een_rescaled_e_gl(i,1,j,l,nw) * een_rescaled_e(i,j,l,nw) - een_rescaled_e_gl(i,2,j,l,nw) = een_rescaled_e_gl(i,2,j,l,nw) * een_rescaled_e(i,j,l,nw) - een_rescaled_e_gl(i,3,j,l,nw) = een_rescaled_e_gl(i,3,j,l,nw) * een_rescaled_e(i,j,l,nw) - een_rescaled_e_gl(i,4,j,l,nw) = een_rescaled_e_gl(i,4,j,l,nw) * een_rescaled_e(i,j,l,nw) + een_rescaled_e_gl(i,1,j,l,nw) = een_rescaled_e_gl(i,1,j,l,nw) * een_rescaled_e(i,j,l,nw) + een_rescaled_e_gl(i,2,j,l,nw) = een_rescaled_e_gl(i,2,j,l,nw) * een_rescaled_e(i,j,l,nw) + een_rescaled_e_gl(i,3,j,l,nw) = een_rescaled_e_gl(i,3,j,l,nw) * een_rescaled_e(i,j,l,nw) + een_rescaled_e_gl(i,4,j,l,nw) = een_rescaled_e_gl(i,4,j,l,nw) * een_rescaled_e(i,j,l,nw) + end do end do - end do - end do + end do end do -end function qmckl_compute_jastrow_champ_factor_een_rescaled_e_gl_f +end function qmckl_compute_jastrow_champ_factor_een_rescaled_e_gl_doc #+end_src # #+CALL: generate_c_header(table=qmckl_factor_een_rescaled_e_gl_args,rettyp=get_value("CRetType"),fname=get_value("Name")) @@ -6674,50 +6593,6 @@ end function qmckl_compute_jastrow_champ_factor_een_rescaled_e_gl_f #+end_src - #+CALL: generate_c_interface(table=qmckl_factor_een_rescaled_e_gl_args,rettyp=get_value("CRetType"),fname=get_value("Name")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_jastrow_champ_factor_een_rescaled_e_gl_doc & - (context, & - walk_num, & - elec_num, & - cord_num, & - rescale_factor_ee, & - coord_ee, & - ee_distance, & - een_rescaled_e, & - een_rescaled_e_gl) & - bind(C) result(info) - - use, intrinsic :: iso_c_binding - implicit none - - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) , value :: walk_num - integer (c_int64_t) , intent(in) , value :: elec_num - integer (c_int64_t) , intent(in) , value :: cord_num - real (c_double ) , intent(in) , value :: rescale_factor_ee - real (c_double ) , intent(in) :: coord_ee(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(elec_num,elec_num,0:cord_num,walk_num) - real (c_double ) , intent(out) :: een_rescaled_e_gl(elec_num,4,elec_num,0:cord_num,walk_num) - - integer(c_int32_t), external :: qmckl_compute_jastrow_champ_factor_een_rescaled_e_gl_f - info = qmckl_compute_jastrow_champ_factor_een_rescaled_e_gl_f & - (context, & - walk_num, & - elec_num, & - cord_num, & - rescale_factor_ee, & - coord_ee, & - ee_distance, & - een_rescaled_e, & - een_rescaled_e_gl) - - end function qmckl_compute_jastrow_champ_factor_een_rescaled_e_gl_doc - #+end_src - #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none qmckl_exit_code qmckl_compute_jastrow_champ_factor_een_rescaled_e_gl_hpc ( const qmckl_context context, @@ -7102,23 +6977,26 @@ qmckl_exit_code qmckl_provide_een_rescaled_n(qmckl_context context) | ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | out | Electron-nucleus rescaled distances | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_een_rescaled_n_f( & +function qmckl_compute_een_rescaled_n( & context, walk_num, elec_num, nucl_num, & type_nucl_num, type_nucl_vector, cord_num, rescale_factor_en, & en_distance, een_rescaled_n) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding 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) :: type_nucl_num - integer*8 , intent(in) :: type_nucl_vector(nucl_num) - integer*8 , intent(in) :: cord_num - double precision , intent(in) :: rescale_factor_en(type_nucl_num) - double precision , intent(in) :: en_distance(nucl_num,elec_num,walk_num) - double precision , intent(out) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) + 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 :: cord_num + real (c_double ) , intent(in) :: rescale_factor_en(nucl_num) + real (c_double ) , intent(in) :: en_distance(nucl_num,elec_num,walk_num) + real (c_double ) , intent(out) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) + integer(qmckl_exit_code) :: info + double precision :: x integer*8 :: i, a, k, l, nw @@ -7170,12 +7048,12 @@ integer function qmckl_compute_een_rescaled_n_f( & end do -end function qmckl_compute_een_rescaled_n_f +end function qmckl_compute_een_rescaled_n #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes /* -qmckl_exit_code qmckl_compute_een_rescaled_n ( +qmckl_exit_code qmckl_compute_een_rescaled_n_hpc ( const qmckl_context context, const int64_t walk_num, const int64_t elec_num, @@ -7239,53 +7117,6 @@ qmckl_exit_code qmckl_compute_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, & - type_nucl_num, & - type_nucl_vector, & - cord_num, & - rescale_factor_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 :: type_nucl_num - integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num) - integer (c_int64_t) , intent(in) , value :: cord_num - real (c_double ) , intent(in) :: rescale_factor_en(nucl_num) - real (c_double ) , intent(in) :: en_distance(nucl_num,elec_num,walk_num) - real (c_double ) , intent(out) :: een_rescaled_n(elec_num,nucl_num,0:cord_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, & - type_nucl_num, & - type_nucl_vector, & - cord_num, & - rescale_factor_en, & - en_distance, & - een_rescaled_n) - - end function qmckl_compute_een_rescaled_n - #+end_src - # #+CALL: generate_c_header(table=qmckl_factor_een_rescaled_n_args,rettyp=get_value("CRetType"),fname=get_value("Name")) #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none @@ -7524,27 +7355,30 @@ qmckl_exit_code qmckl_provide_een_rescaled_n_gl(qmckl_context context) | ~een_rescaled_n_gl~ | ~double[walk_num][0:cord_num][nucl_num][4][elec_num]~ | out | Electron-nucleus rescaled distances | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_jastrow_champ_factor_een_rescaled_n_gl_f( & +function qmckl_compute_jastrow_champ_factor_een_rescaled_n_gl( & context, walk_num, elec_num, nucl_num, type_nucl_num, type_nucl_vector, & cord_num, rescale_factor_en, & coord_ee, coord_n, en_distance, een_rescaled_n, een_rescaled_n_gl) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding 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) :: type_nucl_num - integer*8 , intent(in) :: type_nucl_vector(nucl_num) - integer*8 , intent(in) :: cord_num - double precision , intent(in) :: rescale_factor_en(type_nucl_num) - double precision , intent(in) :: coord_ee(elec_num,3,walk_num) - double precision , intent(in) :: coord_n(nucl_num,3) - double precision , intent(in) :: en_distance(nucl_num,elec_num,walk_num) - double precision , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) - double precision , intent(out) :: een_rescaled_n_gl(elec_num,4,nucl_num,0:cord_num,walk_num) - double precision,dimension(:,:,:),allocatable :: elnuc_dist_gl + 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 :: cord_num + real (c_double ) , intent(in) :: rescale_factor_en(nucl_num) + real (c_double ) , intent(in) :: coord_ee(elec_num,3,walk_num) + real (c_double ) , intent(in) :: coord_n(nucl_num,3) + real (c_double ) , intent(in) :: en_distance(nucl_num,elec_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) + real (c_double ) , intent(out) :: een_rescaled_n_gl(elec_num,4,nucl_num,0:cord_num,walk_num) + integer(qmckl_exit_code) :: info + + double precision,allocatable :: elnuc_dist_gl(:,:,:) double precision :: x, ria_inv, kappa_l integer*8 :: i, a, k, l, nw, ii @@ -7617,7 +7451,7 @@ integer function qmckl_compute_jastrow_champ_factor_een_rescaled_n_gl_f( & end do end do -end function qmckl_compute_jastrow_champ_factor_een_rescaled_n_gl_f +end function qmckl_compute_jastrow_champ_factor_een_rescaled_n_gl #+end_src # #+CALL: generate_c_header(table=qmckl_compute_jastrow_champ_factor_een_rescaled_n_gl_args,rettyp=get_value("CRetType"),fname=get_value("Name")) @@ -7639,62 +7473,6 @@ end function qmckl_compute_jastrow_champ_factor_een_rescaled_n_gl_f double* const een_rescaled_n_gl ); #+end_src - #+CALL: generate_c_interface(table=qmckl_compute_jastrow_champ_factor_een_rescaled_n_gl_args,rettyp=get_value("CRetType"),fname=get_value("Name")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_jastrow_champ_factor_een_rescaled_n_gl & - (context, & - walk_num, & - elec_num, & - nucl_num, & - type_nucl_num, & - type_nucl_vector, & - cord_num, & - rescale_factor_en, & - coord_ee, & - coord_n, & - en_distance, & - een_rescaled_n, & - een_rescaled_n_gl) & - bind(C) result(info) - - use, intrinsic :: iso_c_binding - implicit none - - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) , value :: walk_num - integer (c_int64_t) , intent(in) , value :: elec_num - 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 :: cord_num - real (c_double ) , intent(in) :: rescale_factor_en(nucl_num) - real (c_double ) , intent(in) :: coord_ee(elec_num,3,walk_num) - real (c_double ) , intent(in) :: coord_n(nucl_num,3) - real (c_double ) , intent(in) :: en_distance(nucl_num,elec_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(out) :: een_rescaled_n_gl(elec_num,4,nucl_num,0:cord_num,walk_num) - - integer(c_int32_t), external :: qmckl_compute_jastrow_champ_factor_een_rescaled_n_gl_f - info = qmckl_compute_jastrow_champ_factor_een_rescaled_n_gl_f & - (context, & - walk_num, & - elec_num, & - nucl_num, & - type_nucl_num, & - type_nucl_vector, & - cord_num, & - rescale_factor_en, & - coord_ee, & - coord_n, & - en_distance, & - een_rescaled_n, & - een_rescaled_n_gl) - - end function qmckl_compute_jastrow_champ_factor_een_rescaled_n_gl - #+end_src - **** Test #+begin_src python :results output :exports none :noweb yes @@ -7834,14 +7612,17 @@ return [ ("$N_{ord}$", "Number of parameters"), ("","") ] + \ | ~dim_c_vector~ | ~int64_t~ | out | Number of parameters per atom type | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_dim_c_vector_f( & +function qmckl_compute_dim_c_vector_doc( & context, cord_num, dim_c_vector) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: cord_num - integer*8 , intent(out) :: dim_c_vector + integer(qmckl_context), intent(in) :: context + integer (c_int64_t) , intent(in) , value :: cord_num + integer (c_int64_t) , intent(out) :: dim_c_vector + integer(qmckl_exit_code) :: info + double precision :: x integer*8 :: i, a, k, l, p, lmax @@ -7873,11 +7654,11 @@ integer function qmckl_compute_dim_c_vector_f( & end do end do -end function qmckl_compute_dim_c_vector_f +end function qmckl_compute_dim_c_vector_doc #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_compute_dim_c_vector ( +qmckl_exit_code qmckl_compute_dim_c_vector_hpc ( const qmckl_context context, const int64_t cord_num, int64_t* const dim_c_vector){ @@ -7913,10 +7694,36 @@ qmckl_exit_code qmckl_compute_dim_c_vector ( } #+end_src + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_compute_dim_c_vector ( + const qmckl_context context, + const int64_t cord_num, + int64_t* const dim_c_vector) +{ +#ifdef QMCKL_HPC + return qmckl_compute_dim_c_vector_hpc +#else + return qmckl_compute_dim_c_vector_doc +#endif + (context, cord_num, dim_c_vector); +} + #+end_src + + # #+CALL: generate_c_header(table=qmckl_factor_dim_c_vector_args,rettyp=get_value("CRetType"),fname=get_value("Name")) #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none - qmckl_exit_code qmckl_compute_dim_c_vector ( + qmckl_exit_code qmckl_compute_dim_c_vector( + const qmckl_context context, + const int64_t cord_num, + int64_t* const dim_c_vector ); + + qmckl_exit_code qmckl_compute_dim_c_vector_doc( + const qmckl_context context, + const int64_t cord_num, + int64_t* const dim_c_vector ); + + qmckl_exit_code qmckl_compute_dim_c_vector_hpc( const qmckl_context context, const int64_t cord_num, int64_t* const dim_c_vector ); @@ -8259,19 +8066,22 @@ qmckl_exit_code qmckl_provide_dtmp_c(qmckl_context context) | ~c_vector_full~ | ~double[nucl_num][dim_c_vector]~ | out | Full list of coefficients | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_c_vector_full_doc_f( & +function qmckl_compute_c_vector_full_doc( & context, nucl_num, dim_c_vector, type_nucl_num, & type_nucl_vector, c_vector, c_vector_full) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: nucl_num - integer*8 , intent(in) :: dim_c_vector - integer*8 , intent(in) :: type_nucl_num - integer*8 , intent(in) :: type_nucl_vector(nucl_num) - double precision , intent(in) :: c_vector(dim_c_vector, type_nucl_num) - double precision , intent(out) :: c_vector_full(nucl_num, dim_c_vector) + integer(qmckl_context), intent(in) :: context + integer (c_int64_t) , intent(in) , value :: nucl_num + integer (c_int64_t) , intent(in) , value :: dim_c_vector + 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) :: c_vector(type_nucl_num,dim_c_vector) + real (c_double ) , intent(out) :: c_vector_full(nucl_num,dim_c_vector) + integer(qmckl_exit_code) :: info + double precision :: x integer*8 :: i, a, k, l, nw @@ -8287,33 +8097,7 @@ integer function qmckl_compute_c_vector_full_doc_f( & c_vector_full(a,1:dim_c_vector) = c_vector(1:dim_c_vector, type_nucl_vector(a)+1) end do -end function qmckl_compute_c_vector_full_doc_f - #+end_src - - #+CALL: generate_c_interface(table=qmckl_factor_c_vector_full_args,rettyp=get_value("CRetType"),fname="qmckl_compute_c_vector_full_doc") - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_c_vector_full_doc & - (context, nucl_num, dim_c_vector, type_nucl_num, type_nucl_vector, c_vector, c_vector_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 :: dim_c_vector - 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) :: c_vector(type_nucl_num,dim_c_vector) - real (c_double ) , intent(out) :: c_vector_full(nucl_num,dim_c_vector) - - integer(c_int32_t), external :: qmckl_compute_c_vector_full_doc_f - info = qmckl_compute_c_vector_full_doc_f & - (context, nucl_num, dim_c_vector, type_nucl_num, type_nucl_vector, c_vector, c_vector_full) - - end function qmckl_compute_c_vector_full_doc +end function qmckl_compute_c_vector_full_doc #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes @@ -8415,15 +8199,18 @@ qmckl_exit_code qmckl_compute_c_vector_full ( | ~lkpm_combined_index~ | ~int64_t[4][dim_c_vector]~ | out | Full list of combined indices | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_lkpm_combined_index_doc_f( & +function qmckl_compute_lkpm_combined_index_doc( & context, cord_num, dim_c_vector, lkpm_combined_index) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: cord_num - integer*8 , intent(in) :: dim_c_vector - integer*8 , intent(out) :: lkpm_combined_index(dim_c_vector, 4) + integer(qmckl_context), intent(in) :: context + integer (c_int64_t) , intent(in) , value :: cord_num + integer (c_int64_t) , intent(in) , value :: dim_c_vector + integer (c_int64_t) , intent(out) :: lkpm_combined_index(dim_c_vector,4) + integer(qmckl_exit_code) :: info + double precision :: x integer*8 :: i, a, k, l, kk, p, lmax, m @@ -8454,7 +8241,7 @@ integer function qmckl_compute_lkpm_combined_index_doc_f( & end do end do -end function qmckl_compute_lkpm_combined_index_doc_f +end function qmckl_compute_lkpm_combined_index_doc #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes @@ -8494,28 +8281,6 @@ qmckl_exit_code qmckl_compute_lkpm_combined_index_hpc ( } #+end_src - #+CALL: generate_c_interface(table=lkpm_combined_index_args,rettyp=get_value("CRetType"),fname="qmckl_compute_lkpm_combined_index_doc") - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_lkpm_combined_index_doc & - (context, cord_num, dim_c_vector, lkpm_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_c_vector - integer (c_int64_t) , intent(out) :: lkpm_combined_index(dim_c_vector,4) - - integer(c_int32_t), external :: qmckl_compute_lkpm_combined_index_doc_f - info = qmckl_compute_lkpm_combined_index_doc_f & - (context, cord_num, dim_c_vector, lkpm_combined_index) - - end function qmckl_compute_lkpm_combined_index_doc - #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes qmckl_exit_code qmckl_compute_lkpm_combined_index ( @@ -8636,20 +8401,23 @@ qmckl_exit_code qmckl_compute_tmp_c (const qmckl_context context, #+end_src #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_tmp_c_doc_f( & +function qmckl_compute_tmp_c_doc( & context, cord_num, elec_num, nucl_num, & walk_num, een_rescaled_e, een_rescaled_n, tmp_c) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: cord_num - integer*8 , intent(in) :: elec_num - integer*8 , intent(in) :: nucl_num - integer*8 , intent(in) :: walk_num - double precision , intent(in) :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) - double precision , intent(out) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) + integer (c_int64_t) , intent(in) , value :: cord_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) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) + real (c_double ) , intent(out) :: tmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) + integer(qmckl_exit_code) :: info + double precision :: x integer*8 :: i, j, a, l, kk, p, lmax, nw character :: TransA, TransB @@ -8679,16 +8447,16 @@ integer function qmckl_compute_tmp_c_doc_f( & LDC = size(tmp_c,1) do nw=1, walk_num - do i=0, cord_num-1 - info = qmckl_dgemm(context, TransA, TransB, M, N, K, alpha, & - een_rescaled_e(1,1,i,nw),LDA*1_8, & - een_rescaled_n(1,1,0,nw),LDB*1_8, & - beta, & - tmp_c(1,1,0,i,nw),LDC) - end do + do i=0, cord_num-1 + info = qmckl_dgemm(context, TransA, TransB, M, N, K, alpha, & + een_rescaled_e(1,1,i,nw),LDA*1_8, & + een_rescaled_n(1,1,0,nw),LDB*1_8, & + beta, & + tmp_c(1,1,0,i,nw),LDC) + end do end do -end function qmckl_compute_tmp_c_doc_f +end function qmckl_compute_tmp_c_doc #+end_src #+begin_src c :tangle (eval h_private_func) :comments org @@ -8703,33 +8471,6 @@ qmckl_exit_code qmckl_compute_tmp_c_doc ( double* const tmp_c ); #+end_src - #+CALL: generate_c_interface(table=qmckl_factor_tmp_c_args,rettyp=get_value("FRetType"),fname="qmckl_compute_tmp_c_doc") - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none -integer(c_int32_t) function qmckl_compute_tmp_c_doc & - (context, cord_num, elec_num, nucl_num, walk_num, een_rescaled_e, een_rescaled_n, tmp_c) & - 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 :: 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) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(out) :: tmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) - - integer(c_int32_t), external :: qmckl_compute_tmp_c_doc_f - info = qmckl_compute_tmp_c_doc_f & - (context, cord_num, elec_num, nucl_num, walk_num, een_rescaled_e, een_rescaled_n, tmp_c) - -end function qmckl_compute_tmp_c_doc - #+end_src - ***** CPU :noexport: #+begin_src c :comments org :tangle (eval c) :noweb yes @@ -8885,20 +8626,23 @@ qmckl_compute_dtmp_c (const qmckl_context context, #+end_src #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_dtmp_c_doc_f( & +function qmckl_compute_dtmp_c_doc( & context, cord_num, elec_num, nucl_num, & walk_num, een_rescaled_e_gl, een_rescaled_n, dtmp_c) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: cord_num - integer*8 , intent(in) :: elec_num - integer*8 , intent(in) :: nucl_num - integer*8 , intent(in) :: walk_num - double precision , intent(in) :: een_rescaled_e_gl(elec_num, 4, elec_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) - double precision , intent(out) :: dtmp_c(elec_num, 4, nucl_num,0:cord_num, 0:cord_num-1, walk_num) + integer(qmckl_context), intent(in) :: context + integer (c_int64_t) , intent(in) , value :: cord_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) :: een_rescaled_e_gl(elec_num,4,elec_num,0:cord_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) + real (c_double ) , intent(out) :: dtmp_c(elec_num,4,nucl_num,0:cord_num,0:cord_num-1,walk_num) + integer(qmckl_exit_code) :: info + double precision :: x integer*8 :: i, j, a, l, kk, p, lmax, nw, ii character :: TransA, TransB @@ -8936,35 +8680,8 @@ integer function qmckl_compute_dtmp_c_doc_f( & end do end do -end function qmckl_compute_dtmp_c_doc_f - #+end_src - - #+CALL: generate_c_interface(table=qmckl_factor_dtmp_c_args,rettyp=get_value("FRetType"),fname="qmckl_compute_dtmp_c_doc") - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none -integer(c_int32_t) function qmckl_compute_dtmp_c_doc & - (context, cord_num, elec_num, nucl_num, walk_num, een_rescaled_e_gl, een_rescaled_n, dtmp_c) & - 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 :: 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) :: een_rescaled_e_gl(elec_num,4,elec_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(out) :: dtmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) - - integer(c_int32_t), external :: qmckl_compute_dtmp_c_doc_f - info = qmckl_compute_dtmp_c_doc_f & - (context, cord_num, elec_num, nucl_num, walk_num, een_rescaled_e_gl, een_rescaled_n, dtmp_c) - end function qmckl_compute_dtmp_c_doc - #+end_src + #+end_src #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none qmckl_exit_code qmckl_compute_dtmp_c_doc ( @@ -9325,20 +9042,26 @@ qmckl_exit_code qmckl_provide_jastrow_champ_factor_een(qmckl_context context) | ~factor_een~ | ~double[walk_num]~ | out | Electron-nucleus jastrow | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_jastrow_champ_factor_een_naive_f( & +function qmckl_compute_jastrow_champ_factor_een_naive( & context, walk_num, elec_num, nucl_num, cord_num,& dim_c_vector, c_vector_full, lkpm_combined_index, & een_rescaled_e, een_rescaled_n, factor_een) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: walk_num, elec_num, cord_num, nucl_num, dim_c_vector - integer*8 , intent(in) :: lkpm_combined_index(dim_c_vector,4) - double precision , intent(in) :: c_vector_full(nucl_num, dim_c_vector) - double precision , intent(in) :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) - double precision , intent(out) :: factor_een(walk_num) + integer(qmckl_context), intent(in) :: 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_c_vector + real (c_double ) , intent(in) :: c_vector_full(nucl_num,dim_c_vector) + integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,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(qmckl_exit_code) :: info integer*8 :: i, a, j, l, k, p, m, n, nw double precision :: accu, accu2, cn @@ -9405,7 +9128,8 @@ integer function qmckl_compute_jastrow_champ_factor_een_naive_f( & end do end do -end function qmckl_compute_jastrow_champ_factor_een_naive_f +end function qmckl_compute_jastrow_champ_factor_een_naive + #+end_src # #+CALL: generate_c_header(table=qmckl_factor_een_naive_args,rettyp=get_value("CRetType"),fname=get_value("Name")) @@ -9425,56 +9149,6 @@ end function qmckl_compute_jastrow_champ_factor_een_naive_f double* const factor_een ); #+end_src - #+CALL: generate_c_interface(table=qmckl_factor_een_naive_args,rettyp=get_value("CRetType"),fname=get_value("Name")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_jastrow_champ_factor_een_naive & - (context, & - walk_num, & - elec_num, & - nucl_num, & - cord_num, & - dim_c_vector, & - c_vector_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_c_vector - real (c_double ) , intent(in) :: c_vector_full(nucl_num,dim_c_vector) - integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,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_jastrow_champ_factor_een_naive_f - info = qmckl_compute_jastrow_champ_factor_een_naive_f & - (context, & - walk_num, & - elec_num, & - nucl_num, & - cord_num, & - dim_c_vector, & - c_vector_full, & - lkpm_combined_index, & - een_rescaled_e, & - een_rescaled_n, & - factor_een) - - end function qmckl_compute_jastrow_champ_factor_een_naive - #+end_src - **** Compute :PROPERTIES: :Name: qmckl_compute_jastrow_champ_factor_een_doc @@ -9498,20 +9172,26 @@ end function qmckl_compute_jastrow_champ_factor_een_naive_f | ~factor_een~ | ~double[walk_num]~ | out | Electron-nucleus jastrow | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_jastrow_champ_factor_een_doc_f( & +function qmckl_compute_jastrow_champ_factor_een_doc( & context, walk_num, elec_num, nucl_num, cord_num, & dim_c_vector, c_vector_full, lkpm_combined_index, & tmp_c, een_rescaled_n, factor_een) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: walk_num, elec_num, cord_num, nucl_num, dim_c_vector - integer*8 , intent(in) :: lkpm_combined_index(dim_c_vector,4) - double precision , intent(in) :: c_vector_full(nucl_num, dim_c_vector) - double precision , intent(in) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) - double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) - double precision , intent(out) :: factor_een(walk_num) + integer(qmckl_context), intent(in) :: 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_c_vector + real (c_double ) , intent(in) :: c_vector_full(nucl_num,dim_c_vector) + integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,4) + real (c_double ) , intent(in) :: tmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) + real (c_double ) , intent(out) :: factor_een(walk_num) + integer(qmckl_exit_code) :: info integer*8 :: i, a, j, l, k, p, m, n, nw double precision :: accu, accu2, cn @@ -9549,7 +9229,7 @@ integer function qmckl_compute_jastrow_champ_factor_een_doc_f( & end do end do -end function qmckl_compute_jastrow_champ_factor_een_doc_f +end function qmckl_compute_jastrow_champ_factor_een_doc #+end_src # #+CALL: generate_c_header(table=qmckl_factor_een_args,rettyp=qmckl_exit_code),fname=get_value("Name")) @@ -9607,55 +9287,6 @@ qmckl_compute_jastrow_champ_factor_een (const qmckl_context context, factor_een ); } #+end_src - #+CALL: generate_c_interface(table=qmckl_factor_een_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_factor_een_doc")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_jastrow_champ_factor_een_doc & - (context, & - walk_num, & - elec_num, & - nucl_num, & - cord_num, & - dim_c_vector, & - c_vector_full, & - lkpm_combined_index, & - tmp_c, & - 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_c_vector - real (c_double ) , intent(in) :: c_vector_full(nucl_num,dim_c_vector) - integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,4) - real (c_double ) , intent(in) :: tmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) - real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(out) :: factor_een(walk_num) - - integer(c_int32_t), external :: qmckl_compute_jastrow_champ_factor_een_doc_f - info = qmckl_compute_jastrow_champ_factor_een_doc_f & - (context, & - walk_num, & - elec_num, & - nucl_num, & - cord_num, & - dim_c_vector, & - c_vector_full, & - lkpm_combined_index, & - tmp_c, & - een_rescaled_n, & - factor_een) - - end function qmckl_compute_jastrow_champ_factor_een_doc - #+end_src **** Test #+begin_src python :results output :exports none :noweb yes @@ -9716,13 +9347,18 @@ qmckl_exit_code qmckl_get_jastrow_champ_factor_een_gl(qmckl_context context, double* const factor_een_gl, const int64_t size_max); + +qmckl_exit_code +qmckl_get_jastrow_champ_factor_een_grad(qmckl_context context, + double* const factor_een_grad, + const int64_t size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_get_jastrow_champ_factor_een_gl(qmckl_context context, - double* const factor_een_gl, - const int64_t size_max) + double* const factor_een_gl, + const int64_t size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -9745,6 +9381,35 @@ qmckl_get_jastrow_champ_factor_een_gl(qmckl_context context, } memcpy(factor_een_gl, ctx->jastrow_champ.factor_een_gl, sze*sizeof(double)); + return QMCKL_SUCCESS; +} + +qmckl_exit_code +qmckl_get_jastrow_champ_factor_een_grad(qmckl_context context, + double* const factor_een_grad, + const int64_t size_max) +{ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_jastrow_champ_factor_een_grad(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct*) context; + assert (ctx != NULL); + + int64_t sze = ctx->electron.walker.num * 3 * ctx->electron.num; + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_champ_factor_een_grad", + "Array too small. Expected 3*walk_num*elec_num"); + } + memcpy(factor_een_grad, ctx->jastrow_champ.factor_een_grad, sze*sizeof(double)); + return QMCKL_SUCCESS; } #+end_src @@ -9763,11 +9428,24 @@ interface real(c_double), intent(out) :: factor_een_gl(size_max) end function qmckl_get_jastrow_champ_factor_een_gl end interface + +interface + integer(qmckl_exit_code) function qmckl_get_jastrow_champ_factor_een_grad (context, & + factor_een_grad, size_max) bind(C) + use, intrinsic :: iso_c_binding + import + implicit none + integer (qmckl_context) , intent(in), value :: context + integer(c_int64_t), intent(in), value :: size_max + real(c_double), intent(out) :: factor_een_grad(size_max) + end function qmckl_get_jastrow_champ_factor_een_grad +end interface #+end_src # **** Provide :noexport: #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none qmckl_exit_code qmckl_provide_jastrow_champ_factor_een_gl(qmckl_context context); +qmckl_exit_code qmckl_provide_jastrow_champ_factor_een_grad(qmckl_context context); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none @@ -9851,34 +9529,34 @@ qmckl_exit_code qmckl_provide_jastrow_champ_factor_een_gl(qmckl_context context) } /* - rc = qmckl_compute_jastrow_champ_factor_een_gl_naive (context, - ctx->electron.walker.num, - ctx->electron.num, - ctx->nucleus.num, - ctx->jastrow_champ.cord_num, - ctx->jastrow_champ.dim_c_vector, - ctx->jastrow_champ.c_vector_full, - ctx->jastrow_champ.lkpm_combined_index, - ctx->jastrow_champ.een_rescaled_e, - ctx->jastrow_champ.een_rescaled_n, - ctx->jastrow_champ.een_rescaled_e_gl, - ctx->jastrow_champ.een_rescaled_n_gl, - ctx->jastrow_champ.factor_een_gl); - ,*/ + rc = qmckl_compute_jastrow_champ_factor_een_gl_naive (context, + ctx->electron.walker.num, + ctx->electron.num, + ctx->nucleus.num, + ctx->jastrow_champ.cord_num, + ctx->jastrow_champ.dim_c_vector, + ctx->jastrow_champ.c_vector_full, + ctx->jastrow_champ.lkpm_combined_index, + ctx->jastrow_champ.een_rescaled_e, + ctx->jastrow_champ.een_rescaled_n, + ctx->jastrow_champ.een_rescaled_e_gl, + ctx->jastrow_champ.een_rescaled_n_gl, + ctx->jastrow_champ.factor_een_gl); + ,*/ rc = qmckl_compute_jastrow_champ_factor_een_gl(context, - ctx->electron.walker.num, - ctx->electron.num, - ctx->nucleus.num, - ctx->jastrow_champ.cord_num, - ctx->jastrow_champ.dim_c_vector, - ctx->jastrow_champ.c_vector_full, - ctx->jastrow_champ.lkpm_combined_index, - ctx->jastrow_champ.tmp_c, - ctx->jastrow_champ.dtmp_c, - ctx->jastrow_champ.een_rescaled_n, - ctx->jastrow_champ.een_rescaled_n_gl, - ctx->jastrow_champ.factor_een_gl); + ctx->electron.walker.num, + ctx->electron.num, + ctx->nucleus.num, + ctx->jastrow_champ.cord_num, + ctx->jastrow_champ.dim_c_vector, + ctx->jastrow_champ.c_vector_full, + ctx->jastrow_champ.lkpm_combined_index, + ctx->jastrow_champ.tmp_c, + ctx->jastrow_champ.dtmp_c, + ctx->jastrow_champ.een_rescaled_n, + ctx->jastrow_champ.een_rescaled_n_gl, + ctx->jastrow_champ.factor_een_gl); if (rc != QMCKL_SUCCESS) { return rc; @@ -9887,6 +9565,110 @@ qmckl_exit_code qmckl_provide_jastrow_champ_factor_een_gl(qmckl_context context) ctx->jastrow_champ.factor_een_gl_date = ctx->date; } + return QMCKL_SUCCESS; +} + + +qmckl_exit_code qmckl_provide_jastrow_champ_factor_een_grad(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*) context; + assert (ctx != NULL); + + if (ctx->jastrow_champ.cord_num > 0) { + + /* 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_gl(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Check if en rescaled distance derivatives is provided */ + rc = qmckl_provide_een_rescaled_n_gl(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Check if en rescaled distance derivatives is provided */ + rc = qmckl_provide_jastrow_champ_c_vector_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; + + /* Check if tmp_c is provided */ + rc = qmckl_provide_tmp_c(context); + if(rc != QMCKL_SUCCESS) return rc; + + /* Check if dtmp_c is provided */ + rc = qmckl_provide_dtmp_c(context); + if(rc != QMCKL_SUCCESS) return rc; + + } + + /* Compute if necessary */ + if (ctx->date > ctx->jastrow_champ.factor_een_grad_date) { + + if (ctx->electron.walker.num > ctx->electron.walker_old.num) { + if (ctx->jastrow_champ.factor_een_grad != NULL) { + rc = qmckl_free(context, ctx->jastrow_champ.factor_een_grad); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_provide_jastrow_champ_factor_een_grad", + "Unable to free ctx->jastrow_champ.factor_een_grad"); + } + ctx->jastrow_champ.factor_een_grad = NULL; + } + } + + /* Allocate array */ + if (ctx->jastrow_champ.factor_een_grad == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = 4 * ctx->electron.num * ctx->electron.walker.num * sizeof(double); + double* factor_een_grad = (double*) qmckl_malloc(context, mem_info); + + if (factor_een_grad == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_provide_jastrow_champ_factor_een_grad", + NULL); + } + ctx->jastrow_champ.factor_een_grad = factor_een_grad; + } + + rc = qmckl_compute_jastrow_champ_factor_een_grad(context, + ctx->electron.walker.num, + ctx->electron.num, + ctx->nucleus.num, + ctx->jastrow_champ.cord_num, + ctx->jastrow_champ.dim_c_vector, + ctx->jastrow_champ.c_vector_full, + ctx->jastrow_champ.lkpm_combined_index, + ctx->jastrow_champ.tmp_c, + ctx->jastrow_champ.dtmp_c, + ctx->jastrow_champ.een_rescaled_n, + ctx->jastrow_champ.een_rescaled_n_gl, + ctx->jastrow_champ.factor_een_grad); + + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->jastrow_champ.factor_een_grad_date = ctx->date; + } + return QMCKL_SUCCESS; } #+end_src @@ -9916,22 +9698,28 @@ qmckl_exit_code qmckl_provide_jastrow_champ_factor_een_gl(qmckl_context context) | ~factor_een_gl~ | ~double[walk_num][4][elec_num]~ | out | Electron-nucleus jastrow | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_jastrow_champ_factor_een_gl_naive_f( & +function qmckl_compute_jastrow_champ_factor_een_gl_naive( & context, walk_num, elec_num, nucl_num, cord_num, dim_c_vector, & c_vector_full, lkpm_combined_index, een_rescaled_e, een_rescaled_n, & een_rescaled_e_gl, een_rescaled_n_gl, factor_een_gl)& - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: walk_num, elec_num, cord_num, nucl_num, dim_c_vector - integer*8 , intent(in) :: lkpm_combined_index(dim_c_vector, 4) - double precision , intent(in) :: c_vector_full(nucl_num, dim_c_vector) - double precision , intent(in) :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_e_gl(elec_num, 4, elec_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_n_gl(elec_num, 4, nucl_num, 0:cord_num, walk_num) - double precision , intent(out) :: factor_een_gl(elec_num, 4, walk_num) + integer(qmckl_context), intent(in) :: 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_c_vector + real (c_double ) , intent(in) :: c_vector_full(nucl_num,dim_c_vector) + integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,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_gl(0:cord_num,elec_num,4,elec_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n_gl(0:cord_num,nucl_num,4,elec_num,walk_num) + real (c_double ) , intent(out) :: factor_een_gl(elec_num,4,walk_num) + integer(qmckl_exit_code) :: info integer*8 :: i, a, j, l, k, p, m, n, nw double precision :: accu, accu2, cn @@ -9989,7 +9777,7 @@ integer function qmckl_compute_jastrow_champ_factor_een_gl_naive_f( & end do end do -end function qmckl_compute_jastrow_champ_factor_een_gl_naive_f +end function qmckl_compute_jastrow_champ_factor_een_gl_naive #+end_src # #+CALL: generate_c_header(table=qmckl_factor_een_gl_naive_args,rettyp=get_value("CRetType"),fname=get_value("Name")) @@ -10011,64 +9799,7 @@ end function qmckl_compute_jastrow_champ_factor_een_gl_naive_f double* const factor_een_gl ); #+end_src - - #+CALL: generate_c_interface(table=qmckl_factor_een_gl_naive_args,rettyp=get_value("CRetType"),fname=get_value("Name")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_jastrow_champ_factor_een_gl_naive & - (context, & - walk_num, & - elec_num, & - nucl_num, & - cord_num, & - dim_c_vector, & - c_vector_full, & - lkpm_combined_index, & - een_rescaled_e, & - een_rescaled_n, & - een_rescaled_e_gl, & - een_rescaled_n_gl, & - factor_een_gl) & - bind(C) result(info) - - use, intrinsic :: iso_c_binding - implicit none - - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) , value :: walk_num - integer (c_int64_t) , intent(in) , value :: elec_num - 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_c_vector - real (c_double ) , intent(in) :: c_vector_full(nucl_num,dim_c_vector) - integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,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_gl(0:cord_num,elec_num,4,elec_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_n_gl(0:cord_num,nucl_num,4,elec_num,walk_num) - real (c_double ) , intent(out) :: factor_een_gl(elec_num,4,walk_num) - - integer(c_int32_t), external :: qmckl_compute_jastrow_champ_factor_een_gl_naive_f - info = qmckl_compute_jastrow_champ_factor_een_gl_naive_f & - (context, & - walk_num, & - elec_num, & - nucl_num, & - cord_num, & - dim_c_vector, & - c_vector_full, & - lkpm_combined_index, & - een_rescaled_e, & - een_rescaled_n, & - een_rescaled_e_gl, & - een_rescaled_n_gl, & - factor_een_gl) - - end function qmckl_compute_jastrow_champ_factor_een_gl_naive - #+end_src - -**** Compute +**** Compute GL :PROPERTIES: :Name: qmckl_compute_jastrow_champ_factor_een_gl :CRetType: qmckl_exit_code @@ -10094,22 +9825,28 @@ end function qmckl_compute_jastrow_champ_factor_een_gl_naive_f #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_jastrow_champ_factor_een_gl_doc_f( & +function qmckl_compute_jastrow_champ_factor_een_gl_doc( & context, walk_num, elec_num, nucl_num, & cord_num, dim_c_vector, c_vector_full, lkpm_combined_index, & tmp_c, dtmp_c, een_rescaled_n, een_rescaled_n_gl, factor_een_gl)& - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: walk_num, elec_num, cord_num, nucl_num, dim_c_vector - integer*8 , intent(in) :: lkpm_combined_index(dim_c_vector,4) - double precision , intent(in) :: c_vector_full(nucl_num, dim_c_vector) - double precision , intent(in) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) - double precision , intent(in) :: dtmp_c(elec_num, 4, nucl_num,0:cord_num, 0:cord_num-1, walk_num) - double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_n_gl(elec_num, 4, nucl_num, 0:cord_num, walk_num) - double precision , intent(out) :: factor_een_gl(elec_num,4,walk_num) + integer(qmckl_context), intent(in) :: 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_c_vector + real (c_double ) , intent(in) :: c_vector_full(nucl_num,dim_c_vector) + integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,4) + real (c_double ) , intent(in) :: tmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) + real (c_double ) , intent(in) :: dtmp_c(elec_num,4,nucl_num,0:cord_num,0:cord_num-1,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n_gl(elec_num,4,nucl_num,0:cord_num,walk_num) + real (c_double ) , intent(out) :: factor_een_gl(elec_num,4,walk_num) + integer(qmckl_exit_code) :: info integer*8 :: i, a, j, l, k, m, n, nw, ii double precision :: accu, accu2, cn @@ -10163,7 +9900,7 @@ integer function qmckl_compute_jastrow_champ_factor_een_gl_doc_f( & end do end do -end function qmckl_compute_jastrow_champ_factor_een_gl_doc_f +end function qmckl_compute_jastrow_champ_factor_een_gl_doc #+end_src #+CALL: generate_private_c_header(table=qmckl_factor_een_gl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_factor_een_gl_doc" ) @@ -10186,62 +9923,6 @@ end function qmckl_compute_jastrow_champ_factor_een_gl_doc_f double* const factor_een_gl ); #+end_src - #+CALL: generate_c_interface(table=qmckl_factor_een_gl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_factor_een_gl_doc")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_jastrow_champ_factor_een_gl_doc & - (context, & - walk_num, & - elec_num, & - nucl_num, & - cord_num, & - dim_c_vector, & - c_vector_full, & - lkpm_combined_index, & - tmp_c, & - dtmp_c, & - een_rescaled_n, & - een_rescaled_n_gl, & - factor_een_gl) & - bind(C) result(info) - - use, intrinsic :: iso_c_binding - implicit none - - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) , value :: walk_num - integer (c_int64_t) , intent(in) , value :: elec_num - 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_c_vector - real (c_double ) , intent(in) :: c_vector_full(nucl_num,dim_c_vector) - integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,4) - real (c_double ) , intent(in) :: tmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) - real (c_double ) , intent(in) :: dtmp_c(elec_num,4,nucl_num,0:cord_num,0:cord_num-1,walk_num) - real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_n_gl(elec_num,4,nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(out) :: factor_een_gl(elec_num,4,walk_num) - - integer(c_int32_t), external :: qmckl_compute_jastrow_champ_factor_een_gl_doc_f - info = qmckl_compute_jastrow_champ_factor_een_gl_doc_f & - (context, & - walk_num, & - elec_num, & - nucl_num, & - cord_num, & - dim_c_vector, & - c_vector_full, & - lkpm_combined_index, & - tmp_c, & - dtmp_c, & - een_rescaled_n, & - een_rescaled_n_gl, & - factor_een_gl) - - end function qmckl_compute_jastrow_champ_factor_een_gl_doc - #+end_src - #+CALL: generate_private_c_header(table=qmckl_factor_een_gl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_factor_een_gl" ) #+RESULTS: @@ -10535,7 +10216,7 @@ qmckl_compute_jastrow_champ_factor_een_gl_hpc(const qmckl_context context, return info; } #+end_src -**** Test +***** Test #+begin_src python :results output :exports none :noweb yes import numpy as np @@ -10607,6 +10288,384 @@ printf("%20.15e\n", factor_een_gl[3][0][3]); assert(fabs(-1.175028308456619e+00 - factor_een_gl[3][0][3]) < 1e-12); #+end_src +**** Compute Gradient only + :PROPERTIES: + :Name: qmckl_compute_jastrow_champ_factor_een_grad + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_factor_een_grad_args + | Variable | Type | In/Out | Description | + |-----------------------+---------------------------------------------------------------------+--------+------------------------------------------------| + | ~context~ | ~qmckl_context~ | in | Global state | + | ~walk_num~ | ~int64_t~ | in | Number of walkers | + | ~elec_num~ | ~int64_t~ | in | Number of electrons | + | ~nucl_num~ | ~int64_t~ | in | Number of nuclei | + | ~cord_num~ | ~int64_t~ | in | order of polynomials | + | ~dim_c_vector~ | ~int64_t~ | in | dimension of full coefficient vector | + | ~c_vector_full~ | ~double[dim_c_vector][nucl_num]~ | in | full coefficient vector | + | ~lkpm_combined_index~ | ~int64_t[4][dim_c_vector]~ | in | combined indices | + | ~tmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | in | Temporary intermediate tensor | + | ~dtmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][4][elec_num]~ | in | vector of non-zero coefficients | + | ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | in | Electron-nucleus rescaled factor | + | ~een_rescaled_n_gl~ | ~double[walk_num][0:cord_num][nucl_num][4][elec_num]~ | in | Derivative of Electron-nucleus rescaled factor | + | ~factor_een_grad~ | ~double[walk_num][4][elec_num]~ | out | Derivative of Electron-nucleus jastrow | + + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +function qmckl_compute_jastrow_champ_factor_een_grad_doc( & + context, walk_num, elec_num, nucl_num, & + cord_num, dim_c_vector, c_vector_full, lkpm_combined_index, & + tmp_c, dtmp_c, een_rescaled_n, een_rescaled_n_gl, factor_een_grad) & + bind(C) result(info) + + use, intrinsic :: iso_c_binding + use qmckl + implicit none + integer(qmckl_context), intent(in) :: 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_c_vector + real (c_double ) , intent(in) :: c_vector_full(nucl_num,dim_c_vector) + integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,4) + real (c_double ) , intent(in) :: tmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) + real (c_double ) , intent(in) :: dtmp_c(elec_num,4,nucl_num,0:cord_num,0:cord_num-1,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n_gl(elec_num,4,nucl_num,0:cord_num,walk_num) + real (c_double ) , intent(out) :: factor_een_grad(elec_num,3,walk_num) + integer(qmckl_exit_code) :: info + + integer*8 :: i, a, j, l, k, m, n, nw, ii + double precision :: accu, accu2, cn + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) info = QMCKL_INVALID_CONTEXT + if (walk_num <= 0) info = QMCKL_INVALID_ARG_2 + if (elec_num <= 0) info = QMCKL_INVALID_ARG_3 + if (nucl_num <= 0) info = QMCKL_INVALID_ARG_4 + if (cord_num < 0) info = QMCKL_INVALID_ARG_5 + if (info /= QMCKL_SUCCESS) return + + + if (cord_num == 0) then + factor_een_grad = 0.0d0 + return + end if + + do nw =1, walk_num + factor_een_grad(:,:,nw) = 0.0d0 + do n = 1, dim_c_vector + l = lkpm_combined_index(n, 1) + k = lkpm_combined_index(n, 2) + m = lkpm_combined_index(n, 4) + + do a = 1, nucl_num + cn = c_vector_full(a, n) + if(cn == 0.d0) cycle + + do ii = 1, 3 + do j = 1, elec_num + factor_een_grad(j,ii,nw) = factor_een_grad(j,ii,nw) + ( & + tmp_c(j,a,m,k,nw) * een_rescaled_n_gl(j,ii,a,m+l,nw) + & + (dtmp_c(j,ii,a,m,k,nw)) * een_rescaled_n(j,a,m+l,nw) + & + (dtmp_c(j,ii,a,m+l,k,nw)) * een_rescaled_n(j,a,m ,nw) + & + tmp_c(j,a,m+l,k,nw) * een_rescaled_n_gl(j,ii,a,m,nw) & + ) * cn + end do + end do + + end do + end do + end do + +end function qmckl_compute_jastrow_champ_factor_een_grad_doc + #+end_src + + #+CALL: generate_private_c_header(table=qmckl_factor_een_grad_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_factor_een_grad_doc" ) + + #+RESULTS: + #+begin_src c :tangle (eval h_private_func) :comments org + qmckl_exit_code qmckl_compute_jastrow_champ_factor_een_grad_doc ( + 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_c_vector, + const double* c_vector_full, + const int64_t* lkpm_combined_index, + const double* tmp_c, + const double* dtmp_c, + const double* een_rescaled_n, + const double* een_rescaled_n_gl, + double* const factor_een_grad ); + #+end_src + + #+CALL: generate_private_c_header(table=qmckl_factor_een_grad_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_factor_een_grad" ) + + #+RESULTS: + #+begin_src c :tangle (eval h_private_func) :comments org + qmckl_exit_code qmckl_compute_jastrow_champ_factor_een_grad ( + 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_c_vector, + const double* c_vector_full, + const int64_t* lkpm_combined_index, + const double* tmp_c, + const double* dtmp_c, + const double* een_rescaled_n, + const double* een_rescaled_n_gl, + double* const factor_een_grad ); + #+end_src + + #+begin_src c :tangle (eval c) :comments org +qmckl_exit_code +qmckl_compute_jastrow_champ_factor_een_grad(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_c_vector, + const double *c_vector_full, + const int64_t *lkpm_combined_index, + const double *tmp_c, + const double *dtmp_c, + const double *een_rescaled_n, + const double *een_rescaled_n_gl, + double* const factor_een_grad) +{ +#ifdef HAVE_HPC + return qmckl_compute_jastrow_champ_factor_een_grad_hpc +#else + return qmckl_compute_jastrow_champ_factor_een_grad_doc +#endif + (context, walk_num, elec_num, nucl_num, + cord_num, dim_c_vector, c_vector_full, + lkpm_combined_index, tmp_c, dtmp_c, + een_rescaled_n, een_rescaled_n_gl, + factor_een_grad); +} +#+end_src +***** HPC implementation :noexport: + #+CALL: generate_private_c_header(table=qmckl_factor_een_grad_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_factor_een_grad_hpc" ) + + #+RESULTS: + #+begin_src c :tangle (eval h_private_func) :comments org +qmckl_exit_code +qmckl_compute_jastrow_champ_factor_een_grad_hpc ( + 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_c_vector, + const double* c_vector_full, + const int64_t* lkpm_combined_index, + const double* tmp_c, + const double* dtmp_c, + const double* een_rescaled_n, + const double* een_rescaled_n_gl, + double* const factor_een_grad ); + #+end_src + + #+begin_src c :tangle (eval c) :comments org +qmckl_exit_code +qmckl_compute_jastrow_champ_factor_een_grad_hpc(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_c_vector, + const double *c_vector_full, + const int64_t *lkpm_combined_index, + const double *tmp_c, + const double *dtmp_c, + const double *een_rescaled_n, + const double *een_rescaled_n_gl, + double* const factor_een_grad) +{ + + int64_t info = QMCKL_SUCCESS; + + if (context == QMCKL_NULL_CONTEXT) return QMCKL_INVALID_CONTEXT; + if (walk_num <= 0) return QMCKL_INVALID_ARG_2; + if (elec_num <= 0) return QMCKL_INVALID_ARG_3; + if (nucl_num <= 0) return QMCKL_INVALID_ARG_4; + if (cord_num < 0) return QMCKL_INVALID_ARG_5; + + + if (cord_num == 0) { +#ifdef HAVE_OPENMP +#pragma omp parallel for +#endif + for (size_t nw = 0; nw < (size_t) walk_num; ++nw) { + memset(&factor_een_grad[elec_num*3*nw], 0, elec_num*3*sizeof(double)); + } + return QMCKL_SUCCESS; + } + + const size_t elec_num2 = elec_num << 1; + +#ifdef HAVE_OPENMP +#pragma omp parallel for +#endif + for (size_t nw = 0; nw < (size_t) walk_num; ++nw) { + bool touched = false; + double* const restrict factor_een_grad_0nw = &(factor_een_grad[elec_num*3*nw]); + for (size_t n = 0; n < (size_t) dim_c_vector; ++n) { + const size_t l = lkpm_combined_index[n]; + const size_t k = lkpm_combined_index[n+ dim_c_vector]; + const size_t m = lkpm_combined_index[n+3*dim_c_vector]; + + const size_t en = elec_num*nucl_num; + const size_t len = l*en; + const size_t len4 = len << 2; + const size_t cn = cord_num*nw; + const size_t c1 = cord_num+1; + const size_t addr0 = en*(m+c1*(k+cn)); + const size_t addr1 = en*(m+cn); + + const double* restrict tmp_c_mkn = &(tmp_c[addr0]); + const double* restrict tmp_c_mlkn = tmp_c_mkn + len; + const double* restrict een_rescaled_n_mnw = &(een_rescaled_n[addr1]); + const double* restrict een_rescaled_n_mlnw = een_rescaled_n_mnw + len; + const double* restrict dtmp_c_mknw = &(dtmp_c[addr0 << 2]); + const double* restrict dtmp_c_mlknw = dtmp_c_mknw + len4; + const double* restrict een_rescaled_n_gl_mnw = &(een_rescaled_n_gl[addr1 << 2]); + const double* restrict een_rescaled_n_gl_mlnw = een_rescaled_n_gl_mnw + len4; + for (size_t a = 0; a < (size_t) nucl_num; a++) { + double cn = c_vector_full[a+n*nucl_num]; + if (cn == 0.0) continue; + + const size_t ishift = elec_num*a; + const size_t ishift4 = ishift << 2; + + const double* restrict tmp_c_amlkn = tmp_c_mlkn + ishift; + const double* restrict tmp_c_amkn = tmp_c_mkn + ishift; + const double* restrict een_rescaled_n_amnw = een_rescaled_n_mnw + ishift; + const double* restrict een_rescaled_n_amlnw = een_rescaled_n_mlnw + ishift; + const double* restrict dtmp_c_0amknw = dtmp_c_mknw + ishift4; + const double* restrict dtmp_c_0amlknw = dtmp_c_mlknw + ishift4; + const double* restrict een_rescaled_n_gl_0amnw = een_rescaled_n_gl_mnw + ishift4; + const double* restrict een_rescaled_n_gl_0amlnw = een_rescaled_n_gl_mlnw + ishift4; + + const double* restrict dtmp_c_1amknw = dtmp_c_0amknw + elec_num; + const double* restrict dtmp_c_1amlknw = dtmp_c_0amlknw + elec_num; + const double* restrict dtmp_c_2amknw = dtmp_c_0amknw + elec_num2; + const double* restrict dtmp_c_2amlknw = dtmp_c_0amlknw + elec_num2; + const double* restrict een_rescaled_n_gl_1amnw = een_rescaled_n_gl_0amnw + elec_num; + const double* restrict een_rescaled_n_gl_1amlnw = een_rescaled_n_gl_0amlnw + elec_num; + const double* restrict een_rescaled_n_gl_2amnw = een_rescaled_n_gl_0amnw + elec_num2; + const double* restrict een_rescaled_n_gl_2amlnw = een_rescaled_n_gl_0amlnw + elec_num2; + double* const restrict factor_een_grad_1nw = factor_een_grad_0nw + elec_num; + double* const restrict factor_een_grad_2nw = factor_een_grad_0nw + elec_num2; + + if (touched) { +#ifdef HAVE_OPENMP +#pragma omp simd +#endif + for (size_t j = 0; j < (size_t) elec_num; ++j) { + factor_een_grad_0nw[j] = factor_een_grad_0nw[j] + cn * + (tmp_c_amkn[j] * een_rescaled_n_gl_0amlnw[j] + + dtmp_c_0amknw[j] * een_rescaled_n_amlnw[j] + + dtmp_c_0amlknw[j] * een_rescaled_n_amnw[j] + + tmp_c_amlkn[j] * een_rescaled_n_gl_0amnw[j]); + } + +#ifdef HAVE_OPENMP +#pragma omp simd +#endif + for (size_t j = 0; j < (size_t) elec_num; ++j) { + factor_een_grad_1nw[j] = factor_een_grad_1nw[j] + cn * + (tmp_c_amkn[j] * een_rescaled_n_gl_1amlnw[j] + + dtmp_c_1amknw[j] * een_rescaled_n_amlnw[j] + + dtmp_c_1amlknw[j] * een_rescaled_n_amnw[j] + + tmp_c_amlkn[j] * een_rescaled_n_gl_1amnw[j]); + } + +#ifdef HAVE_OPENMP +#pragma omp simd +#endif + for (size_t j = 0; j < (size_t) elec_num; ++j) { + factor_een_grad_2nw[j] = factor_een_grad_2nw[j] + cn * + (tmp_c_amkn[j] * een_rescaled_n_gl_2amlnw[j] + + dtmp_c_2amknw[j] * een_rescaled_n_amlnw[j] + + dtmp_c_2amlknw[j] * een_rescaled_n_amnw[j] + + tmp_c_amlkn[j] * een_rescaled_n_gl_2amnw[j]); + } + + } else { + + touched = true; + +#ifdef HAVE_OPENMP +#pragma omp simd +#endif + for (size_t j = 0; j < (size_t) elec_num; ++j) { + factor_een_grad_0nw[j] = cn * + (tmp_c_amkn[j] * een_rescaled_n_gl_0amlnw[j] + + dtmp_c_0amknw[j] * een_rescaled_n_amlnw[j] + + dtmp_c_0amlknw[j] * een_rescaled_n_amnw[j] + + tmp_c_amlkn[j] * een_rescaled_n_gl_0amnw[j]); + } + +#ifdef HAVE_OPENMP +#pragma omp simd +#endif + for (size_t j = 0; j < (size_t) elec_num; ++j) { + factor_een_grad_1nw[j] = cn * + (tmp_c_amkn[j] * een_rescaled_n_gl_1amlnw[j] + + dtmp_c_1amknw[j] * een_rescaled_n_amlnw[j] + + dtmp_c_1amlknw[j] * een_rescaled_n_amnw[j] + + tmp_c_amlkn[j] * een_rescaled_n_gl_1amnw[j]); + } + +#ifdef HAVE_OPENMP +#pragma omp simd +#endif + for (size_t j = 0; j < (size_t) elec_num; ++j) { + factor_een_grad_2nw[j] = cn * + (tmp_c_amkn[j] * een_rescaled_n_gl_2amlnw[j] + + dtmp_c_2amknw[j] * een_rescaled_n_amlnw[j] + + dtmp_c_2amlknw[j] * een_rescaled_n_amnw[j] + + tmp_c_amlkn[j] * een_rescaled_n_gl_2amnw[j]); + } + + } + } + } + if (!touched) { + memset(factor_een_grad_0nw, 0, elec_num*3*sizeof(double)); + } + } + return info; +} + #+end_src +***** Test + + #+begin_src c :tangle (eval c_test) +/* Check if Jastrow is properly initialized */ +assert(qmckl_jastrow_champ_provided(context)); + +double factor_een_grad[walk_num][3][elec_num]; +rc = qmckl_get_jastrow_champ_factor_een_grad(context, &(factor_een_grad[0][0][0]),3*walk_num*elec_num); + +for (int nw=0 ; nwjastrow_champ.gl, sze*sizeof(double)); + return QMCKL_SUCCESS; +} + +qmckl_exit_code +qmckl_get_jastrow_champ_grad(qmckl_context context, + double* const grad, + const int64_t size_max) +{ + qmckl_exit_code rc; + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_jastrow_champ_grad", + NULL); + } + + qmckl_context_struct* const ctx = (qmckl_context_struct*) context; + assert (ctx != NULL); + + rc = qmckl_provide_jastrow_champ_grad(context); + if (rc != QMCKL_SUCCESS) return rc; + + int64_t sze = 3 * ctx->electron.walker.num * ctx->electron.num; + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_champ_grad", + "Array too small. Expected walker.num * electron.num * 3"); + } + memcpy(grad, ctx->jastrow_champ.grad, sze*sizeof(double)); + return QMCKL_SUCCESS; } #+end_src @@ -11027,11 +11102,24 @@ interface real(c_double), intent(out) :: gl(size_max) end function qmckl_get_jastrow_champ_gl end interface + +interface + integer(qmckl_exit_code) function qmckl_get_jastrow_champ_grad (context, & + grad, size_max) bind(C) + use, intrinsic :: iso_c_binding + import + implicit none + integer (qmckl_context) , intent(in), value :: context + integer(c_int64_t), intent(in), value :: size_max + real(c_double), intent(out) :: grad(size_max) + end function qmckl_get_jastrow_champ_grad +end interface #+end_src **** Provide :noexport: #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none -qmckl_exit_code qmckl_provide_jastrow_champ_gl(qmckl_context context); +qmckl_exit_code qmckl_provide_jastrow_champ_gl (qmckl_context context); +qmckl_exit_code qmckl_provide_jastrow_champ_grad(qmckl_context context); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none @@ -11113,11 +11201,92 @@ qmckl_exit_code qmckl_provide_jastrow_champ_gl(qmckl_context context) ctx->jastrow_champ.gl_date = ctx->date; } + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_provide_jastrow_champ_grad(qmckl_context context) +{ + + qmckl_exit_code rc; + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_provide_jastrow_champ_grad", + NULL); + } + + qmckl_context_struct* const ctx = (qmckl_context_struct*) context; + assert (ctx != NULL); + + if (!ctx->jastrow_champ.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_provide_jastrow_champ_grad", + NULL); + } + + + rc = qmckl_provide_jastrow_champ_value(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_jastrow_champ_factor_ee_gl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_jastrow_champ_factor_en_gl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_jastrow_champ_factor_een_grad(context); + if (rc != QMCKL_SUCCESS) return rc; + + /* Compute if necessary */ + if (ctx->date > ctx->jastrow_champ.grad_date) { + + if (ctx->electron.walker.num > ctx->electron.walker_old.num) { + if (ctx->jastrow_champ.grad != NULL) { + rc = qmckl_free(context, ctx->jastrow_champ.grad); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_provide_jastrow_champ_grad", + "Unable to free ctx->jastrow_champ.grad"); + } + ctx->jastrow_champ.grad = NULL; + } + } + + /* Allocate array */ + if (ctx->jastrow_champ.grad == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.walker.num * ctx->electron.num * 3 * sizeof(double); + double* grad = (double*) qmckl_malloc(context, mem_info); + + if (grad == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_provide_jastrow_champ_grad", + NULL); + } + ctx->jastrow_champ.grad = grad; + } + + rc = qmckl_compute_jastrow_champ_grad_doc(context, + ctx->electron.walker.num, + ctx->electron.num, + ctx->jastrow_champ.value, + ctx->jastrow_champ.factor_ee_gl, + ctx->jastrow_champ.factor_en_gl, + ctx->jastrow_champ.factor_een_grad, + ctx->jastrow_champ.grad); + + ctx->jastrow_champ.grad_date = ctx->date; + } + return QMCKL_SUCCESS; } #+end_src -**** Compute +**** Compute GL :PROPERTIES: :Name: qmckl_compute_jastrow_champ_gl_doc :CRetType: qmckl_exit_code @@ -11136,47 +11305,23 @@ qmckl_exit_code qmckl_provide_jastrow_champ_gl(qmckl_context context) | ~gl_een~ | ~double[walk_num][4][elec_num]~ | in | eeN component | | ~gl~ | ~double[walk_num][4][elec_num]~ | out | Total Jastrow factor | - #+CALL: generate_c_interface(table=qmckl_jastrow_champ_gl_args,rettyp=get_value("CRetType"),fname=get_value("Name")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_jastrow_champ_gl_doc & - (context, walk_num, elec_num, value, gl_ee, gl_en, gl_een, gl) & - bind(C) result(info) - - use, intrinsic :: iso_c_binding - implicit none - - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) , value :: walk_num - integer (c_int64_t) , intent(in) , value :: elec_num - real (c_double ) , intent(in) :: value(walk_num) - real (c_double ) , intent(in) :: gl_ee(elec_num,4,walk_num) - real (c_double ) , intent(in) :: gl_en(elec_num,4,walk_num) - real (c_double ) , intent(in) :: gl_een(elec_num,4,walk_num) - real (c_double ) , intent(out) :: gl(elec_num,4,walk_num) - - integer(c_int32_t), external :: qmckl_compute_jastrow_champ_gl_doc_f - info = qmckl_compute_jastrow_champ_gl_doc_f & - (context, walk_num, elec_num, value, gl_ee, gl_en, gl_een, gl) - - end function qmckl_compute_jastrow_champ_gl_doc - #+end_src - #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_jastrow_champ_gl_doc_f(context, & +function qmckl_compute_jastrow_champ_gl_doc(context, & walk_num, elec_num, value, gl_ee, gl_en, gl_een, gl) & - result(info) + bind(C) result(info) use qmckl + use, intrinsic :: iso_c_binding implicit none integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: walk_num, elec_num - double precision , intent(in) :: value (walk_num) - double precision , intent(in) :: gl_ee (elec_num,4,walk_num) - double precision , intent(in) :: gl_en (elec_num,4,walk_num) - double precision , intent(in) :: gl_een(elec_num,4,walk_num) - double precision , intent(out) :: gl (elec_num,4,walk_num) + integer (c_int64_t) , intent(in) , value :: walk_num + integer (c_int64_t) , intent(in) , value :: elec_num + real (c_double ) , intent(in) :: value(walk_num) + real (c_double ) , intent(in) :: gl_ee(elec_num,4,walk_num) + real (c_double ) , intent(in) :: gl_en(elec_num,4,walk_num) + real (c_double ) , intent(in) :: gl_een(elec_num,4,walk_num) + real (c_double ) , intent(out) :: gl(elec_num,4,walk_num) + integer(qmckl_exit_code) :: info integer*8 :: i, j, k info = QMCKL_SUCCESS @@ -11198,16 +11343,16 @@ integer function qmckl_compute_jastrow_champ_gl_doc_f(context, & end do end do do i = 1, elec_num - gl(i,4,k) = gl(i,4,k) + & - gl(i,1,k) * gl(i,1,k) + & - gl(i,2,k) * gl(i,2,k) + & - gl(i,3,k) * gl(i,3,k) + gl(i,4,k) = gl(i,4,k) + & + gl(i,1,k) * gl(i,1,k) + & + gl(i,2,k) * gl(i,2,k) + & + gl(i,3,k) * gl(i,3,k) end do gl(:,:,k) = gl(:,:,k) * value(k) end do -end function qmckl_compute_jastrow_champ_gl_doc_f +end function qmckl_compute_jastrow_champ_gl_doc #+end_src #+CALL: generate_private_c_header(table=qmckl_jastrow_champ_gl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_gl") @@ -11255,18 +11400,16 @@ qmckl_exit_code qmckl_compute_jastrow_champ_gl_hpc ( double* const gl ); #+end_src - #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none inline qmckl_exit_code -qmckl_compute_jastrow_champ_gl_hpc ( - const qmckl_context context, - const int64_t walk_num, - const int64_t elec_num, - const double* value, - const double* gl_ee, - const double* gl_en, - const double* gl_een, - double* const gl) +qmckl_compute_jastrow_champ_gl_hpc (const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const double* value, + const double* gl_ee, + const double* gl_en, + const double* gl_een, + double* const gl) { if (context == QMCKL_NULL_CONTEXT) return QMCKL_INVALID_CONTEXT; @@ -11282,14 +11425,14 @@ qmckl_compute_jastrow_champ_gl_hpc ( for (int64_t j = 0; j < 4; ++j) { for (int64_t i = 0; i < elec_num; ++i) { gl[i + elec_num*(j + k*4)] = gl_ee[i + elec_num*(j + k*4)] + - gl_en[i + elec_num*(j + k*4)] + gl_een[i + elec_num*(j + k*4)]; + gl_en[i + elec_num*(j + k*4)] + gl_een[i + elec_num*(j + k*4)]; } } for (int64_t i = 0; i < elec_num; ++i) { - gl[i + elec_num*(3 + walk_num*4)] += - gl_ee[i + elec_num*(0 + k*4)] * gl_ee[i + elec_num*(0 + k*4)] + - gl_ee[i + elec_num*(1 + k*4)] * gl_ee[i + elec_num*(1 + k*4)] + - gl_ee[i + elec_num*(2 + k*4)] * gl_ee[i + elec_num*(2 + k*4)]; + gl[i + elec_num*(3 + walk_num*4)] += + gl_ee[i + elec_num*(0 + k*4)] * gl_ee[i + elec_num*(0 + k*4)] + + gl_ee[i + elec_num*(1 + k*4)] * gl_ee[i + elec_num*(1 + k*4)] + + gl_ee[i + elec_num*(2 + k*4)] * gl_ee[i + elec_num*(2 + k*4)]; } for (int64_t j = 0; j < 4; ++j) { for (int64_t i = 0; i < elec_num; ++i) { @@ -11323,10 +11466,9 @@ qmckl_exit_code qmckl_compute_jastrow_champ_gl ( } #+end_src -**** Test +***** Test - - #+begin_src c :tangle (eval c_test) + #+begin_src c :tangle (eval c_test) printf("Total Jastrow derivatives\n"); /* Check if Jastrow is properly initialized */ assert(qmckl_jastrow_champ_provided(context)); @@ -11369,7 +11511,198 @@ for (int64_t k=0 ; k< walk_num ; ++k) { } - #+end_src + #+end_src + +**** Compute Gradient only + :PROPERTIES: + :Name: qmckl_compute_jastrow_champ_grad_doc + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_jastrow_champ_grad_args + | Variable | Type | In/Out | Description | + |------------+---------------------------------+--------+----------------------| + | ~context~ | ~qmckl_context~ | in | Global state | + | ~walk_num~ | ~int64_t~ | in | Number of walkers | + | ~elec_num~ | ~int64_t~ | in | Number of electrons | + | ~value~ | ~double[walk_num]~ | in | Total Jastrow | + | ~gl_ee~ | ~double[walk_num][4][elec_num]~ | in | ee component | + | ~gl_en~ | ~double[walk_num][4][elec_num]~ | in | eN component | + | ~grad_een~ | ~double[walk_num][3][elec_num]~ | in | eeN component | + | ~grad~ | ~double[walk_num][3][elec_num]~ | out | Total Jastrow factor | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +function qmckl_compute_jastrow_champ_grad_doc(context, & + walk_num, elec_num, value, gl_ee, gl_en, grad_een, grad) & + result(info) bind(C) + use, intrinsic :: iso_c_binding + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer (c_int64_t) , intent(in) , value :: walk_num + integer (c_int64_t) , intent(in) , value :: elec_num + real (c_double ) , intent(in) :: value(walk_num) + real (c_double ) , intent(in) :: gl_ee(elec_num,4,walk_num) + real (c_double ) , intent(in) :: gl_en(elec_num,4,walk_num) + real (c_double ) , intent(in) :: grad_een(elec_num,3,walk_num) + real (c_double ) , intent(out) :: grad(elec_num,3,walk_num) + + integer(qmckl_exit_code) :: info + integer*8 :: i, j, k + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (walk_num <= 0) then + info = QMCKL_INVALID_ARG_2 + return + endif + + do k = 1, walk_num + do j=1,3 + do i = 1, elec_num + grad(i,j,k) = gl_ee(i,j,k) + gl_en(i,j,k) + grad_een(i,j,k) + end do + end do + grad(:,:,k) = grad(:,:,k) * value(k) + end do + + +end function qmckl_compute_jastrow_champ_grad_doc + #+end_src + +#+CALL: generate_private_c_header(table=qmckl_jastrow_champ_grad_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_grad") + +#+RESULTS: +#+begin_src c :tangle (eval h_private_func) :comments org +qmckl_exit_code qmckl_compute_jastrow_champ_grad ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const double* value, + const double* gl_ee, + const double* gl_en, + const double* grad_een, + double* const grad ); +#+end_src + +#+CALL: generate_private_c_header(table=qmckl_jastrow_champ_grad_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_grad_doc") + +#+RESULTS: +#+begin_src c :tangle (eval h_private_func) :comments org +qmckl_exit_code qmckl_compute_jastrow_champ_grad_doc ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const double* value, + const double* gl_ee, + const double* gl_en, + const double* grad_een, + double* const grad ); +#+end_src + +#+CALL: generate_private_c_header(table=qmckl_jastrow_champ_grad_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_grad_hpc") + +#+RESULTS: +#+begin_src c :tangle (eval h_private_func) :comments org +qmckl_exit_code qmckl_compute_jastrow_champ_grad_hpc ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const double* value, + const double* gl_ee, + const double* gl_en, + const double* grad_een, + double* const grad ); +#+end_src + + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +inline qmckl_exit_code +qmckl_compute_jastrow_champ_grad_hpc ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const double* value, + const double* gl_ee, + const double* gl_en, + const double* grad_een, + double* const grad) +{ + + if (context == QMCKL_NULL_CONTEXT) return QMCKL_INVALID_CONTEXT; + if (walk_num <= 0 ) return QMCKL_INVALID_ARG_2; + if (elec_num <= 0 ) return QMCKL_INVALID_ARG_3; + if (value == NULL ) return QMCKL_INVALID_ARG_4; + if (gl_ee == NULL ) return QMCKL_INVALID_ARG_5; + if (gl_en == NULL ) return QMCKL_INVALID_ARG_6; + if (grad_een == NULL ) return QMCKL_INVALID_ARG_7; + if (grad == NULL ) return QMCKL_INVALID_ARG_8; + + for (int64_t k = 0; k < walk_num; ++k) { + for (int64_t j = 0; j < 3; ++j) { + for (int64_t i = 0; i < elec_num; ++i) { + grad[i + elec_num*(j + k*3)] = ( gl_ee[i + elec_num*(j + k*4)] + + gl_en[i + elec_num*(j + k*4)] + grad_een[i + elec_num*(j + k*3)] )* value[k]; + } + } + } + + return QMCKL_SUCCESS; +} + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes +qmckl_exit_code qmckl_compute_jastrow_champ_grad ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const double* value, + const double* gl_ee, + const double* gl_en, + const double* grad_een, + double* const grad) +{ + +#ifdef HAVE_HPC + return qmckl_compute_jastrow_champ_grad_hpc +#else + return qmckl_compute_jastrow_champ_grad_doc +#endif + (context, walk_num, elec_num, value, gl_ee, gl_en, grad_een, grad); +} + #+end_src + +***** Test + + #+begin_src c :tangle (eval c_test) +printf("Total Jastrow gradient only\n"); +/* Check if Jastrow is properly initialized */ +assert(qmckl_jastrow_champ_provided(context)); + +double total_j_grad[walk_num][3][elec_num]; +rc = qmckl_check(context, + qmckl_get_jastrow_champ_grad(context, &(total_j_grad[0][0][0]), walk_num*elec_num*3) + ); +assert(rc == QMCKL_SUCCESS); + + + +for (int64_t k=0 ; k< walk_num ; ++k) { + for (int64_t m=0 ; m<3; ++m) { + for (int64_t e=0 ; eelectron.walker.num; + + if (size_max < 3*walk_num) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_4, + "qmckl_set_single_point", + "Array too small"); + } + qmckl_exit_code rc; - if (ctx->single_point.coord.data != NULL) { - rc = qmckl_matrix_free(context, &(ctx->single_point.coord)); - assert (rc == QMCKL_SUCCESS); - } + if (ctx->single_point.coord.data != NULL) { + rc = qmckl_matrix_free(context, &(ctx->single_point.coord)); + assert (rc == QMCKL_SUCCESS); + } - ctx->single_point.coord = qmckl_matrix_alloc(context, 1, 3); - if (ctx->single_point.coord.data == NULL) { - return qmckl_failwith( context, - QMCKL_ALLOCATION_FAILED, - "qmckl_set_single_point", - NULL); - } + ctx->single_point.coord = qmckl_matrix_alloc(context, walk_num, 3); + if (ctx->single_point.coord.data == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_set_single_point", + NULL); + } ctx->single_point.num = num; if (transp == 'T') { double *a = ctx->single_point.coord.data; -#ifdef HAVE_OPENMP - #pragma omp for -#endif - for (int64_t i=0 ; i<3 ; ++i) { + for (int64_t i=0 ; i<3*walk_num ; ++i) { a[i] = coord[i]; } } else { - qmckl_mat(ctx->single_point.coord, 0, 0) = coord[0]; - qmckl_mat(ctx->single_point.coord, 0, 1) = coord[1]; - qmckl_mat(ctx->single_point.coord, 0, 2) = coord[2]; - + for (int64_t i=0 ; isingle_point.coord, i, 0) = coord[i*walk_num + 0]; + qmckl_mat(ctx->single_point.coord, i, 1) = coord[i*walk_num + 1]; + qmckl_mat(ctx->single_point.coord, i, 2) = coord[i*walk_num + 2]; + } } - /* Increment the date of the context */ + /* Increment the date of the single point */ ctx->single_point.date += 1UL; return QMCKL_SUCCESS; @@ -564,21 +574,22 @@ qmckl_exit_code qmckl_provide_single_ee_distance(qmckl_context context) | ~elec_num~ | ~int64_t~ | in | Number of electrons | | ~walk_num~ | ~int64_t~ | in | Number of walkers | | ~coord~ | ~double[3][walk_num][elec_num]~ | in | Electron coordinates | - | ~single_coord~ | ~double[1][3]~ | in | Single electron coordinates | + | ~single_coord~ | ~double[walk_num][3]~ | in | Single electron coordinates | | ~single_ee_distance~ | ~double[walk_num][elec_num]~ | out | Electron-electron distances | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_single_ee_distance_f(context, elec_num, walk_num, coord, single_coord, single_ee_distance) & - result(info) +integer(qmckl_exit_code) function qmckl_compute_single_ee_distance(context, & + elec_num, walk_num, coord, single_coord, single_ee_distance) & + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: elec_num - integer*8 , intent(in) :: walk_num - double precision , intent(in) :: coord(elec_num,walk_num,3) - double precision , intent(in) :: single_coord(1,3) - double precision , intent(out) :: single_ee_distance(elec_num,walk_num) - + integer (c_int64_t) , intent(in) , value :: elec_num + integer (c_int64_t) , intent(in) , value :: walk_num + real (c_double ) , intent(in) :: coord(elec_num,3,walk_num) + real (c_double ) , intent(in) :: single_coord(3,walk_num) + real (c_double ) , intent(out) :: single_ee_distance(elec_num,walk_num) integer*8 :: k, i, j double precision :: x, y, z @@ -601,16 +612,16 @@ integer function qmckl_compute_single_ee_distance_f(context, elec_num, walk_num, endif do k=1,walk_num - info = qmckl_distance(context, 'T', 'T', 1_8, elec_num, & - single_coord(1,1), 1_8, & - coord(1,k,1), elec_num * walk_num * 1_8, & + info = qmckl_distance(context, 'N', 'T', 1_8, elec_num, & + single_coord(1,k), 3_8, & + coord(1,1,k), elec_num, & single_ee_distance(1,k), 1_8) if (info /= QMCKL_SUCCESS) then exit endif end do -end function qmckl_compute_single_ee_distance_f +end function qmckl_compute_single_ee_distance #+end_src #+begin_src c :tangle (eval h_private_func) :comments org :exports none @@ -623,30 +634,6 @@ qmckl_exit_code qmckl_compute_single_ee_distance ( double* const single_ee_distance ); #+end_src - #+CALL: generate_c_interface(table=qmckl_single_ee_distance_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_single_ee_distance & - (context, elec_num, walk_num, coord, single_coord, single_ee_distance) & - 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 :: elec_num - integer (c_int64_t) , intent(in) , value :: walk_num - real (c_double ) , intent(in) :: coord(elec_num,3,walk_num) - real (c_double ) , intent(in) :: single_coord(3) - real (c_double ) , intent(out) :: single_ee_distance(elec_num,walk_num) - - integer(c_int32_t), external :: qmckl_compute_single_ee_distance_f - info = qmckl_compute_single_ee_distance_f & - (context, elec_num, walk_num, coord, single_coord, single_ee_distance) - - end function qmckl_compute_single_ee_distance - #+end_src ** test @@ -725,7 +712,7 @@ qmckl_get_een_rescaled_single_e(qmckl_context context, if (size_max < sze) { return qmckl_failwith( context, QMCKL_INVALID_ARG_3, - "todo", + "qmckl_get_een_rescaled_single_e", "Array too small. Expected ctx->electron.num * ctx->electron.num * ctx->electron.walker.num * (ctx->jastrow_champ.cord_num + 1)"); } memcpy(distance_rescaled, ctx->single_point.een_rescaled_single_e, sze * sizeof(double)); @@ -833,21 +820,23 @@ qmckl_exit_code qmckl_provide_een_rescaled_single_e(qmckl_context context) | ~een_rescaled_single_e~ | ~double[walk_num][0:cord_num][elec_num]~ | out | Single electron-electron rescaled distances for each walker | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_een_rescaled_single_e_doc_f( & +integer function qmckl_compute_een_rescaled_single_e_doc( & context, num_in, walk_num, elec_num, cord_num, rescale_factor_ee, & single_ee_distance, een_rescaled_e, een_rescaled_single_e) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: num_in - integer*8 , intent(in) :: walk_num - integer*8 , intent(in) :: elec_num - integer*8 , intent(in) :: cord_num - double precision , intent(in) :: rescale_factor_ee - double precision , intent(in) :: single_ee_distance(elec_num,walk_num) - double precision , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) - double precision , intent(out) :: een_rescaled_single_e(elec_num,0:cord_num,walk_num) + integer(qmckl_context), intent(in) :: context + integer(c_int64_t) , intent(in), value :: num_in + 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_ee + real(c_double) , intent(in) :: single_ee_distance(elec_num,walk_num) + real(c_double) , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) + real(c_double) , intent(out) :: een_rescaled_single_e(elec_num,0:cord_num,walk_num) + double precision,allocatable :: een_rescaled_single_e_ij(:,:) double precision :: x integer*8 :: i, j, k, l, nw, num @@ -894,7 +883,7 @@ integer function qmckl_compute_een_rescaled_single_e_doc_f( & end do ! prepare the actual een table - een_rescaled_single_e( :, 0, nw) = 1.0d0 + een_rescaled_single_e(:,0,nw) = 1.0d0 do l = 1, cord_num do j = 1, elec_num @@ -908,7 +897,7 @@ integer function qmckl_compute_een_rescaled_single_e_doc_f( & end do -end function qmckl_compute_een_rescaled_single_e_doc_f +end function qmckl_compute_een_rescaled_single_e_doc #+end_src # #+CALL: generate_c_header(table=qmckl_factor_een_rescaled_e_args,rettyp=get_value("CRetType"),fname=get_value("Name")) @@ -926,48 +915,6 @@ end function qmckl_compute_een_rescaled_single_e_doc_f double* const een_rescaled_single_e ); #+end_src - #+CALL: generate_c_interface(table=qmckl_factor_een_rescaled_single_e_args,rettyp=get_value("CRetType"),fname="qmckl_compute_een_rescaled_single_e_doc") - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_een_rescaled_single_e_doc & - (context, num, walk_num, elec_num, cord_num, rescale_factor_ee, & - single_ee_distance, een_rescaled_e, een_rescaled_single_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 :: num - 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_ee - real (c_double ) , intent(in) :: single_ee_distance(elec_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) - real (c_double ) , intent(out) :: een_rescaled_single_e(elec_num,0:cord_num,walk_num) - - integer(c_int32_t), external :: qmckl_compute_een_rescaled_single_e_doc_f - info = qmckl_compute_een_rescaled_single_e_doc_f & - (context, num, walk_num, elec_num, cord_num, rescale_factor_ee, single_ee_distance, een_rescaled_e, een_rescaled_single_e) - - end function qmckl_compute_een_rescaled_single_e_doc - #+end_src - - #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none - qmckl_exit_code qmckl_compute_een_rescaled_single_e ( - const qmckl_context context, - const int64_t num, - const int64_t walk_num, - const int64_t elec_num, - const int64_t cord_num, - const double rescale_factor_ee, - const double* single_ee_distance, - const double* een_rescaled_e, - double* const een_rescaled_single_e ); - #+end_src - #+begin_src c :tangle (eval h_private_func) :comments org qmckl_exit_code qmckl_compute_een_rescaled_single_e_doc ( const qmckl_context context, @@ -982,24 +929,25 @@ end function qmckl_compute_een_rescaled_single_e_doc_f #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes - qmckl_exit_code qmckl_compute_een_rescaled_single_e ( - const qmckl_context context, - const int64_t num, - const int64_t walk_num, - const int64_t elec_num, - const int64_t cord_num, - const double rescale_factor_ee, - const double* single_ee_distance, - const double* een_rescaled_e, - double* const een_rescaled_single_e ) { +qmckl_exit_code +qmckl_compute_een_rescaled_single_e (const qmckl_context context, + const int64_t num, + const int64_t walk_num, + const int64_t elec_num, + const int64_t cord_num, + const double rescale_factor_ee, + const double* single_ee_distance, + const double* een_rescaled_e, + double* const een_rescaled_single_e ) +{ #ifdef HAVE_HPC - return qmckl_compute_een_rescaled_single_e_doc + return qmckl_compute_een_rescaled_single_e_doc #else - return qmckl_compute_een_rescaled_single_e_doc + return qmckl_compute_een_rescaled_single_e_doc #endif - (context, num, walk_num, elec_num, cord_num, rescale_factor_ee, single_ee_distance, een_rescaled_e, een_rescaled_single_e); - } + (context, num, walk_num, elec_num, cord_num, rescale_factor_ee, single_ee_distance, een_rescaled_e, een_rescaled_single_e); +} #+end_src ** test @@ -1049,6 +997,10 @@ for (int nw = 0; nw < walk_num; nw++){ ** Get + Electron-nucleus distance between the single electron and all + nuclei for all walkers. + Dimension is ~[walk_num][nucl_num]~. + #+begin_src c :comments org :tangle (eval h_func) :noweb yes qmckl_exit_code qmckl_get_single_electron_en_distance(qmckl_context context, double* distance); #+end_src @@ -1082,7 +1034,7 @@ qmckl_exit_code qmckl_get_single_electron_en_distance(qmckl_context context, dou qmckl_context_struct* const ctx = (qmckl_context_struct*) context; assert (ctx != NULL); - size_t sze = ctx->nucleus.num; + size_t sze = ctx->nucleus.num * ctx->electron.walker.num; memcpy(distance, ctx->single_point.single_en_distance, sze * sizeof(double)); return QMCKL_SUCCESS; @@ -1117,7 +1069,7 @@ qmckl_exit_code qmckl_provide_single_en_distance(qmckl_context context) if (ctx->single_point.date > ctx->single_point.single_en_distance_date) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = ctx->nucleus.num * sizeof(double); + mem_info.size = ctx->nucleus.num * ctx->electron.walker.num * sizeof(double); if (ctx->single_point.single_en_distance != NULL) { qmckl_memory_info_struct mem_info_test = qmckl_memory_info_struct_zero; @@ -1150,6 +1102,7 @@ qmckl_exit_code qmckl_provide_single_en_distance(qmckl_context context) qmckl_exit_code rc = qmckl_compute_single_en_distance(context, ctx->nucleus.num, + ctx->electron.walker.num, ctx->single_point.coord.data, ctx->nucleus.coord.data, ctx->single_point.single_en_distance); @@ -1178,20 +1131,22 @@ qmckl_exit_code qmckl_provide_single_en_distance(qmckl_context context) |----------------------+-----------------------+--------+----------------------------| | ~context~ | ~qmckl_context~ | in | Global state | | ~nucl_num~ | ~int64_t~ | in | Number of nuclei | + | ~walk_num~ | ~int64_t~ | in | Number of walkers | | ~elec_coord~ | ~double[3]~ | in | Electron coordinates | | ~nucl_coord~ | ~double[3][nucl_num]~ | in | Nuclear coordinates | | ~single_en_distance~ | ~double[nucl_num]~ | out | Electron-nucleus distances | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_single_en_distance_f(context, nucl_num, elec_coord, nucl_coord, single_en_distance) & - result(info) +integer function qmckl_compute_single_en_distance(context, nucl_num, walk_num, & + elec_coord, nucl_coord, single_en_distance) result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: nucl_num - double precision , intent(in) :: elec_coord(3) - double precision , intent(in) :: nucl_coord(nucl_num,3) - double precision , intent(out) :: single_en_distance(nucl_num) + integer(qmckl_context), intent(in) :: context + integer (c_int64_t) , intent(in) , value :: nucl_num, walk_num + real (c_double ) , intent(in) :: elec_coord(3) + real (c_double ) , intent(in) :: nucl_coord(nucl_num,3) + real (c_double ) , intent(out) :: single_en_distance(nucl_num) integer*8 :: k @@ -1209,45 +1164,22 @@ integer function qmckl_compute_single_en_distance_f(context, nucl_num, elec_coor info = qmckl_distance(context, 'T', 'T', nucl_num, 1_8, & nucl_coord, nucl_num, & - elec_coord, 1_8, & + elec_coord, walk_num, & single_en_distance, nucl_num) -end function qmckl_compute_single_en_distance_f +end function qmckl_compute_single_en_distance #+end_src #+begin_src c :tangle (eval h_private_func) :comments org :exports none qmckl_exit_code qmckl_compute_single_en_distance ( const qmckl_context context, const int64_t nucl_num, + const int64_t walk_num, const double* elec_coord, const double* nucl_coord, double* const single_en_distance ); #+end_src - #+CALL: generate_c_interface(table=qmckl_single_en_distance_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_single_en_distance & - (context, nucl_num, elec_coord, nucl_coord, single_en_distance) & - 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 - real (c_double ) , intent(in) :: elec_coord(3) - real (c_double ) , intent(in) :: nucl_coord(nucl_num,3) - real (c_double ) , intent(out) :: single_en_distance(nucl_num) - - integer(c_int32_t), external :: qmckl_compute_single_en_distance_f - info = qmckl_compute_single_en_distance_f & - (context, nucl_num, elec_coord, nucl_coord, single_en_distance) - - end function qmckl_compute_single_en_distance - #+end_src - ** test #+begin_src c :tangle (eval c_test) @@ -1433,25 +1365,27 @@ qmckl_exit_code qmckl_provide_een_rescaled_single_n(qmckl_context context) | ~een_rescaled_single_n~ | ~double[walk_num][0:cord_num][nucl_num]~ | out | Single electron-nucleus rescaled distances | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_een_rescaled_single_n_f( & +integer function qmckl_compute_een_rescaled_single_n( & context, num_in, walk_num, elec_num, nucl_num, & type_nucl_num, type_nucl_vector, cord_num, rescale_factor_en, & single_en_distance, een_rescaled_n, een_rescaled_single_n) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: num_in - integer*8 , intent(in) :: walk_num - integer*8 , intent(in) :: elec_num - integer*8 , intent(in) :: nucl_num - integer*8 , intent(in) :: type_nucl_num - integer*8 , intent(in) :: type_nucl_vector(nucl_num) - integer*8 , intent(in) :: cord_num - double precision , intent(in) :: rescale_factor_en(type_nucl_num) - double precision , intent(in) :: single_en_distance(nucl_num,walk_num) - double precision , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) - double precision , intent(out) :: een_rescaled_single_n(nucl_num,0:cord_num,walk_num) + integer(c_int64_t) , intent(in), value :: num_in + 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 :: cord_num + real(c_double) , intent(in) :: rescale_factor_en(type_nucl_num) + real(c_double) , intent(in) :: single_en_distance(nucl_num,walk_num) + real(c_double) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) + real(c_double) , intent(out) :: een_rescaled_single_n(nucl_num,0:cord_num,walk_num) + double precision :: x integer*8 :: i, a, k, l, nw, num @@ -1490,7 +1424,7 @@ integer function qmckl_compute_een_rescaled_single_n_f( & do l = 2, cord_num do a = 1, nucl_num - een_rescaled_single_n(a, l, nw) = een_rescaled_single_n(a, l - 1, nw) * een_rescaled_single_n(a, 1, nw) + een_rescaled_single_n(a, l, nw) = een_rescaled_single_n(a, l - 1, nw) * een_rescaled_single_n(a, 1, nw) end do end do @@ -1498,60 +1432,7 @@ integer function qmckl_compute_een_rescaled_single_n_f( & end do -end function qmckl_compute_een_rescaled_single_n_f - #+end_src - - #+CALL: generate_c_interface(table=qmckl_factor_een_rescaled_single_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_single_n & - (context, & - num, & - walk_num, & - elec_num, & - nucl_num, & - type_nucl_num, & - type_nucl_vector, & - cord_num, & - rescale_factor_en, & - single_en_distance, & - een_rescaled_n, & - een_rescaled_single_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 :: num - 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 :: cord_num - real (c_double ) , intent(in) :: rescale_factor_en(nucl_num) - real (c_double ) , intent(in) :: single_en_distance(nucl_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(out) :: een_rescaled_single_n(nucl_num,0:cord_num,walk_num) - - integer(c_int32_t), external :: qmckl_compute_een_rescaled_single_n_f - info = qmckl_compute_een_rescaled_single_n_f & - (context, & - num, & - walk_num, & - elec_num, & - nucl_num, & - type_nucl_num, & - type_nucl_vector, & - cord_num, & - rescale_factor_en, & - single_en_distance, & - een_rescaled_n, & - een_rescaled_single_n) - - end function qmckl_compute_een_rescaled_single_n +end function qmckl_compute_een_rescaled_single_n #+end_src #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none @@ -1757,19 +1638,20 @@ qmckl_exit_code qmckl_provide_jastrow_champ_delta_p(qmckl_context context) | ~delta_p~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | out | Electron-nucleus jastrow | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_jastrow_champ_delta_p_doc_f( & +integer function qmckl_compute_jastrow_champ_delta_p_doc( & context, num_in, walk_num, elec_num, nucl_num, cord_num, & een_rescaled_n, een_rescaled_e, een_rescaled_single_n, een_rescaled_single_e, delta_p) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: num_in, walk_num, elec_num, cord_num, nucl_num - double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_single_n(nucl_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_single_e(elec_num, 0:cord_num, walk_num) - double precision , intent(out) :: delta_p(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) + integer(c_int64_t), intent(in), value :: num_in, walk_num, elec_num, cord_num, nucl_num + real(c_double) , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) + real(c_double) , intent(in) :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num) + real(c_double) , intent(in) :: een_rescaled_single_n(nucl_num, 0:cord_num, walk_num) + real(c_double) , intent(in) :: een_rescaled_single_e(elec_num, 0:cord_num, walk_num) + real(c_double) , intent(out) :: delta_p(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) double precision :: een_rescaled_delta_e(elec_num) @@ -1791,7 +1673,7 @@ integer function qmckl_compute_jastrow_champ_delta_p_doc_f( & if (cord_num == 0) return do nw=1, walk_num - + do i=0, cord_num-1 een_rescaled_delta_e(:) = een_rescaled_single_e(:,i,nw) - een_rescaled_e(:,num,i,nw) @@ -1801,7 +1683,7 @@ integer function qmckl_compute_jastrow_champ_delta_p_doc_f( & dn = een_rescaled_single_n(a,c,nw) - een_rescaled_n(num,a,c,nw) dn2 = dn + een_rescaled_n(num,a,c,nw) do j=1,elec_num - delta_p(j,a,c,i,nw) = een_rescaled_e(j,num,i,nw)*dn + een_rescaled_delta_e(j) * dn2 + delta_p(j,a,c,i,nw) = een_rescaled_e(j,num,i,nw)*dn + een_rescaled_delta_e(j) * dn2 enddo end do end do @@ -1816,7 +1698,7 @@ integer function qmckl_compute_jastrow_champ_delta_p_doc_f( & end do -end function qmckl_compute_jastrow_champ_delta_p_doc_f +end function qmckl_compute_jastrow_champ_delta_p_doc #+end_src # #+CALL: generate_c_header(table=qmckl_factor_een_args,rettyp=qmckl_exit_code),fname=get_value("Name")) @@ -1874,55 +1756,6 @@ qmckl_compute_jastrow_champ_delta_p (const qmckl_context context, } #+end_src - #+CALL: generate_c_interface(table=qmckl_factor_delta_p_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_delta_p_doc")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_jastrow_champ_delta_p_doc & - (context, & - num, & - walk_num, & - elec_num, & - nucl_num, & - cord_num, & - een_rescaled_n, & - een_rescaled_e, & - een_rescaled_single_n, & - een_rescaled_single_e, & - delta_p) & - 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 :: num - 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) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_single_n(nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_single_e(elec_num,0:cord_num,walk_num) - real (c_double ) , intent(out) :: delta_p(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) - - integer(c_int32_t), external :: qmckl_compute_jastrow_champ_delta_p_doc_f - info = qmckl_compute_jastrow_champ_delta_p_doc_f & - (context, & - num, & - walk_num, & - elec_num, & - nucl_num, & - cord_num, & - een_rescaled_n, & - een_rescaled_e, & - een_rescaled_single_n, & - een_rescaled_single_e, & - delta_p) - - end function qmckl_compute_jastrow_champ_delta_p_doc - #+end_src ** test @@ -2145,25 +1978,26 @@ qmckl_exit_code qmckl_provide_jastrow_champ_single_een(qmckl_context context) | ~delta_een~ | ~double[walk_num]~ | out | Electron-nucleus jastrow | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_jastrow_champ_factor_single_een_doc_f( & +integer function qmckl_compute_jastrow_champ_factor_single_een_doc( & context, num_in, walk_num, elec_num, nucl_num, cord_num, & dim_c_vector, c_vector_full, lkpm_combined_index, & tmp_c, delta_p, een_rescaled_n, een_rescaled_e, een_rescaled_single_n, & een_rescaled_single_e, delta_een) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: num_in, walk_num, elec_num, cord_num, nucl_num, dim_c_vector - integer*8 , intent(in) :: lkpm_combined_index(dim_c_vector,4) - double precision , intent(in) :: c_vector_full(nucl_num, dim_c_vector) - double precision , intent(in) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) - double precision , intent(in) :: delta_p(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) - double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_single_n(nucl_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_single_e(elec_num, 0:cord_num, walk_num) - double precision , intent(out) :: delta_een(walk_num) + integer(c_int64_t) , intent(in), value :: num_in, walk_num, elec_num, cord_num, nucl_num, dim_c_vector + integer(c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,4) + real(c_double) , intent(in) :: c_vector_full(nucl_num, dim_c_vector) + real(c_double) , intent(in) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) + real(c_double) , intent(in) :: delta_p(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) + real(c_double) , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) + real(c_double) , intent(in) :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num) + real(c_double) , intent(in) :: een_rescaled_single_n(nucl_num, 0:cord_num, walk_num) + real(c_double) , intent(in) :: een_rescaled_single_e(elec_num, 0:cord_num, walk_num) + real(c_double) , intent(out) :: delta_een(walk_num) double precision :: delta_c(nucl_num,0:cord_num, 0:cord_num-1, walk_num) double precision :: delta_c2(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) @@ -2211,7 +2045,7 @@ integer function qmckl_compute_jastrow_champ_factor_single_een_doc_f( & end do end do -end function qmckl_compute_jastrow_champ_factor_single_een_doc_f +end function qmckl_compute_jastrow_champ_factor_single_een_doc #+end_src # #+CALL: generate_c_header(table=qmckl_factor_een_args,rettyp=qmckl_exit_code),fname=get_value("Name")) @@ -2284,70 +2118,6 @@ qmckl_compute_jastrow_champ_factor_single_een (const qmckl_context context, } #+end_src - #+CALL: generate_c_interface(table=qmckl_factor_single_een_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_factor_single_een_doc")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none -integer(c_int32_t) function qmckl_compute_jastrow_champ_factor_single_een_doc & - (context, & - num, & - walk_num, & - elec_num, & - nucl_num, & - cord_num, & - dim_c_vector, & - c_vector_full, & - lkpm_combined_index, & - tmp_c, & - delta_p, & - een_rescaled_n, & - een_rescaled_e, & - een_rescaled_single_n, & - een_rescaled_single_e, & - delta_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 :: num - 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_c_vector - real (c_double ) , intent(in) :: c_vector_full(nucl_num,dim_c_vector) - integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,4) - real (c_double ) , intent(in) :: tmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) - real (c_double ) , intent(in) :: delta_p(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) - real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_single_n(nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_single_e(elec_num,0:cord_num,walk_num) - real (c_double ) , intent(out) :: delta_een(walk_num) - - integer(c_int32_t), external :: qmckl_compute_jastrow_champ_factor_single_een_doc_f - info = qmckl_compute_jastrow_champ_factor_single_een_doc_f & - (context, & - num, & - walk_num, & - elec_num, & - nucl_num, & - cord_num, & - dim_c_vector, & - c_vector_full, & - lkpm_combined_index, & - tmp_c, & - delta_p, & - een_rescaled_n, & - een_rescaled_e, & - een_rescaled_single_n, & - een_rescaled_single_e, & - delta_een) - -end function qmckl_compute_jastrow_champ_factor_single_een_doc - #+end_src ** test @@ -2798,8 +2568,8 @@ qmckl_exit_code qmckl_provide_en_rescaled_single(qmckl_context context) #+begin_src f90 :comments org :tangle (eval f) :noweb yes function qmckl_compute_en_rescaled_single_doc(context, & - nucl_num, type_nucl_num, & - type_nucl_vector, rescale_factor_en, walk_num, single_en_distance, en_rescaled_single) & + nucl_num, type_nucl_num, type_nucl_vector, rescale_factor_en, & + walk_num, single_en_distance, en_rescaled_single) & bind(C) result(info) use qmckl implicit none @@ -3244,7 +3014,7 @@ qmckl_compute_jastrow_champ_single_ee (const qmckl_context context, } #+end_src - ** test +** test #+begin_src c :tangle (eval c_test) @@ -3642,7 +3412,6 @@ for (int nw = 0; nw < walk_num; nw++) { #+end_src - * En rescaled derivative een ** Get @@ -3702,7 +3471,7 @@ qmckl_exit_code qmckl_provide_een_rescaled_single_n_gl(qmckl_context context) qmckl_context_struct* const ctx = (qmckl_context_struct*) context; assert (ctx != NULL); - /* Check if ee distance is provided */ + /* Check if en distance is provided */ qmckl_exit_code rc = qmckl_provide_single_en_distance(context); if(rc != QMCKL_SUCCESS) return rc; @@ -3788,28 +3557,30 @@ qmckl_exit_code qmckl_provide_een_rescaled_single_n_gl(qmckl_context context) | ~een_rescaled_single_n_gl~ | ~double[walk_num][0:cord_num][nucl_num][4]~ | out | Electron-nucleus rescaled distances | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_een_rescaled_single_n_gl_f( & +integer function qmckl_compute_een_rescaled_single_n_gl( & context, walk_num, nucl_num, type_nucl_num, type_nucl_vector, & - cord_num, rescale_factor_en, & - coord_ee, coord_n, single_en_distance, een_rescaled_single_n, een_rescaled_single_n_gl) & - result(info) + cord_num, rescale_factor_en, coord_ee, coord_n, single_en_distance, & + een_rescaled_single_n, een_rescaled_single_n_gl) & + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: walk_num - integer*8 , intent(in) :: nucl_num - integer*8 , intent(in) :: type_nucl_num - integer*8 , intent(in) :: type_nucl_vector(nucl_num) - integer*8 , intent(in) :: cord_num - double precision , intent(in) :: rescale_factor_en(type_nucl_num) - double precision , intent(in) :: coord_ee(3) - double precision , intent(in) :: coord_n(nucl_num,3) - double precision , intent(in) :: single_en_distance(nucl_num,walk_num) - double precision , intent(in) :: een_rescaled_single_n(nucl_num,0:cord_num,walk_num) - double precision , intent(out) :: een_rescaled_single_n_gl(4,nucl_num,0:cord_num,walk_num) - double precision,dimension(:,:),allocatable :: elnuc_dist_gl - double precision :: x, ria_inv, kappa_l - integer*8 :: i, a, k, l, nw, ii + integer(qmckl_context), intent(in), value :: context + integer(c_int64_t) , intent(in), value :: walk_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 :: cord_num + real(c_double) , intent(in) :: rescale_factor_en(type_nucl_num) + real(c_double) , intent(in) :: coord_ee(3,walk_num) + real(c_double) , intent(in) :: coord_n(nucl_num,3) + real(c_double) , intent(in) :: single_en_distance(nucl_num,walk_num) + real(c_double) , intent(in) :: een_rescaled_single_n(nucl_num,0:cord_num,walk_num) + real(c_double) , intent(out) :: een_rescaled_single_n_gl(4,nucl_num,0:cord_num,walk_num) + + double precision,allocatable :: elnuc_dist_gl(:,:) + double precision :: x, ria_inv, kappa_l + integer*8 :: i, a, k, l, nw, ii allocate(elnuc_dist_gl(4, nucl_num)) @@ -3844,7 +3615,7 @@ integer function qmckl_compute_een_rescaled_single_n_gl_f( & do a = 1, nucl_num ria_inv = 1.0d0 / single_en_distance(a, nw) do ii = 1, 3 - elnuc_dist_gl(ii, a) = (coord_ee(ii) - coord_n(a, ii)) * ria_inv + elnuc_dist_gl(ii, a) = (coord_ee(ii,nw) - coord_n(a, ii)) * ria_inv end do elnuc_dist_gl(4, a) = 2.0d0 * ria_inv end do @@ -3852,27 +3623,24 @@ integer function qmckl_compute_een_rescaled_single_n_gl_f( & do l = 0, cord_num do a = 1, nucl_num kappa_l = - dble(l) * rescale_factor_en(type_nucl_vector(a)+1) - een_rescaled_single_n_gl(1, a, l, nw) = kappa_l * elnuc_dist_gl(1, a) - een_rescaled_single_n_gl(2, a, l, nw) = kappa_l * elnuc_dist_gl(2, a) - een_rescaled_single_n_gl(3, a, l, nw) = kappa_l * elnuc_dist_gl(3, a) - een_rescaled_single_n_gl(4, a, l, nw) = kappa_l * elnuc_dist_gl(4, a) + een_rescaled_single_n_gl(1, a, l, nw) = kappa_l * elnuc_dist_gl(1, a) + een_rescaled_single_n_gl(2, a, l, nw) = kappa_l * elnuc_dist_gl(2, a) + een_rescaled_single_n_gl(3, a, l, nw) = kappa_l * elnuc_dist_gl(3, a) + een_rescaled_single_n_gl(4, a, l, nw) = kappa_l * (elnuc_dist_gl(4, a) + kappa_l) - een_rescaled_single_n_gl(4, a, l, nw) = een_rescaled_single_n_gl(4, a, l, nw) + & - kappa_l * kappa_l - - een_rescaled_single_n_gl(1, a, l, nw) = een_rescaled_single_n_gl(1, a, l, nw) * & - een_rescaled_single_n(a, l, nw) - een_rescaled_single_n_gl(2, a, l, nw) = een_rescaled_single_n_gl(2, a, l, nw) * & - een_rescaled_single_n(a, l, nw) - een_rescaled_single_n_gl(3, a, l, nw) = een_rescaled_single_n_gl(3, a, l, nw) * & - een_rescaled_single_n(a, l, nw) - een_rescaled_single_n_gl(4, a, l, nw) = een_rescaled_single_n_gl(4, a, l, nw) * & - een_rescaled_single_n(a, l, nw) + een_rescaled_single_n_gl(1, a, l, nw) = een_rescaled_single_n_gl(1, a, l, nw) * & + een_rescaled_single_n(a, l, nw) + een_rescaled_single_n_gl(2, a, l, nw) = een_rescaled_single_n_gl(2, a, l, nw) * & + een_rescaled_single_n(a, l, nw) + een_rescaled_single_n_gl(3, a, l, nw) = een_rescaled_single_n_gl(3, a, l, nw) * & + een_rescaled_single_n(a, l, nw) + een_rescaled_single_n_gl(4, a, l, nw) = een_rescaled_single_n_gl(4, a, l, nw) * & + een_rescaled_single_n(a, l, nw) end do end do end do -end function qmckl_compute_een_rescaled_single_n_gl_f +end function qmckl_compute_een_rescaled_single_n_gl #+end_src # #+CALL: generate_c_header(table=qmckl_compute_jastrow_champ_factor_een_rescaled_n_gl_args,rettyp=get_value("CRetType"),fname=get_value("Name")) @@ -3893,58 +3661,6 @@ end function qmckl_compute_een_rescaled_single_n_gl_f double* const een_rescaled_single_n_gl ); #+end_src - #+CALL: generate_c_interface(table=qmckl_compute_een_rescaled_single_n_gl_args,rettyp=get_value("CRetType"),fname=get_value("Name")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_een_rescaled_single_n_gl & - (context, & - walk_num, & - nucl_num, & - type_nucl_num, & - type_nucl_vector, & - cord_num, & - rescale_factor_en, & - coord_ee, & - coord_n, & - single_en_distance, & - een_rescaled_single_n, & - een_rescaled_single_n_gl) & - bind(C) result(info) - - use, intrinsic :: iso_c_binding - implicit none - - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) , value :: walk_num - integer (c_int64_t) , intent(in) , value :: 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 :: cord_num - real (c_double ) , intent(in) :: rescale_factor_en(nucl_num) - real (c_double ) , intent(in) :: coord_ee(3) - real (c_double ) , intent(in) :: coord_n(nucl_num,3) - real (c_double ) , intent(in) :: single_en_distance(nucl_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_single_n(nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(out) :: een_rescaled_single_n_gl(4,nucl_num,0:cord_num,walk_num) - - integer(c_int32_t), external :: qmckl_compute_een_rescaled_single_n_gl_f - info = qmckl_compute_een_rescaled_single_n_gl_f & - (context, & - walk_num, & - nucl_num, & - type_nucl_num, & - type_nucl_vector, & - cord_num, & - rescale_factor_en, & - coord_ee, & - coord_n, & - single_en_distance, & - een_rescaled_single_n, & - een_rescaled_single_n_gl) - - end function qmckl_compute_een_rescaled_single_n_gl - #+end_src ** test @@ -4057,6 +3773,9 @@ qmckl_exit_code qmckl_provide_een_rescaled_single_e_gl(qmckl_context context) qmckl_exit_code rc = qmckl_provide_een_rescaled_single_e(context); if(rc != QMCKL_SUCCESS) return rc; + rc = qmckl_provide_single_ee_distance(context); + if(rc != QMCKL_SUCCESS) return rc; + rc = qmckl_provide_single_en_distance(context); if(rc != QMCKL_SUCCESS) return rc; @@ -4136,26 +3855,28 @@ qmckl_exit_code qmckl_provide_een_rescaled_single_e_gl(qmckl_context context) | ~een_rescaled_single_e_gl~ | ~double[walk_num][0:cord_num][elec_num][4]~ | out | Electron-electron rescaled distances | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_een_rescaled_single_e_gl_f( & +integer function qmckl_compute_een_rescaled_single_e_gl_doc( & context, num_in, walk_num, elec_num, cord_num, rescale_factor_ee, & coord, coord_ee, single_ee_distance, een_rescaled_single_e, een_rescaled_single_e_gl) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: num_in - integer*8 , intent(in) :: walk_num - integer*8 , intent(in) :: elec_num - integer*8 , intent(in) :: cord_num - double precision , intent(in) :: rescale_factor_ee - double precision , intent(in) :: coord(3) - double precision , intent(in) :: coord_ee(elec_num,3,walk_num) - double precision , intent(in) :: single_ee_distance(elec_num,walk_num) - double precision , intent(in) :: een_rescaled_single_e(elec_num,0:cord_num,walk_num) - double precision , intent(out) :: een_rescaled_single_e_gl(4,elec_num,0:cord_num,walk_num) - double precision,dimension(:,:),allocatable :: elec_dist_gl - double precision :: x, rij_inv, kappa_l - integer*8 :: i, j, k, l, nw, ii, num + integer(qmckl_context), intent(in) :: context + integer(c_int64_t) , intent(in), value :: num_in + 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_ee + real(c_double) , intent(in) :: coord(3,walk_num) + real(c_double) , intent(in) :: coord_ee(elec_num,3,walk_num) + real(c_double) , intent(in) :: single_ee_distance(elec_num,walk_num) + real(c_double) , intent(in) :: een_rescaled_single_e(elec_num,0:cord_num,walk_num) + real(c_double) , intent(out) :: een_rescaled_single_e_gl(4,elec_num,0:cord_num,walk_num) + + double precision,allocatable :: elec_dist_gl(:,:) + double precision :: x, rij_inv, kappa_l + integer*8 :: i, j, k, l, nw, ii, num num = num_in + 1 @@ -4183,45 +3904,42 @@ integer function qmckl_compute_een_rescaled_single_e_gl_f( & return endif -! Not necessary: should be set to zero by qmckl_malloc -! een_rescaled_single_e_gl = 0.0d0 + ! Not necessary: should be set to zero by qmckl_malloc + ! een_rescaled_single_e_gl = 0.0d0 ! Prepare table of exponentiated distances raised to appropriate power do nw = 1, walk_num - do i = 1, elec_num + do i = 1, elec_num rij_inv = 1.0d0 / single_ee_distance(i, nw) do ii = 1, 3 - elec_dist_gl(ii, i) = (coord(ii) - coord_ee(i, ii, nw)) * rij_inv + elec_dist_gl(ii, i) = (coord(ii,nw) - coord_ee(i, ii, nw)) * rij_inv end do elec_dist_gl(4, i) = 2.0d0 * rij_inv - end do + end do - elec_dist_gl(:, num) = 0.0d0 + elec_dist_gl(:, num) = 0.0d0 - do l = 1, cord_num - kappa_l = - dble(l) * rescale_factor_ee - do i = 1, elec_num - een_rescaled_single_e_gl(1, i, l, nw) = kappa_l * elec_dist_gl(1, i) - een_rescaled_single_e_gl(2, i, l, nw) = kappa_l * elec_dist_gl(2, i) - een_rescaled_single_e_gl(3, i, l, nw) = kappa_l * elec_dist_gl(3, i) - een_rescaled_single_e_gl(4, i, l, nw) = kappa_l * elec_dist_gl(4, i) + do l = 1, cord_num + kappa_l = - dble(l) * rescale_factor_ee + do i = 1, elec_num + een_rescaled_single_e_gl(1, i, l, nw) = kappa_l * elec_dist_gl(1, i) + een_rescaled_single_e_gl(2, i, l, nw) = kappa_l * elec_dist_gl(2, i) + een_rescaled_single_e_gl(3, i, l, nw) = kappa_l * elec_dist_gl(3, i) + een_rescaled_single_e_gl(4, i, l, nw) = kappa_l * (elec_dist_gl(4, i) + kappa_l) - een_rescaled_single_e_gl(4, i, l, nw) = een_rescaled_single_e_gl(4, i, l, nw) + & - kappa_l * kappa_l + een_rescaled_single_e_gl(1,i,l,nw) = een_rescaled_single_e_gl(1,i,l,nw) * een_rescaled_single_e(i,l,nw) + een_rescaled_single_e_gl(2,i,l,nw) = een_rescaled_single_e_gl(2,i,l,nw) * een_rescaled_single_e(i,l,nw) + een_rescaled_single_e_gl(3,i,l,nw) = een_rescaled_single_e_gl(3,i,l,nw) * een_rescaled_single_e(i,l,nw) + een_rescaled_single_e_gl(4,i,l,nw) = een_rescaled_single_e_gl(4,i,l,nw) * een_rescaled_single_e(i,l,nw) - een_rescaled_single_e_gl(1,i,l,nw) = een_rescaled_single_e_gl(1,i,l,nw) * een_rescaled_single_e(i,l,nw) - een_rescaled_single_e_gl(2,i,l,nw) = een_rescaled_single_e_gl(2,i,l,nw) * een_rescaled_single_e(i,l,nw) - een_rescaled_single_e_gl(3,i,l,nw) = een_rescaled_single_e_gl(3,i,l,nw) * een_rescaled_single_e(i,l,nw) - een_rescaled_single_e_gl(4,i,l,nw) = een_rescaled_single_e_gl(4,i,l,nw) * een_rescaled_single_e(i,l,nw) - - end do + end do + end do end do -end do -end function qmckl_compute_een_rescaled_single_e_gl_f +end function qmckl_compute_een_rescaled_single_e_gl_doc #+end_src # #+CALL: generate_c_header(table=qmckl_factor_een_rescaled_e_gl_args,rettyp=get_value("CRetType"),fname=get_value("Name")) @@ -4257,57 +3975,6 @@ end function qmckl_compute_een_rescaled_single_e_gl_f #+end_src - #+CALL: generate_c_interface(table=qmckl_een_rescaled_single_e_gl_args,rettyp=get_value("CRetType"),fname=get_value("Name")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_een_rescaled_single_e_gl_doc & - (context, & - num, & - walk_num, & - elec_num, & - cord_num, & - rescale_factor_ee, & - coord, & - coord_ee, & - single_ee_distance, & - een_rescaled_single_e, & - een_rescaled_single_e_gl) & - bind(C) result(info) - - use, intrinsic :: iso_c_binding - implicit none - - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) , value :: num - 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_ee - real (c_double ) , intent(in) :: coord(3) - real (c_double ) , intent(in) :: coord_ee(elec_num, 3, walk_num) - real (c_double ) , intent(in) :: single_ee_distance(elec_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_single_e(elec_num,0:cord_num,walk_num) - real (c_double ) , intent(out) :: een_rescaled_single_e_gl(4,elec_num,0:cord_num,walk_num) - - integer(c_int32_t), external :: qmckl_compute_een_rescaled_single_e_gl_f - info = qmckl_compute_een_rescaled_single_e_gl_f & - (context, & - num, & - walk_num, & - elec_num, & - cord_num, & - rescale_factor_ee, & - coord, & - coord_ee, & - single_ee_distance, & - een_rescaled_single_e, & - een_rescaled_single_e_gl) - - end function qmckl_compute_een_rescaled_single_e_gl_doc - #+end_src - - #+begin_src c :comments org :tangle (eval c) :noweb yes qmckl_exit_code qmckl_compute_een_rescaled_single_e_gl ( const qmckl_context context, @@ -4393,7 +4060,6 @@ for (int l = 0; l < cord_num+1; l++) { } #+end_src - * gl delta p ** Get @@ -4458,6 +4124,18 @@ qmckl_exit_code qmckl_provide_jastrow_champ_delta_p_gl(qmckl_context context) qmckl_exit_code rc = qmckl_provide_een_rescaled_single_e(context); if(rc != QMCKL_SUCCESS) return rc; + rc = qmckl_provide_een_rescaled_n(context); + if(rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_een_rescaled_e(context); + if(rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_een_rescaled_n_gl(context); + if(rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_een_rescaled_e_gl(context); + if(rc != QMCKL_SUCCESS) return rc; + rc = qmckl_provide_een_rescaled_single_n(context); if(rc != QMCKL_SUCCESS) return rc; @@ -4549,41 +4227,38 @@ qmckl_exit_code qmckl_provide_jastrow_champ_delta_p_gl(qmckl_context context) | ~een_rescaled_e_gl~ | ~double[walk_num][0:cord_num][elec_num][4][elec_num]~ | in | Electron-electron rescaled distances | | ~een_rescaled_single_n_gl~ | ~double[walk_num][0:cord_num][nucl_num][4]~ | in | Electron-nucleus single rescaled distances | | ~een_rescaled_single_e_gl~ | ~double[walk_num][0:cord_num][elec_num][4]~ | in | Electron-electron single rescaled distances | - | ~delta_p_gl~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][4][elec_num]~ | out | Electron-nucleus jastrow | + | ~delta_p_gl~ | ~double[walk_num][0:cord_num-1][0:cord_num][4][nucl_num][elec_num]~ | out | Electron-nucleus jastrow | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_jastrow_champ_delta_p_gl_doc_f( & +integer(qmckl_exit_code) function qmckl_compute_jastrow_champ_delta_p_gl_doc( & context, num_in, walk_num, elec_num, nucl_num, cord_num, & een_rescaled_n, een_rescaled_e, een_rescaled_single_n, een_rescaled_single_e, & een_rescaled_n_gl, een_rescaled_e_gl, een_rescaled_single_n_gl, een_rescaled_single_e_gl, delta_p_gl) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: num_in, walk_num, elec_num, cord_num, nucl_num - double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_single_n(nucl_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_single_e(elec_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_n_gl(elec_num, 4, nucl_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_e_gl(elec_num, 4, elec_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_single_n_gl(4, nucl_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_single_e_gl(4,elec_num, 0:cord_num, walk_num) - double precision , intent(out) :: delta_p_gl(elec_num,4,nucl_num,0:cord_num, 0:cord_num-1, walk_num) + integer(c_int64_t) , intent(in), value :: num_in, walk_num, elec_num, cord_num, nucl_num + real(c_double) , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) + real(c_double) , intent(in) :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num) + real(c_double) , intent(in) :: een_rescaled_single_n(nucl_num, 0:cord_num, walk_num) + real(c_double) , intent(in) :: een_rescaled_single_e(elec_num, 0:cord_num, walk_num) + real(c_double) , intent(in) :: een_rescaled_n_gl(elec_num, 4, nucl_num, 0:cord_num, walk_num) + real(c_double) , intent(in) :: een_rescaled_e_gl(elec_num, 4, elec_num, 0:cord_num, walk_num) + real(c_double) , intent(in) :: een_rescaled_single_n_gl(4, nucl_num, 0:cord_num, walk_num) + real(c_double) , intent(in) :: een_rescaled_single_e_gl(4,elec_num, 0:cord_num, walk_num) + real(c_double) , intent(out) :: delta_p_gl(elec_num,nucl_num,4,0:cord_num, 0:cord_num-1, walk_num) - double precision :: delta_e_gl(4,elec_num, 0:cord_num, walk_num) + double precision :: delta_e_gl(elec_num,4) + double precision :: delta_e_gl_2(elec_num) + double precision :: een_rescaled_e_gl_2(elec_num) - double precision :: delta_e_gl_2(elec_num, 0:cord_num, walk_num) - double precision :: een_rescaled_e_gl_2(elec_num, elec_num, 0:cord_num, walk_num) - - double precision :: een_rescaled_delta_n(nucl_num, 0:cord_num, walk_num) - - double precision :: delta_c(nucl_num,0:cord_num, 0:cord_num-1, walk_num) - double precision :: delta_c2(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) + double precision :: een_rescaled_delta_n, fk(4) integer*8 :: i, a, j, l, k, p, m, n, nw, num - double precision :: accu, accu2, cn - integer*8 :: LDA, LDB, LDC + double precision :: tmp + integer*8 :: LDA, LDB, LDC num = num_in + 1 @@ -4597,152 +4272,42 @@ integer function qmckl_compute_jastrow_champ_delta_p_gl_doc_f( & if (info /= QMCKL_SUCCESS) return - if (cord_num == 0) return + if (cord_num == 0) then + delta_p_gl = 0.d0 + return + endif + fk(1:3) = -1.d0 + fk(4) = 1.d0 + + do nw=1, walk_num + do m=0, cord_num-1 + do k = 1, 4 + do j = 1, elec_num + delta_e_gl(j,k) = een_rescaled_single_e_gl(k,j,m,nw) - een_rescaled_e_gl(num, k, j, m, nw) + end do + delta_e_gl(num,k) = 0.0d0 + end do - delta_e_gl(:,:,:,:) = een_rescaled_single_e_gl(:,:,:,:) - een_rescaled_e_gl(num, :, :, :, :) - - delta_e_gl(:, num, :, :) = 0.0d0 - - een_rescaled_delta_n(:,:,:) = een_rescaled_single_n(:,:,:) - een_rescaled_n(num, :, :, :) - - delta_c = 0.0d0 - delta_c2 = 0.0d0 - delta_p_gl = 0.0d0 - - - if (.false.) then - - ! Compute using loops - - do nw=1, walk_num - do m=0, cord_num-1 - do a = 1, nucl_num - do l=0, cord_num + do l=0, cord_num + do k = 1, 4 + do a = 1, nucl_num + een_rescaled_delta_n = een_rescaled_single_n(a,l,nw) - een_rescaled_n(num, a, l, nw) + tmp = fk(k) * (een_rescaled_n(num,a,l,nw) + een_rescaled_delta_n) do j = 1, elec_num - do k = 1, 3 - delta_p_gl(num,k,a,l,m,nw) = delta_p_gl(num,k,a,l,m,nw) + & - delta_e_gl(k,j,m,nw) * een_rescaled_n(j,a,l,nw) - delta_p_gl(j,k,a,l,m,nw) = delta_p_gl(j,k,a,l,m,nw) - & - delta_e_gl(k,j,m,nw) * een_rescaled_n(num,a,l,nw) - - - delta_p_gl(j,k,a,l,m,nw) = delta_p_gl(j,k,a,l,m,nw) + & - een_rescaled_e_gl(j,k,num,m,nw) * een_rescaled_delta_n(a,l,nw) - - delta_p_gl(j,k,a,l,m,nw) = delta_p_gl(j,k,a,l,m,nw) - & - delta_e_gl(k,j,m,nw) * een_rescaled_delta_n(a,l,nw) - - - end do - delta_p_gl(num,4,a,l,m,nw) = delta_p_gl(num,4,a,l,m,nw) + & - delta_e_gl(4,j,m,nw) * een_rescaled_n(j,a,l,nw) - delta_p_gl(j,4,a,l,m,nw) = delta_p_gl(j,4,a,l,m,nw) + & - delta_e_gl(4,j,m,nw) * een_rescaled_n(num,a,l,nw) - - delta_p_gl(j,4,a,l,m,nw) = delta_p_gl(j,4,a,l,m,nw) + & - een_rescaled_e_gl(num,4,j,m,nw) * een_rescaled_delta_n(a,l,nw) - - delta_p_gl(j,4,a,l,m,nw) = delta_p_gl(j,4,a,l,m,nw) + & - delta_e_gl(4,j,m,nw) * een_rescaled_delta_n(a,l,nw) - + delta_p_gl(j,a,k,l,m,nw) = delta_e_gl(j,k) * tmp + & + een_rescaled_e_gl(j,k,num,m,nw) * een_rescaled_delta_n + end do + do j = 1, elec_num + delta_p_gl(num,a,k,l,m,nw) = delta_p_gl(num,a,k,l,m,nw) + delta_e_gl(j,k) * een_rescaled_n(j,a,l,nw) end do end do end do end do end do + end do - else - - ! Use DGEMM - - do nw=1, walk_num - do m=0, cord_num-1 - - do k = 1, 3 - delta_e_gl_2(:,:,:) = delta_e_gl(k, :,:,:) - een_rescaled_e_gl_2(:,:,:,:) = een_rescaled_e_gl(:,k, :,:,:) - - info = qmckl_dgemm(context, 'T', 'N', 1_8, nucl_num * (cord_num+1), elec_num, 1.0d0, & - delta_e_gl_2(1,m,nw),elec_num, & - een_rescaled_n(1,1,0,nw),elec_num, & - 0.0d0, & - delta_c(1,0,m,nw),1_8) - - info = qmckl_dgemm(context, 'N', 'N', elec_num, nucl_num * (cord_num+1), 1_8, -1.0d0, & - delta_e_gl_2(1,m,nw),elec_num, & - een_rescaled_n(num,1,0,nw),elec_num, & - 0.0d0, & - delta_c2(1,1,0,m,nw),elec_num) - - delta_c2(num,:,:,m,nw) = delta_c2(num,:,:,m,nw) + delta_c(:,:,m,nw) - delta_p_gl(:,k,:,:,m,nw) = delta_c2(:,:,:,m,nw) - - - info = qmckl_dgemm(context, 'N', 'T', elec_num, nucl_num * (cord_num+1), 1_8, 1.0d0, & - een_rescaled_e_gl_2(:,num,m,nw),elec_num, & - een_rescaled_delta_n(:,:,nw),nucl_num* (cord_num+1), & - 0.0d0, & - delta_c2(:,:,:,m,nw),elec_num) - - - - delta_p_gl(:,k,:,:,m,nw) = delta_p_gl(:,k,:,:,m,nw) + delta_c2(:,:,:,m,nw) - - info = qmckl_dgemm(context, 'N', 'T', elec_num, nucl_num * (cord_num+1), 1_8, -1.0d0, & - delta_e_gl_2(:,m,nw),elec_num, & - een_rescaled_delta_n(:,:,nw),nucl_num* (cord_num+1), & - 0.0d0, & - delta_c2(:,:,:,m,nw),elec_num) - - delta_p_gl(:,k,:,:,m,nw) = delta_p_gl(:,k,:,:,m,nw) + delta_c2(:,:,:,m,nw) - - - end do - k = 4 - delta_e_gl_2(:,:,:) = delta_e_gl(k, :,:,:) - een_rescaled_e_gl_2(:,:,:,:) = een_rescaled_e_gl(:,k, :,:,:) - - info = qmckl_dgemm(context, 'T', 'N', 1_8, nucl_num * (cord_num+1), elec_num, 1.0d0, & - delta_e_gl_2(1,m,nw),elec_num, & - een_rescaled_n(1,1,0,nw),elec_num, & - 0.0d0, & - delta_c(1,0,m,nw),1_8) - - info = qmckl_dgemm(context, 'N', 'N', elec_num, nucl_num * (cord_num+1), 1_8, 1.0d0, & - delta_e_gl_2(1,m,nw),elec_num, & - een_rescaled_n(num,1,0,nw),elec_num, & - 0.0d0, & - delta_c2(1,1,0,m,nw),elec_num) - - delta_c2(num,:,:,m,nw) = delta_c2(num,:,:,m,nw) + delta_c(:,:,m,nw) - delta_p_gl(:,k,:,:,m,nw) = delta_c2(:,:,:,m,nw) - - - info = qmckl_dgemm(context, 'N', 'T', elec_num, nucl_num * (cord_num+1), 1_8, 1.0d0, & - een_rescaled_e_gl_2(:,num,m,nw),elec_num, & - een_rescaled_delta_n(:,:,nw),nucl_num* (cord_num+1), & - 0.0d0, & - delta_c2(:,:,:,m,nw),elec_num) - - - delta_p_gl(:,k,:,:,m,nw) = delta_p_gl(:,k,:,:,m,nw) + delta_c2(:,:,:,m,nw) - - info = qmckl_dgemm(context, 'N', 'T', elec_num, nucl_num * (cord_num+1), 1_8, 1.0d0, & - delta_e_gl_2(:,m,nw),elec_num, & - een_rescaled_delta_n(:,:,nw),nucl_num* (cord_num+1), & - 0.0d0, & - delta_c2(:,:,:,m,nw),elec_num) - - delta_p_gl(:,k,:,:,m,nw) = delta_p_gl(:,k,:,:,m,nw) + delta_c2(:,:,:,m,nw) - end do - end do - end if - - - -end function qmckl_compute_jastrow_champ_delta_p_gl_doc_f - +end function qmckl_compute_jastrow_champ_delta_p_gl_doc #+end_src # #+CALL: generate_c_header(table=qmckl_factor_een_args,rettyp=qmckl_exit_code),fname=get_value("Name")) @@ -4813,67 +4378,7 @@ qmckl_compute_jastrow_champ_delta_p_gl (const qmckl_context context, } #+end_src - #+CALL: generate_c_interface(table=qmckl_factor_delta_p_gl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_delta_p_gl_doc")) - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_jastrow_champ_delta_p_gl_doc & - (context, & - num, & - walk_num, & - elec_num, & - nucl_num, & - cord_num, & - een_rescaled_n, & - een_rescaled_e, & - een_rescaled_single_n, & - een_rescaled_single_e, & - een_rescaled_n_gl, & - een_rescaled_e_gl, & - een_rescaled_single_n_gl, & - een_rescaled_single_e_gl, & - delta_p_gl) & - bind(C) result(info) - - use, intrinsic :: iso_c_binding - implicit none - - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) , value :: num - 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) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_single_n(nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_single_e(elec_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_n_gl(elec_num,4,nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_e_gl(elec_num,4,elec_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_single_n_gl(4, nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_single_e_gl(4,elec_num,0:cord_num,walk_num) - real (c_double ) , intent(out) :: delta_p_gl(elec_num,4,nucl_num,0:cord_num,0:cord_num-1,walk_num) - - integer(c_int32_t), external :: qmckl_compute_jastrow_champ_delta_p_gl_doc_f - info = qmckl_compute_jastrow_champ_delta_p_gl_doc_f & - (context, & - num, & - walk_num, & - elec_num, & - nucl_num, & - cord_num, & - een_rescaled_n, & - een_rescaled_e, & - een_rescaled_single_n, & - een_rescaled_single_e, & - een_rescaled_n_gl, & - een_rescaled_e_gl, & - een_rescaled_single_n_gl, & - een_rescaled_single_e_gl, & - delta_p_gl) - - end function qmckl_compute_jastrow_champ_delta_p_gl_doc - #+end_src ** test @@ -4895,7 +4400,7 @@ assert (rc == QMCKL_SUCCESS); rc = qmckl_set_single_point(context, 'N', 2, new_coords, 3); assert (rc == QMCKL_SUCCESS); -double delta_p_gl[walk_num][cord_num][cord_num+1][nucl_num][4][elec_num]; +double delta_p_gl[walk_num][cord_num][cord_num+1][4][nucl_num][elec_num]; rc = qmckl_get_jastrow_champ_delta_p_gl(context, &delta_p_gl[0][0][0][0][0][0], 4*walk_num*cord_num*(cord_num+1)*nucl_num*elec_num); assert (rc == QMCKL_SUCCESS); @@ -4917,12 +4422,12 @@ for (int nw = 0; nw < walk_num; nw++){ for (int a = 0; a < nucl_num; a++) { for (int i = 0; i < elec_num; i++){ for (int k = 0; k < 4; k++){ - if (fabs(((p_gl_new[nw][l][m][a][k][i]-p_gl_old[nw][l][m][a][k][i])-delta_p_gl[nw][l][m][a][k][i])) > 1.e-12) { + if (fabs(((p_gl_new[nw][l][m][a][k][i]-p_gl_old[nw][l][m][a][k][i])-delta_p_gl[nw][l][m][k][a][i])) > 1.e-12) { printf("p_gl[%d][%d][%d][%d][%d][%d] = %f\n", nw, l, m, a, k, i, p_gl_new[nw][l][m][a][k][i] - p_gl_old[nw][l][m][a][k][i]); - printf("delta_p_gl[%d][%d][%d][%d][%d][%d] = %f\n", nw, l, m, a, k, i, delta_p_gl[nw][l][m][a][k][i]); + printf("delta_p_gl[%d][%d][%d][%d][%d][%d] = %f\n", nw, l, m, a, k, i, delta_p_gl[nw][l][m][k][a][i]); } - assert(fabs(((p_gl_new[nw][l][m][a][k][i]-p_gl_old[nw][l][m][a][k][i])-delta_p_gl[nw][l][m][a][k][i])) < 1.e-12); + assert(fabs(((p_gl_new[nw][l][m][a][k][i]-p_gl_old[nw][l][m][a][k][i])-delta_p_gl[nw][l][m][k][a][i])) < 1.e-12); } } } @@ -5100,7 +4605,7 @@ qmckl_exit_code qmckl_provide_jastrow_champ_single_een_gl(qmckl_context context) | ~tmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | in | vector of non-zero coefficients | | ~dtmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][4][elec_num]~ | in | vector of non-zero coefficients | | ~delta_p~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | in | vector of non-zero coefficients | - | ~delta_p_gl~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][4][elec_num]~ | in | vector of non-zero coefficients | + | ~delta_p_gl~ | ~double[walk_num][0:cord_num-1][0:cord_num][4][nucl_num][elec_num]~ | in | vector of non-zero coefficients | | ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | in | Electron-nucleus rescaled distances | | ~een_rescaled_single_n~ | ~double[walk_num][0:cord_num][nucl_num]~ | in | Electron-nucleus single rescaled distances | | ~een_rescaled_n_gl~ | ~double[walk_num][0:cord_num][nucl_num][4][elec_num]~ | in | Electron-nucleus rescaled distances | @@ -5108,27 +4613,28 @@ qmckl_exit_code qmckl_provide_jastrow_champ_single_een_gl(qmckl_context context) | ~delta_een_gl~ | ~double[walk_num][elec_num][4]~ | out | Electron-nucleus jastrow | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_jastrow_champ_factor_single_een_gl_doc_f( & +integer(qmckl_exit_code) function qmckl_compute_jastrow_champ_factor_single_een_gl_doc( & context, num_in, walk_num, elec_num, nucl_num, cord_num, & dim_c_vector, c_vector_full, lkpm_combined_index, & tmp_c, dtmp_c, delta_p, delta_p_gl, een_rescaled_n, een_rescaled_single_n, & een_rescaled_n_gl, een_rescaled_single_n_gl, delta_een_gl) & - result(info) + result(info) bind(C) + use, intrinsic :: iso_c_binding use qmckl implicit none integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: num_in, walk_num, elec_num, cord_num, nucl_num, dim_c_vector - integer*8 , intent(in) :: lkpm_combined_index(dim_c_vector,4) - double precision , intent(in) :: c_vector_full(nucl_num, dim_c_vector) - double precision , intent(in) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) - double precision , intent(in) :: dtmp_c(elec_num, 4, nucl_num,0:cord_num, 0:cord_num-1, walk_num) - double precision , intent(in) :: delta_p(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) - double precision , intent(in) :: delta_p_gl(elec_num, 4, nucl_num,0:cord_num, 0:cord_num-1, walk_num) - double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_single_n(nucl_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_n_gl(elec_num, 4, nucl_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_single_n_gl(4, nucl_num, 0:cord_num, walk_num) - double precision , intent(out) :: delta_een_gl(4, elec_num, walk_num) + integer(c_int64_t) , intent(in), value :: num_in, walk_num, elec_num, cord_num, nucl_num, dim_c_vector + integer(c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,4) + real(c_double) , intent(in) :: c_vector_full(nucl_num, dim_c_vector) + real(c_double) , intent(in) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) + real(c_double) , intent(in) :: dtmp_c(elec_num, 4, nucl_num,0:cord_num, 0:cord_num-1, walk_num) + real(c_double) , intent(in) :: delta_p(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) + real(c_double) , intent(in) :: delta_p_gl(elec_num, nucl_num, 4, 0:cord_num, 0:cord_num-1, walk_num) + real(c_double) , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) + real(c_double) , intent(in) :: een_rescaled_single_n(nucl_num, 0:cord_num, walk_num) + real(c_double) , intent(in) :: een_rescaled_n_gl(elec_num, 4, nucl_num, 0:cord_num, walk_num) + real(c_double) , intent(in) :: een_rescaled_single_n_gl(4, nucl_num, 0:cord_num, walk_num) + real(c_double) , intent(out) :: delta_een_gl(elec_num, 4, walk_num) integer*8 :: i, a, j, l, k, p, m, n, nw, kk, num double precision :: accu, accu2, cn @@ -5163,48 +4669,49 @@ integer function qmckl_compute_jastrow_champ_factor_single_een_gl_doc_f( & p = lkpm_combined_index(n, 3) m = lkpm_combined_index(n, 4) - do a = 1, nucl_num - cn = c_vector_full(a, n) - if(cn == 0.d0) cycle - do i = 1, elec_num - do kk = 1, 4 - delta_een_gl(kk,i,nw) = delta_een_gl(kk,i,nw) + ( & - delta_p_gl(i,kk,a,m ,k,nw) * een_rescaled_n(i,a,m+l,nw) + & - delta_p_gl(i,kk,a,m+l,k,nw) * een_rescaled_n(i,a,m ,nw) + & + do kk = 1, 4 + do a = 1, nucl_num + cn = c_vector_full(a, n) + if(cn == 0.d0) cycle + do i = 1, elec_num + delta_een_gl(i,kk,nw) = delta_een_gl(i,kk,nw) + ( & + delta_p_gl(i,a,kk,m ,k,nw) * een_rescaled_n(i,a,m+l,nw) + & + delta_p_gl(i,a,kk,m+l,k,nw) * een_rescaled_n(i,a,m ,nw) + & delta_p(i,a,m ,k,nw) * een_rescaled_n_gl(i,kk,a,m+l,nw) + & delta_p(i,a,m+l,k,nw) * een_rescaled_n_gl(i,kk,a,m ,nw) ) * cn end do - end do - do kk = 1, 4 - delta_een_gl(kk,num,nw) = delta_een_gl(kk,num,nw) + ( & - (dtmp_c(num,kk,a,m ,k,nw) + delta_p_gl(num,kk,a,m ,k,nw)) * een_rescaled_delta_n(a,m+l,nw) + & - (dtmp_c(num,kk,a,m+l,k,nw) + delta_p_gl(num,kk,a,m+l,k,nw)) * een_rescaled_delta_n(a,m ,nw) + & + delta_een_gl(num,kk,nw) = delta_een_gl(num,kk,nw) + ( & + (dtmp_c(num,kk,a,m ,k,nw) + delta_p_gl(num,a,kk,m ,k,nw)) * een_rescaled_delta_n(a,m+l,nw) + & + (dtmp_c(num,kk,a,m+l,k,nw) + delta_p_gl(num,a,kk,m+l,k,nw)) * een_rescaled_delta_n(a,m ,nw) + & (tmp_c(num,a,m ,k,nw) + delta_p(num,a,m ,k,nw)) * een_rescaled_delta_n_gl(kk,a,m+l,nw) + & - (tmp_c(num,a,m+l,k,nw) + delta_p(num,a,m+l,k,nw)) * een_rescaled_delta_n_gl(kk,a,m ,nw) ) & - ,* cn + (tmp_c(num,a,m+l,k,nw) + delta_p(num,a,m+l,k,nw)) * een_rescaled_delta_n_gl(kk,a,m ,nw) )* cn end do + end do + do a = 1, nucl_num + cn = c_vector_full(a, n) + if(cn == 0.d0) cycle cn = cn + cn do i = 1, elec_num - delta_een_gl(4,i,nw) = delta_een_gl(4,i,nw) + ( & - delta_p_gl(i,1,a,m ,k,nw) * een_rescaled_n_gl(i,1,a,m+l,nw) + & - delta_p_gl(i,1,a,m+l,k,nw) * een_rescaled_n_gl(i,1,a,m ,nw) + & - delta_p_gl(i,2,a,m ,k,nw) * een_rescaled_n_gl(i,2,a,m+l,nw) + & - delta_p_gl(i,2,a,m+l,k,nw) * een_rescaled_n_gl(i,2,a,m ,nw) + & - delta_p_gl(i,3,a,m ,k,nw) * een_rescaled_n_gl(i,3,a,m+l,nw) + & - delta_p_gl(i,3,a,m+l,k,nw) * een_rescaled_n_gl(i,3,a,m ,nw) ) * cn + delta_een_gl(i,4,nw) = delta_een_gl(i,4,nw) + ( & + delta_p_gl(i,a,1,m ,k,nw) * een_rescaled_n_gl(i,1,a,m+l,nw) + & + delta_p_gl(i,a,1,m+l,k,nw) * een_rescaled_n_gl(i,1,a,m ,nw) + & + delta_p_gl(i,a,2,m ,k,nw) * een_rescaled_n_gl(i,2,a,m+l,nw) + & + delta_p_gl(i,a,2,m+l,k,nw) * een_rescaled_n_gl(i,2,a,m ,nw) + & + delta_p_gl(i,a,3,m ,k,nw) * een_rescaled_n_gl(i,3,a,m+l,nw) + & + delta_p_gl(i,a,3,m+l,k,nw) * een_rescaled_n_gl(i,3,a,m ,nw) ) * cn end do - delta_een_gl(4,num,nw) = delta_een_gl(4,num,nw) + ( & - (delta_p_gl(num,1,a,m ,k,nw) + dtmp_c(num,1,a,m ,k,nw)) * een_rescaled_delta_n_gl(1,a,m+l,nw) + & - (delta_p_gl(num,1,a,m+l,k,nw) + dtmp_c(num,1,a,m+l,k,nw)) * een_rescaled_delta_n_gl(1,a,m ,nw) + & - (delta_p_gl(num,2,a,m ,k,nw) + dtmp_c(num,2,a,m ,k,nw)) * een_rescaled_delta_n_gl(2,a,m+l,nw) + & - (delta_p_gl(num,2,a,m+l,k,nw) + dtmp_c(num,2,a,m+l,k,nw)) * een_rescaled_delta_n_gl(2,a,m ,nw) + & - (delta_p_gl(num,3,a,m ,k,nw) + dtmp_c(num,3,a,m ,k,nw)) * een_rescaled_delta_n_gl(3,a,m+l,nw) + & - (delta_p_gl(num,3,a,m+l,k,nw) + dtmp_c(num,3,a,m+l,k,nw)) * een_rescaled_delta_n_gl(3,a,m ,nw) ) * cn + delta_een_gl(num,4,nw) = delta_een_gl(num,4,nw) + ( & + (delta_p_gl(num,a,1,m ,k,nw) + dtmp_c(num,1,a,m ,k,nw)) * een_rescaled_delta_n_gl(1,a,m+l,nw) + & + (delta_p_gl(num,a,1,m+l,k,nw) + dtmp_c(num,1,a,m+l,k,nw)) * een_rescaled_delta_n_gl(1,a,m ,nw) + & + (delta_p_gl(num,a,2,m ,k,nw) + dtmp_c(num,2,a,m ,k,nw)) * een_rescaled_delta_n_gl(2,a,m+l,nw) + & + (delta_p_gl(num,a,2,m+l,k,nw) + dtmp_c(num,2,a,m+l,k,nw)) * een_rescaled_delta_n_gl(2,a,m ,nw) + & + (delta_p_gl(num,a,3,m ,k,nw) + dtmp_c(num,3,a,m ,k,nw)) * een_rescaled_delta_n_gl(3,a,m+l,nw) + & + (delta_p_gl(num,a,3,m+l,k,nw) + dtmp_c(num,3,a,m+l,k,nw)) * een_rescaled_delta_n_gl(3,a,m ,nw) ) * cn end do end do end do -end function qmckl_compute_jastrow_champ_factor_single_een_gl_doc_f +end function qmckl_compute_jastrow_champ_factor_single_een_gl_doc #+end_src # #+CALL: generate_c_header(table=qmckl_factor_een_args,rettyp=qmckl_exit_code),fname=get_value("Name")) @@ -5283,76 +4790,7 @@ qmckl_compute_jastrow_champ_factor_single_een_gl (const qmckl_context context, } #+end_src - #+CALL: generate_c_interface(table=qmckl_factor_single_een_gl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_factor_single_een_gl_doc")) - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none -integer(c_int32_t) function qmckl_compute_jastrow_champ_factor_single_een_gl_doc & - (context, & - num, & - walk_num, & - elec_num, & - nucl_num, & - cord_num, & - dim_c_vector, & - c_vector_full, & - lkpm_combined_index, & - tmp_c, & - dtmp_c, & - delta_p, & - delta_p_gl, & - een_rescaled_n, & - een_rescaled_single_n, & - een_rescaled_n_gl, & - een_rescaled_single_n_gl, & - delta_een_gl) & - bind(C) result(info) - - use, intrinsic :: iso_c_binding - implicit none - - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) , value :: num - 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_c_vector - real (c_double ) , intent(in) :: c_vector_full(nucl_num,dim_c_vector) - integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,4) - real (c_double ) , intent(in) :: tmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) - real (c_double ) , intent(in) :: dtmp_c(elec_num,4,nucl_num,0:cord_num,0:cord_num-1,walk_num) - real (c_double ) , intent(in) :: delta_p(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) - real (c_double ) , intent(in) :: delta_p_gl(elec_num,4,nucl_num,0:cord_num,0:cord_num-1,walk_num) - real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_single_n(nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_n_gl(elec_num,4,nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_single_n_gl(4,nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(out) :: delta_een_gl(4, elec_num, walk_num) - - integer(c_int32_t), external :: qmckl_compute_jastrow_champ_factor_single_een_gl_doc_f - info = qmckl_compute_jastrow_champ_factor_single_een_gl_doc_f & - (context, & - num, & - walk_num, & - elec_num, & - nucl_num, & - cord_num, & - dim_c_vector, & - c_vector_full, & - lkpm_combined_index, & - tmp_c, & - dtmp_c, & - delta_p, & - delta_p_gl, & - een_rescaled_n, & - een_rescaled_single_n, & - een_rescaled_n_gl, & - een_rescaled_single_n_gl, & - delta_een_gl) - -end function qmckl_compute_jastrow_champ_factor_single_een_gl_doc - #+end_src ** test @@ -5366,7 +4804,7 @@ rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3); assert(rc == QMCKL_SUCCESS); double een_gl_old[walk_num][4][elec_num]; -rc = qmckl_get_jastrow_champ_factor_een_gl(context, &een_gl_old[0][0][0], walk_num*elec_num*4); +rc = qmckl_get_jastrow_champ_factor_een_gl(context, &een_gl_old[0][0][0], walk_num*4*elec_num); assert (rc == QMCKL_SUCCESS); rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3); @@ -5375,8 +4813,8 @@ assert (rc == QMCKL_SUCCESS); rc = qmckl_set_single_point(context, 'N', 2, new_coords, 3); assert (rc == QMCKL_SUCCESS); -double delta_een_gl[walk_num][elec_num][4]; -rc = qmckl_get_jastrow_champ_single_een_gl(context, &delta_een_gl[0][0][0], walk_num*elec_num*4); +double delta_een_gl[walk_num][4][elec_num]; +rc = qmckl_get_jastrow_champ_single_een_gl(context, &delta_een_gl[0][0][0], walk_num*4*elec_num); assert (rc == QMCKL_SUCCESS); coords[0][2][0] = new_coords[0]; @@ -5387,16 +4825,16 @@ rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num assert (rc == QMCKL_SUCCESS); double een_gl_new[walk_num][4][elec_num]; -rc = qmckl_get_jastrow_champ_factor_een_gl(context, &een_gl_new[0][0][0], walk_num*elec_num*4); +rc = qmckl_get_jastrow_champ_factor_een_gl(context, &een_gl_new[0][0][0], walk_num*4*elec_num); assert (rc == QMCKL_SUCCESS); for (int nw = 0; nw < walk_num; nw++) { - for (int i = 0; i < elec_num; i++) { - for (int m = 0; m < 4; m++) { + for (int m = 0; m < 4; m++) { + for (int i = 0; i < elec_num; i++) { //printf("delta_een_gl[%d][%d][%d] = %f\n", nw, i, m, delta_een_gl[nw][i][m]); //printf("een_gl_[%d][%d][%d] = %f\n", nw, m,i, een_gl_new[nw][m][i]-een_gl_old[nw][m][i]); - assert(fabs((een_gl_new[nw][m][i]- een_gl_old[nw][m][i]) - delta_een_gl[nw][i][m]) < 1.e-12); + assert(fabs((een_gl_new[nw][m][i]- een_gl_old[nw][m][i]) - delta_een_gl[nw][m][i]) < 1.e-12); } } @@ -6966,7 +6404,7 @@ qmckl_get_jastrow_champ_single_accept(qmckl_context context) ctx->jastrow_champ.een_rescaled_e_gl[nw][l][ctx->single_point.num][k][i] = ctx->jastrow_champ.een_rescaled_single_e_gl[nw][l][i][k]; for (m = 0; m < ctx->jastrow_champ.cord_num; m++){ for (a = 0; a < ctx->nucleus.num; a++){ - ctx->jastrow_champ.dtmp_c[nw][i][k][a][l][m] = ctx->jastrow_champ.dtmp_c[nw][i][k][a][l][m] + ctx->single_point.delta_p_gl[nw][m][l][a][i][k] + ctx->jastrow_champ.dtmp_c[nw][i][k][a][l][m] = ctx->jastrow_champ.dtmp_c[nw][i][k][a][l][m] + ctx->single_point.delta_p_gl[nw][m][l][k][a][i] } } } diff --git a/org/qmckl_memory.org b/org/qmckl_memory.org index 7f44382..c61479d 100644 --- a/org/qmckl_memory.org +++ b/org/qmckl_memory.org @@ -7,11 +7,12 @@ optimized libraries to fine-tune the memory allocation. Example of usage: #+begin_src c -#include "qmckl_memory.h" - info_struct mem_info = qmckl_memory_info_struct_zero; mem_info.size = size * sizeof(double); data = (double*) qmckl_malloc (context, mem_info); +if (data == NULL) { + return QMCKL_ALLOCATION_FAILED; +} // ... qmckl_free(data); #+end_src diff --git a/org/qmckl_tests.org b/org/qmckl_tests.org index 75ef952..759b7ba 100644 --- a/org/qmckl_tests.org +++ b/org/qmckl_tests.org @@ -2,6 +2,9 @@ # -*- org-image-actual-width: 300 -*- +To modify the data of the tests, don't modify only this file. You will +need to modify the files that are in the =include/= directory. + * CHBrClF This test is the all-electron Hartree-Fock wave function of CHClBr, @@ -967,7 +970,8 @@ double chbrclf_basis_prim_factor[chbrclf_prim_num] = #+end_src ** Molecular orbitals - The file is too large to be included in org-mode. + +The file is too large to be included in org-mode. #+begin_src c #define chbrclf_mo_num ((int64_t) 224) @@ -975,7 +979,6 @@ double chbrclf_mo_coef[chbrclf_mo_num*chbrclf_ao_num] = { ... see include/chbrclf.h } - #+end_src ** Electron coordinates @@ -1153,7 +1156,7 @@ N2 Nuclear coordinates are stored in atomic units in transposed format. -#+begin_src c :tangle (concat include "n2.h") +#+begin_src c #define n2_nucl_num ((int64_t) 2) double n2_charge[n2_nucl_num] = { 5., 5.}; @@ -1169,7 +1172,7 @@ double n2_nucl_coord[3][n2_nucl_num] = Electron coordinates are stored in atomic units in normal format. -#+begin_src c :tangle (concat include "n2.h") +#+begin_src c #define n2_elec_up_num ((int64_t) 5) #define n2_elec_dn_num ((int64_t) 5) #define n2_elec_num ((int64_t) 10) @@ -1194,7 +1197,7 @@ double n2_elec_coord[n2_walk_num][n2_elec_num][3] = { { This test is mainly for the Jastrow factor and was supplied by Ramon Panades Baruetta. -#+begin_src c :tangle (concat include "n2.h") +#+begin_src c /* Jastrow related */ #define n2_type_nucl_num ((int64_t) 1)