1
0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2025-01-03 18:16:28 +01:00

Working on ee_distance_deriv_e.

This commit is contained in:
v1j4y 2022-02-11 15:27:18 +01:00
parent fa535bdcd1
commit da3c8c7cf9

View File

@ -1824,11 +1824,11 @@ assert(fabs(factor_ee[0]+4.282760865958113) < 1.e-12);
*** Get *** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes #+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context, double* const factor_ee_deriv_e); qmckl_exit_code qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context, double* const factor_ee_deriv_e, int64_t* size_max);
#+end_src #+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context, double* const factor_ee_deriv_e) qmckl_exit_code qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context, double* const factor_ee_deriv_e, int64_t* size_max)
{ {
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT; return QMCKL_NULL_CONTEXT;
@ -1844,6 +1844,7 @@ qmckl_exit_code qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context, doubl
int64_t sze = ctx->electron.walk_num * 4 * ctx->electron.num; int64_t sze = ctx->electron.walk_num * 4 * ctx->electron.num;
memcpy(factor_ee_deriv_e, ctx->jastrow.factor_ee_deriv_e, sze * sizeof(double)); memcpy(factor_ee_deriv_e, ctx->jastrow.factor_ee_deriv_e, sze * sizeof(double));
(*size_max) = sze;
return QMCKL_SUCCESS; return QMCKL_SUCCESS;
} }
@ -1947,8 +1948,8 @@ integer function qmckl_compute_factor_ee_deriv_e_f(context, walk_num, elec_num,
integer(qmckl_context), intent(in) :: context integer(qmckl_context), intent(in) :: context
integer*8 , intent(in) :: walk_num, elec_num, bord_num, up_num integer*8 , intent(in) :: walk_num, elec_num, bord_num, up_num
double precision , intent(in) :: bord_vector(bord_num + 1) double precision , intent(in) :: bord_vector(bord_num + 1)
double precision , intent(in) :: ee_distance_rescaled(walk_num, elec_num, elec_num) double precision , intent(in) :: ee_distance_rescaled(elec_num, elec_num,walk_num)
double precision , intent(in) :: ee_distance_rescaled_deriv_e(walk_num, 4, elec_num, elec_num) double precision , intent(in) :: ee_distance_rescaled_deriv_e(4,elec_num, elec_num,walk_num)
double precision , intent(in) :: asymp_jasb(2) double precision , intent(in) :: asymp_jasb(2)
double precision , intent(out) :: factor_ee_deriv_e(elec_num,4,walk_num) double precision , intent(out) :: factor_ee_deriv_e(elec_num,4,walk_num)
@ -1987,7 +1988,7 @@ integer function qmckl_compute_factor_ee_deriv_e_f(context, walk_num, elec_num,
do nw =1, walk_num do nw =1, walk_num
do j = 1, elec_num do j = 1, elec_num
do i = 1, elec_num do i = 1, elec_num
x = ee_distance_rescaled(nw, i, j) x = ee_distance_rescaled(i,j,nw)
if(abs(x) < 1.0d-18) cycle if(abs(x) < 1.0d-18) cycle
pow_ser_g = 0.0d0 pow_ser_g = 0.0d0
spin_fact = 1.0d0 spin_fact = 1.0d0
@ -1998,9 +1999,10 @@ integer function qmckl_compute_factor_ee_deriv_e_f(context, walk_num, elec_num,
xinv = 1.0d0 / (x + 1.0d-18) xinv = 1.0d0 / (x + 1.0d-18)
ipar = 1 ipar = 1
do ii = 1, 4 dx(ii) = ee_distance_rescaled_deriv_e(1, i, j, nw) &
dx(ii) = ee_distance_rescaled_deriv_e(nw, ii, i, j) + ee_distance_rescaled_deriv_e(2, i, j, nw) &
end do + ee_distance_rescaled_deriv_e(3, i, j, nw) &
+ ee_distance_rescaled_deriv_e(4, i, j, nw)
if((i .LE. up_num .AND. j .LE. up_num ) .OR. & if((i .LE. up_num .AND. j .LE. up_num ) .OR. &
(i .GT. up_num .AND. j .GT. up_num)) then (i .GT. up_num .AND. j .GT. up_num)) then
@ -2011,14 +2013,14 @@ integer function qmckl_compute_factor_ee_deriv_e_f(context, walk_num, elec_num,
lap2 = 0.0d0 lap2 = 0.0d0
lap3 = 0.0d0 lap3 = 0.0d0
do ii = 1, 3 do ii = 1, 3
x = ee_distance_rescaled(nw, i, j) x = ee_distance_rescaled(i, j, nw)
if(abs(x) < 1.0d-18) cycle if(abs(x) < 1.0d-18) cycle
do p = 2, bord_num do p = 2, bord_num
y = p * bord_vector(p + 1) * x y = p * bord_vector(p + 1) * x
pow_ser_g(ii) = pow_ser_g(ii) + y * dx(ii) pow_ser_g(ii) = pow_ser_g(ii) + y * dx(ii)
lap1 = lap1 + (p - 1) * y * xinv * dx(ii) * dx(ii) lap1 = lap1 + (p - 1) * y * xinv * dx(ii) * dx(ii)
lap2 = lap2 + y lap2 = lap2 + y
x = x * ee_distance_rescaled(nw, i, j) x = x * ee_distance_rescaled(i, j, nw)
end do end do
lap3 = lap3 - 2.0d0 * bord_vector(2) * dx(ii) * dx(ii) lap3 = lap3 - 2.0d0 * bord_vector(2) * dx(ii) * dx(ii)
@ -2215,7 +2217,8 @@ assert(qmckl_jastrow_provided(context));
// calculate factor_ee_deriv_e // calculate factor_ee_deriv_e
double factor_ee_deriv_e[walk_num][4][elec_num]; double factor_ee_deriv_e[walk_num][4][elec_num];
rc = qmckl_get_jastrow_factor_ee_deriv_e(context, &(factor_ee_deriv_e[0][0][0])); size_max=0;
rc = qmckl_get_jastrow_factor_ee_deriv_e(context, &(factor_ee_deriv_e[0][0][0]),&size_max);
// check factor_ee_deriv_e // check factor_ee_deriv_e
assert(fabs(factor_ee_deriv_e[0][0][0]-0.16364894652107934) < 1.e-12); assert(fabs(factor_ee_deriv_e[0][0][0]-0.16364894652107934) < 1.e-12);