1
0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2025-04-30 04:15:00 +02:00
qmckl/org/qmckl_jastrow_champ_single.org
2024-12-18 00:32:21 +01:00

285 KiB

CHAMP Jastrow Factor Single

Introduction

Context

Data structure

typedef struct qmckl_jastrow_champ_single_struct{
int64_t      num;
uint64_t     date;
qmckl_matrix coord;
double  *    restrict een_rescaled_single_e;
uint64_t     een_rescaled_single_e_date;
double  *    restrict een_rescaled_single_n;
uint64_t     een_rescaled_single_n_date;
uint64_t     single_ee_distance_date;
double*      single_ee_distance;
uint64_t     single_en_distance_date;
double*      single_en_distance;
double*      delta_een;
uint64_t     delta_een_date;
double*      delta_p;
uint64_t     delta_p_date;
double*      ee_rescaled_single;
uint64_t     ee_rescaled_single_date;
double*      en_rescaled_single;
uint64_t     en_rescaled_single_date;
double*      delta_en;
uint64_t     delta_en_date;
double*      delta_ee;
uint64_t     delta_ee_date;
double  *    restrict een_rescaled_single_e_gl;
uint64_t     een_rescaled_single_e_gl_date;
double  *    restrict een_rescaled_single_n_gl;
uint64_t     een_rescaled_single_n_gl_date;
double*      delta_p_gl;
uint64_t     delta_p_gl_date;
double*      delta_een_gl;
uint64_t     delta_een_gl_date;
double*      ee_rescaled_single_gl;
uint64_t     ee_rescaled_single_gl_date;
double*      en_rescaled_single_gl;
uint64_t     en_rescaled_single_gl_date;
double*      delta_en_gl;
uint64_t     delta_en_gl_date;
double*      delta_ee_gl;
uint64_t     delta_ee_gl_date;

} qmckl_jastrow_champ_single_struct;

Test

/* Reference input data */
int64_t walk_num      = n2_walk_num;
int64_t elec_num      = n2_elec_num;
int64_t elec_up_num   = n2_elec_up_num;
int64_t elec_dn_num   = n2_elec_dn_num;
int64_t nucl_num      = n2_nucl_num;
double  rescale_factor_ee   = 0.6;
double  rescale_factor_en[2] = { 0.6, 0.6 };
double* elec_coord    = &(n2_elec_coord[0][0][0]);

const double*   nucl_charge   = n2_charge;
double*  nucl_coord    = &(n2_nucl_coord[0][0]);

/* Provide Electron data */

qmckl_exit_code rc;

assert(!qmckl_electron_provided(context));

rc = qmckl_check(context,
              qmckl_set_electron_num (context, elec_up_num, elec_dn_num)
              );
assert(rc == QMCKL_SUCCESS);

assert(qmckl_electron_provided(context));

rc = qmckl_check(context,
              qmckl_set_electron_coord (context, 'N', walk_num, elec_coord, walk_num*3*elec_num)
              );
assert(rc == QMCKL_SUCCESS);

double elec_coord2[walk_num*3*elec_num];

rc = qmckl_check(context,
              qmckl_get_electron_coord (context, 'N', elec_coord2, walk_num*3*elec_num)
              );
assert(rc == QMCKL_SUCCESS);
for (int64_t i=0 ; i<3*elec_num ; ++i) {
assert( elec_coord[i] == elec_coord2[i] );
}


/* Provide Nucleus data */

assert(!qmckl_nucleus_provided(context));

rc = qmckl_check(context,
              qmckl_set_nucleus_num (context, nucl_num)
              );
assert(rc == QMCKL_SUCCESS);
assert(!qmckl_nucleus_provided(context));

double nucl_coord2[3*nucl_num];

rc = qmckl_get_nucleus_coord (context, 'T', nucl_coord2, 3*nucl_num);
assert(rc == QMCKL_NOT_PROVIDED);

rc = qmckl_check(context,
              qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0]), 3*nucl_num)
              );
assert(rc == QMCKL_SUCCESS);

assert(!qmckl_nucleus_provided(context));

rc = qmckl_check(context,
              qmckl_get_nucleus_coord (context, 'N', nucl_coord2, nucl_num*3)
              );
assert(rc == QMCKL_SUCCESS);
for (int64_t k=0 ; k<3 ; ++k) {
for (int64_t i=0 ; i<nucl_num ; ++i) {
 assert( nucl_coord[nucl_num*k+i] == nucl_coord2[3*i+k] );
}
}

rc = qmckl_check(context,
              qmckl_get_nucleus_coord (context, 'T', nucl_coord2, nucl_num*3)
              );
assert(rc == QMCKL_SUCCESS);
for (int64_t i=0 ; i<3*nucl_num ; ++i) {
assert( nucl_coord[i] == nucl_coord2[i] );
}

double nucl_charge2[nucl_num];

rc = qmckl_get_nucleus_charge(context, nucl_charge2, nucl_num);
assert(rc == QMCKL_NOT_PROVIDED);

rc = qmckl_check(context,
              qmckl_set_nucleus_charge(context, nucl_charge, nucl_num)
              );
assert(rc == QMCKL_SUCCESS);

rc = qmckl_check(context,
              qmckl_get_nucleus_charge(context, nucl_charge2, nucl_num)
              );
assert(rc == QMCKL_SUCCESS);
for (int64_t i=0 ; i<nucl_num ; ++i) {
assert( nucl_charge[i] == nucl_charge2[i] );
}
assert(qmckl_nucleus_provided(context));

assert(qmckl_electron_provided(context));

int64_t type_nucl_num = n2_type_nucl_num;
int64_t* type_nucl_vector = &(n2_type_nucl_vector[0]);
int64_t aord_num = n2_aord_num;
int64_t bord_num = n2_bord_num;
int64_t cord_num = n2_cord_num;
double* a_vector = &(n2_a_vector[0][0]);
double* b_vector = &(n2_b_vector[0]);
double* c_vector = &(n2_c_vector[0][0]);
int64_t dim_c_vector=0;

assert(!qmckl_jastrow_champ_provided(context));

/* Set the data */
rc = qmckl_check(context,
              qmckl_set_jastrow_champ_spin_independent(context, 0)
              );

rc = qmckl_check(context,
              qmckl_set_jastrow_champ_aord_num(context, aord_num)
              );
rc = qmckl_check(context,
              qmckl_set_jastrow_champ_bord_num(context, bord_num)
              );
rc = qmckl_check(context,
              qmckl_set_jastrow_champ_cord_num(context, cord_num)
              );
assert(rc == QMCKL_SUCCESS);
rc = qmckl_check(context,
              qmckl_set_jastrow_champ_type_nucl_num(context, type_nucl_num)
              );
assert(rc == QMCKL_SUCCESS);
rc = qmckl_check(context,
              qmckl_set_jastrow_champ_type_nucl_vector(context, type_nucl_vector, nucl_num)
              );
assert(rc == QMCKL_SUCCESS);
rc = qmckl_check(context,
              qmckl_set_jastrow_champ_a_vector(context, a_vector,(aord_num+1)*type_nucl_num)
              );
assert(rc == QMCKL_SUCCESS);
rc = qmckl_check(context,
              qmckl_set_jastrow_champ_b_vector(context, b_vector,(bord_num+1))
              );
assert(rc == QMCKL_SUCCESS);
rc = qmckl_check(context,
              qmckl_get_jastrow_champ_dim_c_vector(context, &dim_c_vector)
              );
assert(rc == QMCKL_SUCCESS);
rc = qmckl_check(context,
              qmckl_set_jastrow_champ_c_vector(context, c_vector, dim_c_vector*type_nucl_num)
              );
assert(rc == QMCKL_SUCCESS);

double k_ee = 0.;
double k_en[2] = { 0., 0. };
rc = qmckl_check(context,
              qmckl_set_jastrow_champ_rescale_factor_en(context, rescale_factor_en, type_nucl_num)
              );
assert(rc == QMCKL_SUCCESS);

rc = qmckl_check(context,
              qmckl_set_jastrow_champ_rescale_factor_ee(context, rescale_factor_ee)
              );
assert(rc == QMCKL_SUCCESS);

rc = qmckl_check(context,
              qmckl_get_jastrow_champ_rescale_factor_ee (context, &k_ee)
              );
assert(rc == QMCKL_SUCCESS);
assert(k_ee == rescale_factor_ee);

rc = qmckl_check(context,
              qmckl_get_jastrow_champ_rescale_factor_en (context, &(k_en[0]), type_nucl_num)
              );
assert(rc == QMCKL_SUCCESS);
for (int i=0 ; i<type_nucl_num ; ++i) {
assert(k_en[i] == rescale_factor_en[i]);
}

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double new_coords[3] = {1.0,2.0,3.0};

double coords[walk_num][elec_num][3];

Single point

Set

We set the coordinates of the num-th electron for all walkers. The dimension of coord is

  • [walk_num][3] if transp is 'N'
  • [3][walk_num] if transp is 'T'
qmckl_exit_code qmckl_set_single_point (qmckl_context context,
                              const char transp,
                              const int64_t num,
                              const double* coord,
                              const int64_t size_max);

The Fortran function shifts the num by 1 because of 1-based indexing.

qmckl_exit_code qmckl_set_single_point_f (qmckl_context context,
                              const char transp,
                              const int64_t num,
                              const double* coord,
                              const int64_t size_max);
qmckl_exit_code
qmckl_set_single_point (qmckl_context context,
              const char transp,
              const int64_t num,
              const double* coord,
              const int64_t size_max)
{

if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
 return QMCKL_NULL_CONTEXT;
}

if (num < 0) {
   return qmckl_failwith( context,
                          QMCKL_INVALID_ARG_3,
                          "qmckl_set_single_point",
                          "Incorrect point number");
}

if (transp != 'N' && transp != 'T') {
 return qmckl_failwith( context,
                        QMCKL_INVALID_ARG_2,
                        "qmckl_set_single_point",
                        "transp should be 'N' or 'T'");
}

if (coord == NULL) {
 return qmckl_failwith( context,
                        QMCKL_INVALID_ARG_3,
                        "qmckl_set_single_point",
                        "coord is a NULL pointer");
}

qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);

int64_t walk_num = ctx->electron.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);
}

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;
 for (int64_t i=0 ; i<3*walk_num ; ++i) {
   a[i] = coord[i];
 }
} else {
 for (int64_t i=0 ; i<walk_num ; ++i) {
   qmckl_mat(ctx->single_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 single point */
ctx->single_point.date += 1UL;

return QMCKL_SUCCESS;

}

qmckl_exit_code
qmckl_set_single_point_f (qmckl_context context,
              const char transp,
              const int64_t num,
              const double* coord,
              const int64_t size_max)
{
return qmckl_set_single_point(context, transp, num-1, coord, size_max);
}
interface
integer(qmckl_exit_code) function qmckl_set_single_point(context, &
    transp, num, coord, size_max) bind(C, name="qmckl_set_single_point_f")
 use, intrinsic :: iso_c_binding
 import
 implicit none

 integer (c_int64_t) , intent(in)  , value :: context
 character(c_char)   , intent(in)  , value :: transp
 integer (c_int64_t) , intent(in)  , value :: num
 real    (c_double ) , intent(in)          :: coord(*)
 integer (c_int64_t) , intent(in)  , value :: size_max
end function
end interface

Electron-electron distances single point

Get

qmckl_exit_code qmckl_get_single_electron_ee_distance(qmckl_context context, double* const distance);

Compute

Variable Type In/Out Description
context qmckl_context in Global state
num int64_t in Number of electrons
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[walk_num][3] in Single electron coordinates
single_ee_distance double[walk_num][elec_num] out Electron-electron distances
integer(qmckl_exit_code) function qmckl_compute_single_ee_distance(context, &
 num_in, 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 (c_int64_t) , intent(in)  , value :: elec_num, num_in
integer (c_int64_t) , intent(in)  , value :: walk_num
real    (c_double ) , intent(in)          :: coord(elec_num,walk_num,3)
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, num
double precision :: x, y, z

info = QMCKL_SUCCESS

num = num_in + 1

if (context == QMCKL_NULL_CONTEXT) then
 info = QMCKL_INVALID_CONTEXT
 return
endif

if (elec_num <= 0) then
 info = QMCKL_INVALID_ARG_2
 return
endif

if (walk_num <= 0) then
 info = QMCKL_INVALID_ARG_3
 return
endif

do k=1,walk_num
 info = qmckl_distance(context, 'N', 'T', 1_8, elec_num, &
      single_coord(1,k), 3_8, &
      coord(1,k,1), elec_num, &
      single_ee_distance(1,k), 1_8)
 if (info /= QMCKL_SUCCESS) then
    exit
 endif
 single_ee_distance(num,k) = 0.0d0
end do



end function qmckl_compute_single_ee_distance

test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double ee_distance[walk_num][elec_num][elec_num];
double single_ee_distance[walk_num][elec_num];

for (int elec = 0; elec < elec_num; elec++){


rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);


rc = qmckl_get_electron_ee_distance(context, &ee_distance[0][0][0]);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_single_electron_ee_distance(context, &single_ee_distance[0][0]);
assert (rc == QMCKL_SUCCESS);

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_ee_distance(context, &ee_distance[0][0][0]);
assert (rc == QMCKL_SUCCESS);

for (int nw = 0; nw < walk_num; nw++){
for (int i = 0; i < elec_num; i++) {
if (i == elec) continue;
assert(fabs((ee_distance[nw][elec][i]-single_ee_distance[nw][i])) < 1.e-12);
assert(fabs((ee_distance[nw][i][elec]-single_ee_distance[nw][i])) < 1.e-12);
}
}
}

ee distance rescaled single point

Get

qmckl_exit_code
qmckl_get_een_rescaled_single_e(qmckl_context context,
                            double* const distance_rescaled,
                            const int64_t size_max);

Compute

Variable Type In/Out Description
context qmckl_context in Global state
num int64_t in Number of walkers
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
single_ee_distance double[walk_num][elec_num] in Single electron-electron distances for each walker
een_rescaled_e double[walk_num][0:cord_num][elec_num][elec_num] in Rescaled electron-electron distances for each walker
een_rescaled_single_e double[walk_num][0:cord_num][elec_num] out Single electron-electron rescaled distances for each walker
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) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
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

num = num_in + 1
info = QMCKL_SUCCESS

if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif

if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_2
return
endif

if (elec_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif

if (cord_num < 0) then
info = QMCKL_INVALID_ARG_4
return
endif

allocate(een_rescaled_single_e_ij(elec_num, cord_num + 1))

! Prepare table of exponentiated distances raised to appropriate power
do nw = 1, walk_num
een_rescaled_single_e_ij(:, 1) = 1.0d0


do j = 1, elec_num
   een_rescaled_single_e_ij(j, 2) = dexp(-rescale_factor_ee * single_ee_distance(j, nw))
end do


do l = 2, cord_num
   do k = 1, elec_num
      een_rescaled_single_e_ij(k, l + 1) = een_rescaled_single_e_ij(k, l) * een_rescaled_single_e_ij(k, 2)
   end do
end do

! prepare the actual een table
een_rescaled_single_e(:,0,nw) = 1.0d0

do l = 1, cord_num
   do j = 1, elec_num
       x = een_rescaled_single_e_ij(j, l + 1)
       een_rescaled_single_e(j, l, nw) = x
   end do
end do

!een_rescaled_single_e(:,:,:) = een_rescaled_single_e(:,:,:) - een_rescaled_e(num,:,:,:)
een_rescaled_single_e(num, :, :) = 0.0d0

end do

end function qmckl_compute_een_rescaled_single_e_doc
qmckl_exit_code qmckl_compute_een_rescaled_single_e_doc (
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
#else
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);
}

test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double rescaled_een_ee_distance[walk_num][cord_num+1][elec_num][elec_num];
double single_rescaled_een_ee_distance[walk_num][cord_num+1][elec_num];

for (int elec = 0; elec < elec_num; elec++){

rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_een_rescaled_e(context,  &rescaled_een_ee_distance[0][0][0][0], walk_num*(cord_num+1)*elec_num*elec_num);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);


rc = qmckl_get_een_rescaled_single_e(context, &single_rescaled_een_ee_distance[0][0][0], walk_num*(cord_num+1)*elec_num);
assert (rc == QMCKL_SUCCESS);

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_een_rescaled_e(context,  &rescaled_een_ee_distance[0][0][0][0], walk_num*(cord_num+1)*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);

for (int nw = 0; nw < walk_num; nw++){
for (int l = 0; l <= cord_num; l++){
for (int i = 0; i < elec_num; i++) {
  if (i == elec) continue;
  assert(fabs((rescaled_een_ee_distance[nw][l][elec][i]-single_rescaled_een_ee_distance[nw][l][i])) < 1.e-12);
  assert(fabs((rescaled_een_ee_distance[nw][l][i][elec]-single_rescaled_een_ee_distance[nw][l][i])) < 1.e-12);
}
}
}

}

Electron-nucleus distances single point

Get

Electron-nucleus distance between the single electron and all nuclei for all walkers. Dimension is [walk_num][nucl_num].

qmckl_exit_code qmckl_get_single_electron_en_distance(qmckl_context context, double* distance);

Compute

Variable Type In/Out Description
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
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 (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

info = QMCKL_SUCCESS

if (context == QMCKL_NULL_CONTEXT) then
 info = QMCKL_INVALID_CONTEXT
 return
endif

if (nucl_num <= 0) then
 info = QMCKL_INVALID_ARG_2
 return
endif

info = qmckl_distance(context, 'T', 'T', nucl_num, 1_8, &
      nucl_coord, nucl_num, &
      elec_coord, walk_num, &
      single_en_distance, nucl_num)

end function qmckl_compute_single_en_distance

test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double en_distance[elec_num][nucl_num];
double single_en_distance[nucl_num];

for (int elec = 0; elec < elec_num; elec++){

rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_en_distance(context,  &en_distance[0][0]);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_single_electron_en_distance(context, &single_en_distance[0]);
assert (rc == QMCKL_SUCCESS);

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_en_distance(context, &en_distance[0][0]);
assert (rc == QMCKL_SUCCESS);

for (int a = 0; a < nucl_num; a++){
  assert(fabs((en_distance[elec][a]-single_en_distance[a])) < 1.e-12);
}
}

en distance rescaled single point

Get

qmckl_exit_code
qmckl_get_een_rescaled_single_n(qmckl_context context,
                            double* const distance_rescaled,
                            const int64_t size_max);

Compute

Variable Type In/Out Description
context qmckl_context in Global state
num int64_t in Number of single electron
walk_num int64_t in Number of walkers
elec_num int64_t in Number of atoms
nucl_num int64_t in Number of atoms
type_nucl_num int64_t in Number of atom types
type_nucl_vector int64_t[nucl_num] in Types of atoms
cord_num int64_t in Order of polynomials
rescale_factor_en double[nucl_num] in Factor to rescale ee distances
single_en_distance double[walk_num][nucl_num] in Electron-nucleus distances
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] out Single electron-nucleus rescaled distances
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) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
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  :: 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

num = num_in + 1

info = QMCKL_SUCCESS

if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif

if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_2
return
endif

if (nucl_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif

if (cord_num < 0) then
info = QMCKL_INVALID_ARG_4
return
endif

do nw = 1, walk_num

! prepare the actual een table
een_rescaled_single_n(:, 0, nw) = 1.0d0

do a = 1, nucl_num
   een_rescaled_single_n(a, 1, nw) = dexp(-rescale_factor_en(type_nucl_vector(a)+1) * single_en_distance(a, nw))
end do

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)
   end do
end do

!een_rescaled_single_n(:,:,:) = een_rescaled_single_n(:,:,:) - een_rescaled_n(num,:,:,:)

end do

end function qmckl_compute_een_rescaled_single_n

test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double rescaled_een_en_distance[walk_num][cord_num+1][nucl_num][elec_num];
double single_rescaled_een_en_distance[walk_num][cord_num+1][nucl_num];

for (int elec = 0; elec < elec_num; elec++){

rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_een_rescaled_n(context,  &rescaled_een_en_distance[0][0][0][0], walk_num*(cord_num+1)*nucl_num*elec_num);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);


rc = qmckl_get_een_rescaled_single_n(context, &single_rescaled_een_en_distance[0][0][0], walk_num*(cord_num+1)*nucl_num);
assert (rc == QMCKL_SUCCESS);

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_een_rescaled_n(context,  &rescaled_een_en_distance[0][0][0][0], walk_num*(cord_num+1)*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);

for (int nw = 0; nw < walk_num; nw++){
for (int l = 0; l <= cord_num; l++){
for (int a = 0; a < nucl_num; a++) {
  assert(fabs((rescaled_een_en_distance[nw][l][a][elec]-single_rescaled_een_en_distance[nw][l][a])) < 1.e-12);
}
}
}
}

Delta p

Get

qmckl_exit_code
qmckl_get_jastrow_champ_delta_p(qmckl_context context,
                            double* const delta_p,
                            const int64_t size_max);

provide

Compute

Variable Type In/Out Description
context qmckl_context in Global state
num int64_t in Single point number
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
een_rescaled_n double[walk_num][0:cord_num][nucl_num][elec_num] in Electron-nucleus rescaled distances
een_rescaled_e double[walk_num][0:cord_num][elec_num][elec_num] in Electron-electron rescaled distances
een_rescaled_single_n double[walk_num][0:cord_num][nucl_num] in Electron-nucleus single rescaled distances
een_rescaled_single_e double[walk_num][0:cord_num][elec_num] in Electron-electron single rescaled distances
delta_p double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num] out Electron-nucleus jastrow
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) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in)  :: context
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)

integer*8 :: i, a, c, j, l, k, p, m, n, nw, num
double precision :: dn, dn2
integer*8                           :: LDA, LDB, LDC

num = num_in + 1  

info = QMCKL_SUCCESS

if (context == QMCKL_NULL_CONTEXT) info = QMCKL_INVALID_CONTEXT
if (walk_num <= 0)                 info = QMCKL_INVALID_ARG_3
if (elec_num <= 0)                 info = QMCKL_INVALID_ARG_4
if (nucl_num <= 0)                 info = QMCKL_INVALID_ARG_5
if (cord_num <  0)                 info = QMCKL_INVALID_ARG_6
if (info /= QMCKL_SUCCESS)         return

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)

   do c=0,cord_num
      do a=1,nucl_num
         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
         enddo
      end do
   end do

   info = qmckl_dgemm(context, 'T', 'N', 1_8, nucl_num * (cord_num+1_8), elec_num, 1.0d0,     &
        een_rescaled_delta_e,elec_num, &
        een_rescaled_n(1,1,0,nw),elec_num,     &
        1.0d0,                                 &
        delta_p(num,1,0,i,nw),elec_num)

enddo

end do

end function qmckl_compute_jastrow_champ_delta_p_doc

test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double p_old[walk_num][cord_num][cord_num+1][nucl_num][elec_num];
double delta_p[walk_num][cord_num][cord_num+1][nucl_num][elec_num];
double p_new[walk_num][cord_num][cord_num+1][nucl_num][elec_num];

for (int elec = 0; elec < elec_num; elec++){

rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_tmp_c(context,  &p_old[0][0][0][0][0]);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_delta_p(context, &delta_p[0][0][0][0][0], walk_num*cord_num*(cord_num+1)*nucl_num*elec_num);

assert (rc == QMCKL_SUCCESS);

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_tmp_c(context,  &p_new[0][0][0][0][0]);
assert (rc == QMCKL_SUCCESS);

for (int nw = 0; nw < walk_num; nw++){
for (int l = 0; l < cord_num; l++){
for (int m = 0; m <= cord_num; m++){
  for (int a = 0; a < nucl_num; a++) {
    for (int i = 0; i < elec_num; i++){
      assert(fabs(((p_new[nw][l][m][a][i]-p_old[nw][l][m][a][i])-delta_p[nw][l][m][a][i])) < 1.e-12);
    }
  }
}
}
}
}

Delta e-e-n

get

qmckl_exit_code
qmckl_get_jastrow_champ_single_een(qmckl_context context,
                            double* const delta_een,
                            const int64_t size_max);
interface
  integer(qmckl_exit_code) function qmckl_get_jastrow_champ_single_een (context, &
       delta_een, 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)               :: delta_een(size_max)
  end function
end interface

Compute

Variable Type In/Out Description
context qmckl_context in Global state
num int64_t in Single point number
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 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
een_rescaled_n double[walk_num][0:cord_num][nucl_num][elec_num] in Electron-nucleus rescaled distances
een_rescaled_e double[walk_num][0:cord_num][elec_num][elec_num] in Electron-electron rescaled distances
een_rescaled_single_n double[walk_num][0:cord_num][nucl_num] in Electron-nucleus single rescaled distances
een_rescaled_single_e double[walk_num][0:cord_num][elec_num] in Electron-electron single rescaled distances
delta_een double[walk_num] out Electron-nucleus jastrow
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) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in)  :: context
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)

double precision        :: een_rescaled_delta_n(nucl_num, 0:cord_num)

integer*8 :: i, a, j, l, k, p, m, n, nw, num
double precision :: accu, accu2, cn
integer*8                           :: LDA, LDB, LDC

num = num_in + 1

info = QMCKL_SUCCESS

if (context == QMCKL_NULL_CONTEXT) info = QMCKL_INVALID_CONTEXT
if (walk_num <= 0)                 info = QMCKL_INVALID_ARG_3
if (elec_num <= 0)                 info = QMCKL_INVALID_ARG_4
if (nucl_num <= 0)                 info = QMCKL_INVALID_ARG_5
if (cord_num <  0)                 info = QMCKL_INVALID_ARG_6
if (info /= QMCKL_SUCCESS)         return

delta_een = 0.0d0

if (cord_num == 0) return

do nw =1, walk_num
een_rescaled_delta_n(:,:) = een_rescaled_single_n(:,:,nw) - een_rescaled_n(num,:,:,nw)
do n = 1, dim_c_vector
   l = lkpm_combined_index(n, 1)
   k = lkpm_combined_index(n, 2)
   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

      accu = 0.0d0
      do j = 1, elec_num
         accu = accu + een_rescaled_n(j,a,m,nw) * delta_p(j,a,m+l,k,nw) 
      end do
      accu = accu + een_rescaled_delta_n(a,m) * (tmp_c(num,a,m+l,k,nw) + delta_p(num,a,m+l,k,nw))
      delta_een(nw) = delta_een(nw) + accu * cn
   end do
end do
end do

end function qmckl_compute_jastrow_champ_factor_single_een_doc

test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double jastrow_een_old[walk_num];
double delta_een[walk_num];
double jastrow_een_new[walk_num];

for (int elec = 0; elec < elec_num; elec++){

qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);


rc = qmckl_get_jastrow_champ_factor_een(context, &jastrow_een_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_single_een(context, &delta_een[0], walk_num);
assert (rc == QMCKL_SUCCESS);

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_een(context, &jastrow_een_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);


for (int i = 0; i < walk_num; i++) {
assert(fabs((jastrow_een_new[i]-jastrow_een_old[i])-delta_een[i]) < 1.e-12);
}

}

ee distance rescaled single point

Get

qmckl_exit_code
qmckl_get_ee_rescaled_single(qmckl_context context,
                            double* const distance_rescaled,
                            const int64_t size_max);

Compute

Variable Type In/Out Description
context qmckl_context in Global state
elec_num int64_t in Number of electrons
rescale_factor_ee double in Factor to rescale ee distances
walk_num int64_t in Number of walkers
single_ee_distance double[walk_num][elec_num] in Electron coordinates
ee_rescaled_single double[walk_num][elec_num] out Electron-electron rescaled distances
function qmckl_compute_ee_rescaled_single_doc(context, &
elec_num, rescale_factor_ee, walk_num, &
single_ee_distance, ee_rescaled_single) &
bind(C) result(info)
use qmckl
implicit none

integer(qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in)  , value :: elec_num
real    (c_double ) , intent(in)  , value :: rescale_factor_ee
integer (c_int64_t) , intent(in)  , value :: walk_num
real    (c_double ) , intent(in)          :: single_ee_distance(elec_num,walk_num)
real    (c_double ) , intent(out)         :: ee_rescaled_single(elec_num,walk_num)
integer(qmckl_exit_code)                  :: info

integer*8 :: k, i
real (c_double) :: inverse_rescale_factor_ee

inverse_rescale_factor_ee = 1.0d0 / rescale_factor_ee

info = QMCKL_SUCCESS

if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif

if (elec_num <= 0) then
info = QMCKL_INVALID_ARG_2
return
endif

if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif

do k=1,walk_num
 do i=1,elec_num
ee_rescaled_single(i,k) = (1.0d0 - dexp(-rescale_factor_ee * single_ee_distance(i,k))) * inverse_rescale_factor_ee
enddo
end do

end function qmckl_compute_ee_rescaled_single_doc

test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double ee_rescaled[walk_num][elec_num][elec_num];
double single_ee_rescaled[walk_num][elec_num];

for (int elec = 0; elec < elec_num; elec++){

rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_ee_distance_rescaled(context, &ee_rescaled[0][0][0]);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_ee_rescaled_single(context, &single_ee_rescaled[0][0], walk_num*elec_num);
assert (rc == QMCKL_SUCCESS);

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_ee_distance_rescaled(context, &ee_rescaled[0][0][0]);
assert (rc == QMCKL_SUCCESS);


for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++){
//printf("nw %d i %d %f %f\n", nw, i, ee_rescaled[nw][2][i], single_ee_rescaled[nw][i]);
assert(fabs(ee_rescaled[nw][elec][i]-single_ee_rescaled[nw][i]) < 1.e-12);
assert(fabs(ee_rescaled[nw][i][elec]-single_ee_rescaled[nw][i]) < 1.e-12);
}
}
}

en distance rescaled single point

Get

qmckl_exit_code
qmckl_get_en_rescaled_single(qmckl_context context,
                            double* const distance_rescaled,
                            const int64_t size_max);

Compute

Variable Type In/Out Description
context qmckl_context in Global state
elec_num int64_t in Number of electrons
nucl_num int64_t in Number of nuclei
type_nucl_num int64_t in Number of types of nuclei
type_nucl_vector int64_t[nucl_num] in Number of types of nuclei
rescale_factor_en double[type_nucl_num] in The factor for rescaled distances
walk_num int64_t in Number of walkers
single_en_distance double[walk_num][nucl_num] in Electron coordinates
en_rescaled_single double[walk_num][nucl_num] out Electron-electron rescaled distances
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) &
bind(C) result(info)
use qmckl
implicit none
integer (qmckl_context), intent(in), value :: context
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(type_nucl_num)
integer (c_int64_t) , intent(in)  , value  :: walk_num
real    (c_double ) , intent(in)           :: single_en_distance(nucl_num,walk_num)
real    (c_double ) , intent(out)          :: en_rescaled_single(nucl_num,walk_num)
integer(qmckl_exit_code)                   :: info

integer*8 :: i, k
double precision      :: coord(3)

info = QMCKL_SUCCESS

if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif


if (nucl_num <= 0) then
info = QMCKL_INVALID_ARG_2
return
endif

if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_4
return
endif

do i=1, nucl_num
do k=1,walk_num
   en_rescaled_single(i,k) = (1.0d0 - dexp(-rescale_factor_en(type_nucl_vector(i)+1) * &
        single_en_distance(i,k))) / rescale_factor_en(type_nucl_vector(i)+1)
end do
end do

end function qmckl_compute_en_rescaled_single_doc

test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double en_rescaled[walk_num][nucl_num][elec_num];
double single_en_rescaled[walk_num][nucl_num];

for (int elec = 0; elec < elec_num; elec++){

rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_en_distance_rescaled(context, &en_rescaled[0][0][0]);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_en_rescaled_single(context, &single_en_rescaled[0][0], walk_num*nucl_num);
assert (rc == QMCKL_SUCCESS);

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_en_distance_rescaled(context, &en_rescaled[0][0][0]);
assert (rc == QMCKL_SUCCESS);


for (int nw = 0; nw < walk_num; nw++) {
for (int a = 0; a < nucl_num; a++){
assert(fabs(en_rescaled[nw][a][elec]-single_en_rescaled[nw][a]) < 1.e-12);
}
}
}

Delta ee

Get

qmckl_exit_code
qmckl_get_jastrow_champ_single_ee(qmckl_context context,
                       double* const delta_ee,
                       const int64_t size_max);
interface
  integer(qmckl_exit_code) function qmckl_get_jastrow_champ_single_ee (context, &
       delta_ee, 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)               :: delta_ee(size_max)
  end function qmckl_get_jastrow_champ_single_ee
end interface

Compute

Variable Type In/Out Description
context qmckl_context in Global state
num int64_t in Number of walkers
walk_num int64_t in Number of walkers
elec_num int64_t in Number of electrons
up_num int64_t in Number of alpha electrons
bord_num int64_t in Number of coefficients
b_vector double[bord_num+1] in List of coefficients
ee_distance_rescaled double[walk_num][elec_num][elec_num] in Electron-electron distances
ee_rescaled_single double[walk_num][][elec_num] in Electron-electron distances
delta_ee double[walk_num] out $f_{ee}$
function qmckl_compute_jastrow_champ_single_ee_doc(context, &
num_in, walk_num, elec_num, up_num, bord_num, b_vector, &
ee_distance_rescaled, ee_rescaled_single, spin_independent, delta_ee) &
bind(C) result(info)
use qmckl
implicit none

integer (qmckl_context), intent(in), value :: 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 :: up_num
integer (c_int64_t)    , intent(in), value :: bord_num
real    (c_double )    , intent(in)        :: b_vector(bord_num+1)
real    (c_double )    , intent(in)        :: ee_distance_rescaled(elec_num,elec_num,walk_num)
real    (c_double )    , intent(in)        :: ee_rescaled_single(elec_num,walk_num)
integer (c_int32_t)    , intent(in), value :: spin_independent
real    (c_double )    , intent(out)       :: delta_ee(walk_num)
integer(qmckl_exit_code)                   :: info

integer*8 :: i, j, k, nw, num
double precision   :: x, xk, y, yk

num = num_in + 1

info = QMCKL_SUCCESS

if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif

if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif

if (elec_num <= 0) then
info = QMCKL_INVALID_ARG_4
return
endif

if (bord_num < 0) then
info = QMCKL_INVALID_ARG_5
return
endif

do nw =1, walk_num

delta_ee(nw) = 0.0d0
do i=1,elec_num
    !print *,i, ee_rescaled_single(i,nw)
    !print *, i, ee_distance_rescaled(i,num,nw)
    !print *, '   '
   if (i.ne.num) then
      x = ee_distance_rescaled(i,num,nw)
      y = ee_rescaled_single(i,nw)
      if (spin_independent == 1) then
         delta_ee(nw) = delta_ee(nw) - (b_vector(1) * x / (1.d0 + b_vector(2) * x)) &
              + (b_vector(1) * y / (1.d0 + b_vector(2) * y))
      else
         if ((i <= up_num .and. num <= up_num ) .or. (i >  up_num .and. num >  up_num)) then
            delta_ee(nw) = delta_ee(nw) - (0.5d0 * b_vector(1) * x / (1.d0 + b_vector(2) * x)) &
                 + (0.5d0 * b_vector(1) * y / (1.d0 + b_vector(2) * y))
         else
            delta_ee(nw) = delta_ee(nw) - (b_vector(1) * x / (1.d0 + b_vector(2) * x)) &
                 + (b_vector(1) * y / (1.d0 + b_vector(2) * y))
         endif
      endif

      xk = x
      yk = y
      do k=2,bord_num
         xk = xk * x
         yk = yk * y
         delta_ee(nw) = delta_ee(nw) - (b_vector(k+1) * xk) + (b_vector(k+1) * yk)
      end do
   endif
end do

end do

end function qmckl_compute_jastrow_champ_single_ee_doc
qmckl_exit_code
qmckl_compute_jastrow_champ_single_ee (const qmckl_context context,
                                       const int64_t num,
                                      const int64_t walk_num,
                                      const int64_t elec_num,
                                      const int64_t up_num,
                                      const int64_t bord_num,
                                      const double* b_vector,
                                      const double* ee_distance_rescaled,
                                      const double* ee_rescaled_single,
                                      const int32_t spin_independent,
                                      double* const delta_ee )
{

#ifdef HAVE_HPC
 return qmckl_compute_jastrow_champ_single_ee_doc
#else
 return qmckl_compute_jastrow_champ_single_ee_doc
#endif
   (context, num, walk_num, elec_num, up_num, bord_num, b_vector,
    ee_distance_rescaled, ee_rescaled_single, spin_independent, delta_ee);
}

test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double jastrow_ee_old[walk_num];
double delta_ee[walk_num];
double jastrow_ee_new[walk_num];

for (int elec = 0; elec < elec_num; elec++){

rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);


rc = qmckl_get_jastrow_champ_factor_ee(context, &jastrow_ee_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);


rc = qmckl_get_jastrow_champ_single_ee(context, &delta_ee[0], walk_num);
assert (rc == QMCKL_SUCCESS);

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_ee(context, &jastrow_ee_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);

for (int nw = 0; nw < walk_num; nw++) {
//printf("%f %f %f %3.14f\n", jastrow_ee_new[nw], jastrow_ee_old[nw], delta_ee[nw], fabs((jastrow_ee_new[nw] - jastrow_ee_old[nw]) - delta_ee[nw]));
assert(fabs((jastrow_ee_new[nw] - jastrow_ee_old[nw]) - delta_ee[nw]) < 1.e-12);
}
}
  • Delta en

** Get

qmckl_exit_code
qmckl_get_jastrow_champ_single_en(qmckl_context context,
                       double* const delta_en,
                       const int64_t size_max);
interface
  integer(qmckl_exit_code) function qmckl_get_jastrow_champ_single_en (context, &
       delta_en, 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)               :: delta_en(size_max)
  end function qmckl_get_jastrow_champ_single_en
end interface

Compute

Variable Type In/Out Description
context qmckl_context in Global state
num int64_t in Number of single point
walk_num int64_t in Number of walkers
elec_num int64_t in Number of electrons
nucl_num int64_t in Number of nuclei
type_nucl_num int64_t in Number of unique nuclei
type_nucl_vector int64_t[nucl_num] in IDs of unique nuclei
aord_num int64_t in Number of coefficients
a_vector double[type_nucl_num][aord_num+1] in List of coefficients
en_distance_rescaled double[walk_num][nucl_num][elec_num] in Electron-nucleus distances
~en_rescaled_single ~ double[walk_num][nucl_num] in Electron-nucleus distances
delta_en double[walk_num] out Electron-nucleus jastrow
function qmckl_compute_jastrow_champ_single_en_doc( &
context, num_in, walk_num, elec_num, nucl_num, type_nucl_num, &
type_nucl_vector, aord_num, a_vector, &
en_distance_rescaled, en_rescaled_single, delta_en) &
bind(C) result(info)
use qmckl
implicit none

integer (qmckl_context), intent(in), value :: 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 :: nucl_num
integer (c_int64_t) , intent(in)  , value :: type_nucl_num
integer (c_int64_t) , intent(in)          :: type_nucl_vector(nucl_num)
integer (c_int64_t) , intent(in)  , value :: aord_num
real    (c_double ) , intent(in)          :: a_vector(aord_num+1,type_nucl_num)
real    (c_double ) , intent(in)          :: en_distance_rescaled(elec_num,nucl_num,walk_num)
real    (c_double ) , intent(in)          :: en_rescaled_single(nucl_num,walk_num)
real    (c_double ) , intent(out)         :: delta_en(walk_num)
integer(qmckl_exit_code)                  :: info

integer*8 :: i, a, p, nw, num
double precision   :: x, power_ser, y

num = num_in + 1

info = QMCKL_SUCCESS

if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif

if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_2
return
endif

if (elec_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif

if (nucl_num <= 0) then
info = QMCKL_INVALID_ARG_4
return
endif

if (type_nucl_num <= 0) then
info = QMCKL_INVALID_ARG_4
return
endif

if (aord_num < 0) then
info = QMCKL_INVALID_ARG_7
return
endif


do nw =1, walk_num
delta_en(nw) = 0.0d0
do a = 1, nucl_num
     x = en_distance_rescaled(num, a, nw)
     y = en_rescaled_single(a, nw)

     delta_en(nw) = delta_en(nw) - a_vector(1, type_nucl_vector(a)+1) * x / (1.0d0 + a_vector(2, type_nucl_vector(a)+1) * x) 
     delta_en(nw) = delta_en(nw) + a_vector(1, type_nucl_vector(a)+1) * y / (1.0d0 + a_vector(2, type_nucl_vector(a)+1) * y)

     do p = 2, aord_num
       x = x * en_distance_rescaled(num, a, nw)
       y = y * en_rescaled_single(a, nw)
       delta_en(nw) = delta_en(nw) - a_vector(p + 1, type_nucl_vector(a)+1) * x + a_vector(p + 1, type_nucl_vector(a)+1) * y
     end do

end do
end do

end function qmckl_compute_jastrow_champ_single_en_doc
qmckl_exit_code qmckl_compute_jastrow_champ_single_en (
     const qmckl_context context,
     const int64_t num,
     const int64_t walk_num,
     const int64_t elec_num,
     const int64_t nucl_num,
     const int64_t type_nucl_num,
     const int64_t* type_nucl_vector,
     const int64_t aord_num,
     const double* a_vector,
     const double* en_distance_rescaled,
     const double* en_rescaled_single,
     double* const delta_en );

qmckl_exit_code qmckl_compute_jastrow_champ_single_en_doc (
     const qmckl_context context,
     const int64_t num,
     const int64_t walk_num,
     const int64_t elec_num,
     const int64_t nucl_num,
     const int64_t type_nucl_num,
     const int64_t* type_nucl_vector,
     const int64_t aord_num,
     const double* a_vector,
     const double* en_distance_rescaled,
     const double* en_rescaled_single,
     double* const delta_en );
qmckl_exit_code qmckl_compute_jastrow_champ_single_en (
     const qmckl_context context,
     const int64_t num,
     const int64_t walk_num,
     const int64_t elec_num,
     const int64_t nucl_num,
     const int64_t type_nucl_num,
     const int64_t* type_nucl_vector,
     const int64_t aord_num,
     const double* a_vector,
     const double* en_distance_rescaled,
     const double* en_rescaled_single,
     double* const delta_en )
{
#ifdef HAVE_HPC
return qmckl_compute_jastrow_champ_single_en_doc
#else
return qmckl_compute_jastrow_champ_single_en_doc
#endif
(context, num, walk_num, elec_num, nucl_num, type_nucl_num,
 type_nucl_vector, aord_num, a_vector, en_distance_rescaled,
 en_rescaled_single, delta_en );
}

** test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double jastrow_en_old[walk_num];
double delta_en[walk_num];
double jastrow_en_new[walk_num];

for (int elec = 0; elec < elec_num; elec++){

rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_en(context, &jastrow_en_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_single_en(context, &delta_en[0], walk_num);
assert (rc == QMCKL_SUCCESS);

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_en(context, &jastrow_en_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);


for (int nw = 0; nw < walk_num; nw++) {
assert(fabs((jastrow_en_new[nw] - jastrow_en_old[nw]) - delta_en[nw]) < 1.e-12);
}
}

En rescaled derivative een

Get

qmckl_exit_code
qmckl_get_een_rescaled_single_n_gl(qmckl_context context,
                                    double* const distance_rescaled,
                                    const int64_t size_max);

Compute

Variable Type In/Out Description
context qmckl_context in Global state
walk_num int64_t in Number of walkers
nucl_num int64_t in Number of atoms
type_nucl_num int64_t in Number of atom types
type_nucl_vector int64_t[nucl_num] in Types of atoms
cord_num int64_t in Order of polynomials
rescale_factor_en double[nucl_num] in Factor to rescale ee distances
coord_ee double[walk_num][3] in Electron coordinates
coord_n double[3][nucl_num] in Nuclear coordinates
single_en_distance double[walk_num][nucl_num] in Electron-nucleus distances
een_rescaled_single_n double[walk_num][0:cord_num][nucl_num] in Electron-nucleus distances
een_rescaled_single_n_gl double[walk_num][0:cord_num][nucl_num][4] out Electron-nucleus rescaled distances
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) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
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))

info = QMCKL_SUCCESS

if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif

if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_2
return
endif


if (nucl_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif

if (cord_num < 0) then
info = QMCKL_INVALID_ARG_4
return
endif

! Prepare table of exponentiated distances raised to appropriate power
een_rescaled_single_n_gl             = 0.0d0
do nw = 1, walk_num

! prepare the actual een table
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,nw) - coord_n(a, ii)) * ria_inv
   end do
   elnuc_dist_gl(4, a) = 2.0d0 * ria_inv
end do

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) + 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)
   end do
end do
end do

end function qmckl_compute_een_rescaled_single_n_gl

test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double een_rescaled_en_gl[walk_num][cord_num+1][nucl_num][4][elec_num];
double een_rescaled_single_n_gl[walk_num][cord_num+1][nucl_num][4];

for (int elec = 0; elec < elec_num; elec++){

qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_een_rescaled_n_gl(context, &een_rescaled_en_gl[0][0][0][0][0], walk_num*(cord_num+1)*nucl_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_een_rescaled_single_n_gl(context, &een_rescaled_single_n_gl[0][0][0][0], walk_num*(cord_num+1)*nucl_num*4);
assert (rc == QMCKL_SUCCESS);

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_een_rescaled_n_gl(context, &een_rescaled_en_gl[0][0][0][0][0], walk_num*(cord_num+1)*nucl_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);

for (int l = 0; l < cord_num+1; l++) {
for (int nw = 0; nw < walk_num; nw++) {
for (int a = 0; a < nucl_num; a++) {
  for (int m = 0; m < 4; m++) {
    assert(fabs(een_rescaled_en_gl[nw][l][a][m][elec] - een_rescaled_single_n_gl[nw][l][a][m]) < 1.e-12);
  }
}
}
}
}

EE rescaled distance derivative for een

Get

qmckl_exit_code
qmckl_get_een_rescaled_single_e_gl(qmckl_context context,
                                    double* const distance_rescaled,
                                    const int64_t size_max);

Compute

Variable Type In/Out Description
context qmckl_context in Global state
num int64_t in Number of walkers
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 double[3] in Electron coordinates
coord_ee double[walk_num][3][elec_num] in Electron coordinates
single_ee_distance double[walk_num][elec_num] in Electron-electron distances
een_rescaled_single_e double[walk_num][0:cord_num][elec_num] in Electron-electron distances
een_rescaled_single_e_gl double[walk_num][0:cord_num][elec_num][4] out Electron-electron rescaled distances
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) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
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

allocate(elec_dist_gl(4, elec_num))

info = QMCKL_SUCCESS

if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif

if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif

if (elec_num <= 0) then
info = QMCKL_INVALID_ARG_4
return
endif

if (cord_num < 0) then
info = QMCKL_INVALID_ARG_5
return
endif

!   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
   rij_inv = 1.0d0 / single_ee_distance(i, nw)
   do ii = 1, 3
      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

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) + 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)

   end do
end do
end do



end function qmckl_compute_een_rescaled_single_e_gl_doc
qmckl_exit_code qmckl_compute_een_rescaled_single_e_gl (
        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* coord,
        const double* coord_ee,
        const double* single_ee_distance,
        const double* een_rescaled_single_e,
        double* const een_rescaled_single_e_gl )
{
#ifdef HAVE_HPC
 return qmckl_compute_een_rescaled_single_e_gl_doc
#else
 return qmckl_compute_een_rescaled_single_e_gl_doc
#endif
   (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 );
}

test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double een_rescaled_ee_gl[walk_num][cord_num+1][elec_num][4][elec_num];
double een_rescaled_single_e_gl[walk_num][cord_num+1][elec_num][4];

for (int elec = 0; elec < elec_num; elec++){

qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_een_rescaled_e_gl(context, &een_rescaled_ee_gl[0][0][0][0][0], walk_num*(cord_num+1)*elec_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_een_rescaled_single_e_gl(context, &een_rescaled_single_e_gl[0][0][0][0], walk_num*(cord_num+1)*elec_num*4);
assert (rc == QMCKL_SUCCESS);

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_een_rescaled_e_gl(context, &een_rescaled_ee_gl[0][0][0][0][0], walk_num*(cord_num+1)*elec_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);

double metric[4] = {-1.0, -1.0, -1.0, 1.0};

for (int l = 0; l < cord_num+1; l++) {
for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++) {
  for (int m = 0; m < 4; m++) {
    //printf("een_rescaled_ee_gl[nw][l][i][m][elec] %i %i %i %f \n", l, m ,i, een_rescaled_ee_gl[nw][l][i][m][elec]);
    //printf("een_rescaled_ee_gl[nw][l][elec][m][i] %i %i %i %f \n", l, m ,i, een_rescaled_ee_gl[nw][l][elec][m][i]);
    //printf("een_rescaled_single_e_gl[nw][l][i][m] %i %i %i %f\n", l, m, i,een_rescaled_single_e_gl[nw][l][i][m]);
    assert(fabs(een_rescaled_ee_gl[nw][l][i][m][elec] - een_rescaled_single_e_gl[nw][l][i][m]) < 1.e-12);
    assert(fabs(een_rescaled_ee_gl[nw][l][elec][m][i] - metric[m] * een_rescaled_single_e_gl[nw][l][i][m]) < 1.e-12);
  }
}
}
}
}

gl delta p

Get

qmckl_exit_code
qmckl_get_jastrow_champ_delta_p_gl(qmckl_context context,
                            double* const delta_p_gl,
                            const int64_t size_max);

provide

Compute

Variable Type In/Out Description
context qmckl_context in Global state
num int64_t in Single point number
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
een_rescaled_n double[walk_num][0:cord_num][nucl_num][elec_num] in Electron-nucleus rescaled distances
een_rescaled_e double[walk_num][0:cord_num][elec_num][elec_num] in Electron-electron rescaled distances
een_rescaled_single_n double[walk_num][0:cord_num][nucl_num] in Electron-nucleus single rescaled distances
een_rescaled_single_e double[walk_num][0:cord_num][elec_num] in Electron-electron single rescaled distances
een_rescaled_n_gl double[walk_num][0:cord_num][nucl_num][4][elec_num] in Electron-nucleus rescaled distances
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][4][nucl_num][elec_num] out Electron-nucleus jastrow
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) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in)  :: context
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(elec_num,4)
double precision        :: delta_e_gl_2(elec_num)
double precision        :: een_rescaled_e_gl_2(elec_num)

double precision        :: een_rescaled_delta_n, fk(4)

integer*8 :: i, a, j, l, k, p, m, n, nw, num
double precision :: tmp
integer*8        :: LDA, LDB, LDC

num = num_in + 1

info = QMCKL_SUCCESS

if (context == QMCKL_NULL_CONTEXT) info = QMCKL_INVALID_CONTEXT
if (walk_num <= 0)                 info = QMCKL_INVALID_ARG_3
if (elec_num <= 0)                 info = QMCKL_INVALID_ARG_4
if (nucl_num <= 0)                 info = QMCKL_INVALID_ARG_5
if (cord_num <  0)                 info = QMCKL_INVALID_ARG_6
if (info /= QMCKL_SUCCESS)         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

   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
               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

end function qmckl_compute_jastrow_champ_delta_p_gl_doc

test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double p_gl_old[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];
double p_gl_new[walk_num][cord_num][cord_num+1][nucl_num][4][elec_num];


for (int elec = 0; elec < elec_num; elec++){

rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_dtmp_c(context,  &p_gl_old[0][0][0][0][0][0]);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);

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);

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_dtmp_c(context,  &p_gl_new[0][0][0][0][0][0]);
assert (rc == QMCKL_SUCCESS);

for (int nw = 0; nw < walk_num; nw++){
for (int l = 0; l < cord_num; l++){
for (int m = 0; m <= cord_num; m++){
  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][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][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][k][a][i])) < 1.e-12);
      }
    }
  }
}
}
}
}

Delta grad e-e-n

get

qmckl_exit_code
qmckl_get_jastrow_champ_single_een_gl(qmckl_context context,
                            double* const delta_een_gl,
                            const int64_t size_max);
interface
  integer(qmckl_exit_code) function qmckl_get_jastrow_champ_single_een_gl (context, &
       delta_een_gl, size_max) bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (qmckl_context) , intent(in), value :: context
    integer(c_int64_t), intent(in), value       :: size_max
    real(c_double),   intent(out)               :: delta_een_gl(size_max)
  end function
end interface

Compute

Variable Type In/Out Description
context qmckl_context in Global state
num int64_t in Single point number
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 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][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
een_rescaled_single_n_gl double[walk_num][0:cord_num][nucl_num][4] in Electron-nucleus single rescaled distances
delta_een_gl double[walk_num][4][elec_num] out Electron-nucleus jastrow
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) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in)  :: context
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
integer*8                           :: LDA, LDB, LDC

double precision  :: een_rescaled_delta_n_gl(4, nucl_num, 0:cord_num, walk_num)
double precision  :: een_rescaled_delta_n(nucl_num, 0:cord_num, walk_num)

num = num_in + 1

info = QMCKL_SUCCESS

if (context == QMCKL_NULL_CONTEXT) info = QMCKL_INVALID_CONTEXT
if (walk_num <= 0)                 info = QMCKL_INVALID_ARG_3
if (elec_num <= 0)                 info = QMCKL_INVALID_ARG_4
if (nucl_num <= 0)                 info = QMCKL_INVALID_ARG_5
if (cord_num <  0)                 info = QMCKL_INVALID_ARG_6
if (info /= QMCKL_SUCCESS)         return

delta_een_gl = 0.0d0

if (cord_num == 0) return

een_rescaled_delta_n(:,:,:) = een_rescaled_single_n(:,:,:) - een_rescaled_n(num, :, :, :)
een_rescaled_delta_n_gl(:,:,:,:) = een_rescaled_single_n_gl(:,:,:,:) - een_rescaled_n_gl(num, :,:,:,:)


do nw =1, walk_num
do n = 1, dim_c_vector
   l = lkpm_combined_index(n, 1)
   k = lkpm_combined_index(n, 2)
   p = lkpm_combined_index(n, 3)
   m = lkpm_combined_index(n, 4)

   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
         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
      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(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(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

test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double een_gl_old[walk_num][4][elec_num];
double delta_een_gl[walk_num][4][elec_num];
double een_gl_new[walk_num][4][elec_num];


for (int elec = 0; elec < elec_num; elec++){

rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);

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);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);

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][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

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 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][m][i]) < 1.e-12);

}
}
}
}

ee distance rescaled single point gl

Get

qmckl_exit_code qmckl_get_ee_rescaled_single_gl(qmckl_context context, double* const distance_rescaled_gl);

Compute

Variable Type In/Out Description
context qmckl_context in Global state
num int64_t in Number of electrons
elec_num int64_t in Number of electrons
rescale_factor_ee double in Factor to rescale ee distances
walk_num int64_t in Number of walkers
single_ee_distance double[elec_num][walk_num] in Electron coordinates
elec_coord double[3][walk_num][elec_num] in Electron coordinates
coord double[3] in Electron coordinates
ee_rescaled_single_gl double[walk_num][elec_num][4] out Electron-electron rescaled distance derivatives
function qmckl_compute_ee_rescaled_single_gl_doc(context, num_in,  &
elec_num, rescale_factor_ee, walk_num, single_ee_distance, elec_coord, coord, ee_rescaled_single_gl) &
bind(C) result(info)
use qmckl
implicit none

integer(qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in)  , value :: num_in
integer (c_int64_t) , intent(in)  , value :: elec_num
real    (c_double ) , intent(in)  , value :: rescale_factor_ee
integer (c_int64_t) , intent(in)  , value :: walk_num
real    (c_double ) , intent(in)          :: single_ee_distance(elec_num,walk_num)
real    (c_double ) , intent(in)          :: elec_coord(elec_num,walk_num,3)
real    (c_double ) , intent(in)          :: coord(3)
real    (c_double ) , intent(out)         :: ee_rescaled_single_gl(4,elec_num,walk_num)
integer(qmckl_exit_code)                  :: info

integer*8 :: nw, i, ii, num
double precision :: rij_inv, elel_dist_gl(4, elec_num), kappa_l

num = num_in + 1

info = QMCKL_SUCCESS

if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif

if (elec_num <= 0) then
info = QMCKL_INVALID_ARG_2
return
endif

if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif


ee_rescaled_single_gl = 0.0d0
do nw = 1, walk_num

! prepare the actual een table
do i = 1, elec_num
   rij_inv = 1.0d0 / single_ee_distance(i, nw)
   do ii = 1, 3
     elel_dist_gl(ii, i) = (elec_coord(i,nw, ii) - coord(ii)) * rij_inv
   end do
   elel_dist_gl(4, i) = 2.0d0 * rij_inv
end do

 do i = 1, elec_num
   kappa_l = -1 * rescale_factor_ee
   ee_rescaled_single_gl(1, i, nw) = elel_dist_gl(1, i)
   ee_rescaled_single_gl(2, i, nw) = elel_dist_gl(2, i) 
   ee_rescaled_single_gl(3, i, nw) = elel_dist_gl(3, i)
   ee_rescaled_single_gl(4, i, nw) = elel_dist_gl(4, i) 

   ee_rescaled_single_gl(4, i, nw) = ee_rescaled_single_gl(4, i, nw) + kappa_l

   ee_rescaled_single_gl(1, i, nw) = ee_rescaled_single_gl(1, i, nw)  * dexp(kappa_l * single_ee_distance(i,nw)) 
   ee_rescaled_single_gl(2, i, nw) = ee_rescaled_single_gl(2, i, nw)  * dexp(kappa_l * single_ee_distance(i,nw))  
   ee_rescaled_single_gl(3, i, nw) = ee_rescaled_single_gl(3, i, nw)  * dexp(kappa_l * single_ee_distance(i,nw)) 
   ee_rescaled_single_gl(4, i, nw) = ee_rescaled_single_gl(4, i, nw)  * dexp(kappa_l * single_ee_distance(i,nw)) 
end do

ee_rescaled_single_gl(1, num, nw) = 0.0d0
ee_rescaled_single_gl(2, num, nw) = 0.0d0
ee_rescaled_single_gl(3, num, nw) = 0.0d0
ee_rescaled_single_gl(4, num, nw) = 0.0d0
end do


end function qmckl_compute_ee_rescaled_single_gl_doc

test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double ee_rescaled_gl[walk_num][elec_num][elec_num][4];
double single_ee_rescaled_gl[walk_num][elec_num][4];


for (int elec = 0; elec < elec_num; elec++){

rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_ee_distance_rescaled_gl(context, &ee_rescaled_gl[0][0][0][0]);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_ee_rescaled_single_gl(context, &single_ee_rescaled_gl[0][0][0]);
assert (rc == QMCKL_SUCCESS);

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_ee_distance_rescaled_gl(context, &ee_rescaled_gl[0][0][0][0]);
assert (rc == QMCKL_SUCCESS);

double metric[4] = {-1.0, -1.0, -1.0, 1.0};

for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++) {
for (int m = 0; m < 4; m++) {
  if (i == elec) continue;
  //printf("%f\n", ee_rescaled_gl[nw][elec][i][m]);
  //printf("%f\n", single_ee_rescaled_gl[nw][i][m]);
  assert(fabs(ee_rescaled_gl[nw][elec][i][m] - single_ee_rescaled_gl[nw][i][m]) < 1.e-12);
  assert(fabs(ee_rescaled_gl[nw][i][elec][m] - metric[m] * single_ee_rescaled_gl[nw][i][m]) < 1.e-12);

}
}
}
}

en distance rescaled single point gl

Get

qmckl_exit_code qmckl_get_en_rescaled_single_gl(qmckl_context context, double* distance_rescaled_gl);

Provide

Compute

Variable Type In/Out Description
context qmckl_context in Global state
nucl_num int64_t in Number of nuclei
type_nucl_num int64_t in Number of nucleus types
type_nucl_vector int64_t[nucl_num] in Array of nucleus types
rescale_factor_en double[nucl_num] in The factors for rescaled distances
walk_num int64_t in Number of walkers
single_en_distance double[walk_num][nucl_num] in Electron coordinates
coord double[3] in Electron coordinates
nucl_coord double[3][nucl_num] in Electron coordinates
en_rescaled_single_gl double[walk_num][nucl_num][4] out Electron-nucleus distance derivatives
integer function qmckl_compute_en_rescaled_single_gl_doc_f(context, nucl_num, &
type_nucl_num, type_nucl_vector, rescale_factor_en, walk_num, &
single_en_distance, coord, nucl_coord, en_rescaled_single_gl) &
result(info)
use qmckl
implicit none
integer(qmckl_context), intent(in)  :: context
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)  :: single_en_distance(nucl_num, walk_num)
double precision      , intent(in)  :: coord(3)
double precision      , intent(in)  :: nucl_coord(nucl_num,3)
double precision      , intent(out) :: en_rescaled_single_gl(4,nucl_num,walk_num)

integer*8 :: nw, a, ii
double precision :: ria_inv, elnuc_dist_gl(4, nucl_num), kappa_l

info = QMCKL_SUCCESS

if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif


if (nucl_num <= 0) then
info = QMCKL_INVALID_ARG_2
return
endif

if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_4
return
endif


en_rescaled_single_gl = 0.0d0
do nw = 1, walk_num

! prepare the actual een table
do a = 1, nucl_num
   ria_inv = 1.0d0 / single_en_distance(a, nw)
   do ii = 1, 3
     elnuc_dist_gl(ii, a) = (coord(ii) - nucl_coord(a, ii)) * ria_inv
   end do
   elnuc_dist_gl(4, a) = 2.0d0 * ria_inv
end do

 do a = 1, nucl_num
   kappa_l = -1 * rescale_factor_en(type_nucl_vector(a)+1)
   en_rescaled_single_gl(1, a, nw) = elnuc_dist_gl(1, a)
   en_rescaled_single_gl(2, a, nw) = elnuc_dist_gl(2, a)
   en_rescaled_single_gl(3, a, nw) = elnuc_dist_gl(3, a)
   en_rescaled_single_gl(4, a, nw) = elnuc_dist_gl(4, a)

   en_rescaled_single_gl(4, a, nw) = en_rescaled_single_gl(4, a, nw) + kappa_l

   en_rescaled_single_gl(1, a, nw) = en_rescaled_single_gl(1, a, nw)  * dexp(kappa_l * single_en_distance(a,nw)) 
   en_rescaled_single_gl(2, a, nw) = en_rescaled_single_gl(2, a, nw)  * dexp(kappa_l * single_en_distance(a,nw))  
   en_rescaled_single_gl(3, a, nw) = en_rescaled_single_gl(3, a, nw)  * dexp(kappa_l * single_en_distance(a,nw)) 
   en_rescaled_single_gl(4, a, nw) = en_rescaled_single_gl(4, a, nw)  * dexp(kappa_l * single_en_distance(a,nw)) 
end do

end do


end function qmckl_compute_en_rescaled_single_gl_doc_f

test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double en_rescaled_gl[walk_num][nucl_num][elec_num][4];
double single_en_rescaled_gl[walk_num][nucl_num][4];


for (int elec = 0; elec < elec_num; elec++){

rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_en_distance_rescaled_gl(context, &en_rescaled_gl[0][0][0][0]);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_en_rescaled_single_gl(context, &single_en_rescaled_gl[0][0][0]);
assert (rc == QMCKL_SUCCESS);

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_en_distance_rescaled_gl(context, &en_rescaled_gl[0][0][0][0]);
assert (rc == QMCKL_SUCCESS);

for (int nw = 0; nw < walk_num; nw++) {
for (int a = 0; a < nucl_num; a++) {
for (int m = 0; m < 4; m++) {
  assert(fabs(en_rescaled_gl[nw][a][elec][m] - single_en_rescaled_gl[nw][a][m]) < 1.e-12);

}
}
}
}

Delta ee gl

Get

qmckl_exit_code
qmckl_get_jastrow_champ_single_ee_gl(qmckl_context context,
                               double* const delta_ee_gl,
                               const int64_t size_max);
interface
  integer(qmckl_exit_code) function qmckl_get_jastrow_champ_single_ee_gl (context, &
       delta_ee_gl, size_max) bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (qmckl_context) , intent(in), value :: context
    integer(c_int64_t), intent(in), value       :: size_max
    real(c_double),   intent(out)               :: delta_ee_gl(size_max)
  end function qmckl_get_jastrow_champ_single_ee_gl
end interface

Compute

Variable Type In/Out Description
context qmckl_context in Global state
num int64_t in Number of walkers
walk_num int64_t in Number of walkers
elec_num int64_t in Number of electrons
up_num int64_t in Number of alpha electrons
bord_num int64_t in Number of coefficients
b_vector double[bord_num+1] in List of coefficients
ee_distance_rescaled double[walk_num][elec_num][elec_num] in Electron-electron distances
ee_distance_rescaled_gl double[walk_num][4][elec_num][elec_num] in Electron-electron distances
ee_rescaled_single double[walk_num][elec_num] in Electron-electron distances
ee_rescaled_single_gl double[walk_num][4][elec_num] in Electron-electron distances
spin_independent int32_t in If 1, same parameters for parallel and antiparallel spins
delta_ee_gl double[walk_num][elec_num][4] out Electron-electron distances
function qmckl_compute_jastrow_champ_single_ee_gl_doc( &
context, num_in, walk_num, elec_num, up_num, bord_num, &
b_vector, ee_distance_rescaled, ee_distance_rescaled_gl,  &
ee_rescaled_single, ee_rescaled_single_gl,  &
spin_independent, delta_ee_gl) &
bind(C) result(info)
use qmckl
implicit none

integer (qmckl_context), intent(in), value :: 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 :: up_num
integer (c_int64_t) , intent(in)  , value :: bord_num
real    (c_double ) , intent(in)          :: b_vector(bord_num+1)
real    (c_double ) , intent(in)          :: ee_distance_rescaled(elec_num,elec_num,walk_num)
real    (c_double ) , intent(in)          :: ee_distance_rescaled_gl(4,elec_num,elec_num,walk_num)
real    (c_double ) , intent(in)          :: ee_rescaled_single(elec_num,walk_num)
real    (c_double ) , intent(in)          :: ee_rescaled_single_gl(4,elec_num,walk_num)
integer (c_int32_t) , intent(in)  , value :: spin_independent
real    (c_double ) , intent(out)         :: delta_ee_gl(4,elec_num,walk_num)
integer(qmckl_exit_code)                  :: info

integer*8 :: i, j, k, nw, ii, num
double precision   :: x, x1, kf, x_old, x1_old
double precision   :: denom, invdenom, invdenom2, f
double precision   :: denom_old, invdenom_old, invdenom2_old, f_old
double precision   :: grad_c2, grad_c2_old
double precision   :: dx(4), dx_old(4)

num = num_in + 1

info = QMCKL_SUCCESS

if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif

if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif

if (elec_num <= 0) then
info = QMCKL_INVALID_ARG_4
return
endif

if (bord_num < 0) then
info = QMCKL_INVALID_ARG_5
return
endif

if ((spin_independent < 0).or.(spin_independent > 1)) then
info = QMCKL_INVALID_ARG_8
return
endif

do nw =1, walk_num
delta_ee_gl(:,:,nw) = 0.0d0
   do i = 1, elec_num
      if (i == num) cycle

      x = ee_rescaled_single(i,nw)
      x_old = ee_distance_rescaled(i,num,nw)

      denom         = 1.0d0 + b_vector(2) * x
      invdenom      = 1.0d0 / denom
      invdenom2     = invdenom * invdenom

      denom_old         = 1.0d0 + b_vector(2) * x_old
      invdenom_old      = 1.0d0 / denom_old
      invdenom2_old     = invdenom_old * invdenom_old

      dx(1) = ee_rescaled_single_gl(1, i, nw)
      dx(2) = ee_rescaled_single_gl(2, i, nw)
      dx(3) = ee_rescaled_single_gl(3, i, nw)
      dx(4) = ee_rescaled_single_gl(4, i, nw)

      dx_old(1) = ee_distance_rescaled_gl(1, i, num, nw)
      dx_old(2) = ee_distance_rescaled_gl(2, i, num, nw)
      dx_old(3) = ee_distance_rescaled_gl(3, i, num, nw)
      dx_old(4) = ee_distance_rescaled_gl(4, i, num, nw)

      grad_c2 = dx(1)*dx(1) + dx(2)*dx(2) + dx(3)*dx(3)
      grad_c2_old = dx_old(1)*dx_old(1) + dx_old(2)*dx_old(2) + dx_old(3)*dx_old(3)

      if (spin_independent == 1) then
         f = b_vector(1) * invdenom2
         f_old = b_vector(1) * invdenom2_old
      else
         if((i <= up_num .and. num <= up_num ) .or. (i >  up_num .and. num >  up_num)) then
            f = 0.5d0 * b_vector(1) * invdenom2
            f_old = 0.5d0 * b_vector(1) * invdenom2_old
         else
            f = b_vector(1) * invdenom2
            f_old = b_vector(1) * invdenom2_old
         end if
      end if

      delta_ee_gl(1,i,nw) = delta_ee_gl(1,i,nw) + f * dx(1) - f_old * dx_old(1)
      delta_ee_gl(2,i,nw) = delta_ee_gl(2,i,nw) + f * dx(2) - f_old * dx_old(2)
      delta_ee_gl(3,i,nw) = delta_ee_gl(3,i,nw) + f * dx(3) - f_old * dx_old(3)
      delta_ee_gl(4,i,nw) = delta_ee_gl(4,i,nw) &
           + f * (dx(4) - 2.d0 * b_vector(2) * grad_c2 * invdenom) &
           - f_old * (dx_old(4) - 2.d0 * b_vector(2) * grad_c2_old * invdenom_old)

      delta_ee_gl(1,num,nw) = delta_ee_gl(1,num,nw) - f * dx(1) + f_old * dx_old(1)
      delta_ee_gl(2,num,nw) = delta_ee_gl(2,num,nw) - f * dx(2) + f_old * dx_old(2)
      delta_ee_gl(3,num,nw) = delta_ee_gl(3,num,nw) - f * dx(3) + f_old * dx_old(3)
      delta_ee_gl(4,num,nw) = delta_ee_gl(4,num,nw) &
           + f * (dx(4) - 2.d0 * b_vector(2) * grad_c2 * invdenom) &
           - f_old * (dx_old(4) - 2.d0 * b_vector(2) * grad_c2_old * invdenom_old)


      kf = 2.d0
      x1 = x
      x1_old = x_old
      x = 1.d0
      x_old = 1.d0
      do k=2, bord_num
         f = b_vector(k+1) * kf * x
         f_old = b_vector(k+1) * kf * x_old
         delta_ee_gl(1,i,nw) = delta_ee_gl(1,i,nw) + f * x1 * dx(1) - f_old * x1_old * dx_old(1)
         delta_ee_gl(2,i,nw) = delta_ee_gl(2,i,nw) + f * x1 * dx(2) - f_old * x1_old * dx_old(2)
         delta_ee_gl(3,i,nw) = delta_ee_gl(3,i,nw) + f * x1 * dx(3) - f_old * x1_old * dx_old(3)
         delta_ee_gl(4,i,nw) = delta_ee_gl(4,i,nw) &
              + f * (x1 * dx(4) + (kf-1.d0) * grad_c2) &
              - f_old * (x1_old * dx_old(4) + (kf-1.d0) * grad_c2_old)

         delta_ee_gl(1,num,nw) = delta_ee_gl(1,num,nw) - f * x1 * dx(1) + f_old * x1_old * dx_old(1)
         delta_ee_gl(2,num,nw) = delta_ee_gl(2,num,nw) - f * x1 * dx(2) + f_old * x1_old * dx_old(2)
         delta_ee_gl(3,num,nw) = delta_ee_gl(3,num,nw) - f * x1 * dx(3) + f_old * x1_old * dx_old(3)
         delta_ee_gl(4,num,nw) = delta_ee_gl(4,num,nw) &
              + f * (x1 * dx(4) + (kf-1.d0) * grad_c2) &
              - f_old * (x1_old * dx_old(4) + (kf-1.d0) * grad_c2_old)
         x = x*x1
         x_old = x_old*x1_old
         kf = kf + 1.d0
      end do

   
   end do

end do

end function qmckl_compute_jastrow_champ_single_ee_gl_doc
qmckl_exit_code
qmckl_compute_jastrow_champ_single_ee_gl_doc (const qmckl_context context,
                                         const int64_t num,
                                         const int64_t walk_num,
                                         const int64_t elec_num,
                                         const int64_t up_num,
                                         const int64_t bord_num,
                                         const double* b_vector,
                                         const double* ee_distance_rescaled,
                                         const double* ee_distance_rescaled_gl,
                                         const double* ee_rescaled_single,
                                         const double* ee_rescaled_single_gl,
                                         const int32_t spin_independent,
                                         double* const delta_ee_gl );
qmckl_exit_code
qmckl_compute_jastrow_champ_single_ee_gl (const qmckl_context context,
                                     const int64_t num,
                                     const int64_t walk_num,
                                     const int64_t elec_num,
                                     const int64_t up_num,
                                     const int64_t bord_num,
                                     const double* b_vector,
                                     const double* ee_distance_rescaled,
                                     const double* ee_distance_rescaled_gl,
                                     const double* ee_rescaled_single,
                                     const double* ee_rescaled_single_gl,
                                     const int32_t spin_independent,
                                     double* const delta_ee_gl )
{
#ifdef HAVE_HPC
return qmckl_compute_jastrow_champ_single_ee_gl_doc
#else
return qmckl_compute_jastrow_champ_single_ee_gl_doc
#endif
(context, num, walk_num, elec_num, up_num, bord_num, b_vector,
ee_distance_rescaled, ee_distance_rescaled_gl, ee_rescaled_single, ee_rescaled_single_gl, spin_independent, delta_ee_gl );
}

test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double ee_gl_old[walk_num][4][elec_num];
double delta_ee_gl[walk_num][elec_num][4];
double ee_gl_new[walk_num][4][elec_num];

for (int elec = 0; elec < elec_num; elec++){

rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_ee_gl(context, &ee_gl_old[0][0][0], walk_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_single_ee_gl(context, &delta_ee_gl[0][0][0], walk_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_ee_gl(context, &ee_gl_new[0][0][0], walk_num*elec_num*4);
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++) {
  //printf("%f\n",(ee_gl_new[nw][m][i] - ee_gl_old[nw][m][i]));
  //printf("%f\n",delta_ee_gl[nw][i][m]);
  assert(fabs((ee_gl_new[nw][m][i] - ee_gl_old[nw][m][i]) - delta_ee_gl[nw][i][m]) < 1.e-12);

}
}
}
}

Delta en gl

Get

qmckl_exit_code
qmckl_get_jastrow_champ_single_en_gl(qmckl_context context,
                               double* const delta_en_gl,
                               const int64_t size_max);
interface
  integer(qmckl_exit_code) function qmckl_get_jastrow_champ_single_en_gl (context, &
       delta_en_gl, size_max) bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (qmckl_context) , intent(in), value :: context
    integer(c_int64_t), intent(in), value       :: size_max
    real(c_double),   intent(out)               :: delta_en_gl(size_max)
  end function qmckl_get_jastrow_champ_single_en_gl
end interface

Compute

Variable Type In/Out Description
context qmckl_context in Global state
wnum int64_t in Number of walkers
walk_num int64_t in Number of walkers
elec_num int64_t in Number of electrons
nucl_num int64_t in Number of nuclei
type_nucl_num int64_t in Number of unique nuclei
type_nucl_vector int64_t[nucl_num] in IDs of unique nuclei
aord_num int64_t in Number of coefficients
a_vector double[type_nucl_num][aord_num+1] in List of coefficients
en_distance_rescaled double[walk_num][nucl_num][elec_num] in Electron-nucleus distances
en_distance_rescaled_gl double[walk_num][nucl_num][elec_num][4] in Electron-nucleus distance derivatives
en_rescaled_single double[walk_num][nucl_num] in Electron-nucleus distances
en_rescaled_single_gl double[walk_num][nucl_num][4] in Electron-nucleus distance derivatives
delta_en_gl double[walk_num][elec_num][4] out Electron-nucleus jastrow
function qmckl_compute_jastrow_champ_single_en_gl_doc( &
context, num_in, walk_num, elec_num, nucl_num, type_nucl_num, &
type_nucl_vector, aord_num, a_vector, &
en_distance_rescaled, en_distance_rescaled_gl, en_rescaled_single, en_rescaled_single_gl, delta_en_gl) &
bind(C) result(info)
use qmckl
implicit none

integer (qmckl_context), intent(in), value :: 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 :: nucl_num
integer (c_int64_t) , intent(in)  , value :: type_nucl_num
integer (c_int64_t) , intent(in)          :: type_nucl_vector(nucl_num)
integer (c_int64_t) , intent(in)  , value :: aord_num
real    (c_double ) , intent(in)          :: a_vector(aord_num+1,type_nucl_num)
real    (c_double ) , intent(in)          :: en_distance_rescaled(elec_num,nucl_num,walk_num)
real    (c_double ) , intent(in)          :: en_distance_rescaled_gl(4, elec_num,nucl_num,walk_num)
real    (c_double ) , intent(in)          :: en_rescaled_single(nucl_num,walk_num)
real    (c_double ) , intent(in)          :: en_rescaled_single_gl(4, nucl_num,walk_num)
real    (c_double ) , intent(out)         :: delta_en_gl(4,elec_num,walk_num)
integer(qmckl_exit_code)                   :: info

integer*8 :: i, a, k, nw, ii, num
double precision   :: x, x1, kf, x_old, x1_old
double precision   :: denom, invdenom, invdenom2, f
double precision   :: denom_old, invdenom_old, invdenom2_old, f_old
double precision   :: grad_c2, grad_c2_old
double precision   :: dx(4), dx_old(4)

num = num_in + 1

info = QMCKL_SUCCESS

if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif

if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif

if (elec_num <= 0) then
info = QMCKL_INVALID_ARG_4
return
endif

if (nucl_num <= 0) then
info = QMCKL_INVALID_ARG_5
return
endif

if (aord_num < 0) then
info = QMCKL_INVALID_ARG_8
return
endif


do nw =1, walk_num
delta_en_gl(:,:,nw) = 0.0d0

do a = 1, nucl_num

     x_old = en_distance_rescaled(num,a,nw)
     x = en_rescaled_single(a,nw)


     denom = 1.0d0 + a_vector(2, type_nucl_vector(a)+1) * x
     invdenom = 1.0d0 / denom
     invdenom2 = invdenom*invdenom

     denom_old = 1.0d0 + a_vector(2, type_nucl_vector(a)+1) * x_old
     invdenom_old = 1.0d0 / denom_old
     invdenom2_old = invdenom_old*invdenom_old

     dx(1) = en_rescaled_single_gl(1,a,nw)
     dx(2) = en_rescaled_single_gl(2,a,nw)
     dx(3) = en_rescaled_single_gl(3,a,nw)
     dx(4) = en_rescaled_single_gl(4,a,nw)

     dx_old(1) = en_distance_rescaled_gl(1,num,a,nw)
     dx_old(2) = en_distance_rescaled_gl(2,num,a,nw)
     dx_old(3) = en_distance_rescaled_gl(3,num,a,nw)
     dx_old(4) = en_distance_rescaled_gl(4,num,a,nw)

     f = a_vector(1, type_nucl_vector(a)+1) * invdenom2
     grad_c2 = dx(1)*dx(1) + dx(2)*dx(2) + dx(3)*dx(3)

     f_old = a_vector(1, type_nucl_vector(a)+1) * invdenom2_old
     grad_c2_old = dx_old(1)*dx_old(1) + dx_old(2)*dx_old(2) + dx_old(3)*dx_old(3)

     delta_en_gl(1,num,nw) = delta_en_gl(1,num,nw) + f * dx(1) - f_old * dx_old(1)
     delta_en_gl(2,num,nw) = delta_en_gl(2,num,nw) + f * dx(2) - f_old * dx_old(2)
     delta_en_gl(3,num,nw) = delta_en_gl(3,num,nw) + f * dx(3) - f_old * dx_old(3)
     delta_en_gl(4,num,nw) = delta_en_gl(4,num,nw) &
          + f * (dx(4) - 2.d0 * a_vector(2, type_nucl_vector(a)+1) * grad_c2 * invdenom) &
          - f_old * (dx_old(4) - 2.d0 * a_vector(2, type_nucl_vector(a)+1) * grad_c2_old * invdenom_old)


      kf = 2.d0
      x1 = x
      x = 1.d0
      x1_old = x_old
      x_old = 1.d0
      do k=2, aord_num
         f = a_vector(k+1,type_nucl_vector(a)+1) * kf * x
         f_old = a_vector(k+1,type_nucl_vector(a)+1) * kf * x_old
         delta_en_gl(1,num,nw) = delta_en_gl(1,num,nw) + f * x1 * dx(1) - f_old * x1_old * dx_old(1)
         delta_en_gl(2,num,nw) = delta_en_gl(2,num,nw) + f * x1 * dx(2) - f_old * x1_old * dx_old(2)
         delta_en_gl(3,num,nw) = delta_en_gl(3,num,nw) + f * x1 * dx(3) - f_old * x1_old * dx_old(3)
         delta_en_gl(4,num,nw) = delta_en_gl(4,num,nw) &
              + f * (x1 * dx(4) + (kf-1.d0) * grad_c2) &
              - f_old * (x1_old * dx_old(4) + (kf-1.d0) * grad_c2_old)
         x = x*x1
         x_old = x_old*x1_old
         kf = kf + 1.d0
      end do
end do
end do

end function qmckl_compute_jastrow_champ_single_en_gl_doc

test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

double en_gl_old[walk_num][4][elec_num];
double delta_en_gl[walk_num][elec_num][4];
double en_gl_new[walk_num][4][elec_num];

for (int elec = 0; elec < elec_num; elec++){

rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_en_gl(context, &en_gl_old[0][0][0], walk_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_single_en_gl(context, &delta_en_gl[0][0][0], walk_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_en_gl(context, &en_gl_new[0][0][0], walk_num*elec_num*4);
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++) {
  assert(fabs((en_gl_new[nw][m][i] - en_gl_old[nw][m][i]) - delta_en_gl[nw][i][m]) < 1.e-12);

}
}
}
}

Accept single electron move

qmckl_exit_code
qmckl_get_jastrow_champ_single_accept(qmckl_context context);
interface
  integer(qmckl_exit_code) function qmckl_get_jastrow_champ_single_accept (context) bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (qmckl_context) , intent(in), value :: context
  end function qmckl_get_jastrow_champ_single_accept
end interface

Test

/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

for (int elec = 0; elec < elec_num; elec++){

rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_en(context, &jastrow_en_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_ee(context, &jastrow_ee_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_een(context, &jastrow_een_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_en_gl(context, &en_gl_old[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_ee_gl(context, &ee_gl_old[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);

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_jastrow_champ_tmp_c(context,  &p_old[0][0][0][0][0]);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_dtmp_c(context,  &p_gl_old[0][0][0][0][0][0]);
assert (rc == QMCKL_SUCCESS);



// ----------------------------

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_single_en(context, &delta_en[0], walk_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_single_ee(context, &delta_ee[0], walk_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_single_een(context, &delta_een[0], walk_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_single_en_gl(context, &delta_en_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_single_ee_gl(context, &delta_ee_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_single_een_gl(context, &delta_een_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);



rc = qmckl_get_een_rescaled_single_e(context, &single_rescaled_een_ee_distance[0][0][0], walk_num*(cord_num+1)*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_een_rescaled_single_n(context, &single_rescaled_een_en_distance[0][0][0], walk_num*(cord_num+1)*nucl_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_delta_p(context, &delta_p[0][0][0][0][0], walk_num*cord_num*(cord_num+1)*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);


rc = qmckl_get_ee_rescaled_single(context, &single_ee_rescaled[0][0], walk_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_en_rescaled_single(context, &single_en_rescaled[0][0], walk_num*nucl_num);
assert (rc == QMCKL_SUCCESS);


rc = qmckl_get_een_rescaled_single_n_gl(context, &een_rescaled_single_n_gl[0][0][0][0], walk_num*(cord_num+1)*nucl_num*4);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_een_rescaled_single_e_gl(context, &een_rescaled_single_e_gl[0][0][0][0], walk_num*(cord_num+1)*elec_num*4);
assert (rc == QMCKL_SUCCESS);


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);

rc = qmckl_get_ee_rescaled_single_gl(context, &single_ee_rescaled_gl[0][0][0]);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_en_rescaled_single_gl(context, &single_en_rescaled_gl[0][0][0]);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_single_electron_ee_distance(context, &single_ee_distance[0][0]);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_single_electron_en_distance(context, &single_en_distance[0]);
assert (rc == QMCKL_SUCCESS);

// ----------------------------

coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];

rc = qmckl_get_jastrow_champ_single_accept(context);
assert (rc == QMCKL_SUCCESS);

//rc = qmckl_context_touch(context);

rc = qmckl_get_jastrow_champ_factor_en(context, &jastrow_en_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_ee(context, &jastrow_ee_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_een(context, &jastrow_een_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_en_gl(context, &en_gl_new[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_ee_gl(context, &ee_gl_new[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_een_gl(context, &een_gl_new[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);



rc = qmckl_get_jastrow_champ_een_rescaled_e(context, &rescaled_een_ee_distance[0][0][0][0], walk_num*(cord_num+1)*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_een_rescaled_n(context, &rescaled_een_en_distance[0][0][0][0], walk_num*(cord_num+1)*elec_num*nucl_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_tmp_c(context,  &p_new[0][0][0][0][0]);
assert (rc == QMCKL_SUCCESS);


rc = qmckl_get_jastrow_champ_ee_distance_rescaled(context, &ee_rescaled[0][0][0]);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_en_distance_rescaled(context, &en_rescaled[0][0][0]);
assert (rc == QMCKL_SUCCESS);


rc = qmckl_get_jastrow_champ_een_rescaled_n_gl(context, &een_rescaled_en_gl[0][0][0][0][0], walk_num*(cord_num+1)*nucl_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_een_rescaled_e_gl(context, &een_rescaled_ee_gl[0][0][0][0][0], walk_num*(cord_num+1)*elec_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_dtmp_c(context,  &p_gl_new[0][0][0][0][0][0]);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_ee_distance_rescaled_gl(context, &ee_rescaled_gl[0][0][0][0]);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_en_distance_rescaled_gl(context, &en_rescaled_gl[0][0][0][0]);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_ee_distance(context, &ee_distance[0][0][0]);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_en_distance(context, &en_distance[0][0]);
assert (rc == QMCKL_SUCCESS);

double metric[4] = {-1.0, -1.0, -1.0, 1.0};


for (int nw = 0; nw < walk_num; nw++) {
//printf("jastrow_en_new[%d] = %f\n", nw, jastrow_en_new[nw]);
//printf("jastrow_en_old[%d] = %f\n", nw, jastrow_en_old[nw]);
//printf("delta_en[%d] = %f\n", nw, delta_en[nw]);
assert(fabs((jastrow_en_new[nw] - jastrow_en_old[nw]) - delta_en[nw]) < 1.e-12);
assert(fabs((jastrow_ee_new[nw] - jastrow_ee_old[nw]) - delta_ee[nw]) < 1.e-12);
assert(fabs((jastrow_een_new[nw] - jastrow_een_old[nw]) - delta_een[nw]) < 1.e-12);
for (int i = 0; i < elec_num; i++){
for (int k = 0; k < 4; k++){
  //printf("en_gl_new[%d][%d][%d] = %f\n", nw, k, i, en_gl_new[nw][k][i]);
  //printf("en_gl_old[%d][%d][%d] = %f\n", nw, k, i, en_gl_old[nw][k][i]);
  //printf("delta_en_gl[%d][%d][%d] = %f\n", nw, i, k, delta_en_gl[nw][i][k]);
  assert(fabs((en_gl_new[nw][k][i] - en_gl_old[nw][k][i]) - delta_en_gl[nw][i][k]) < 1.e-12);
  assert(fabs((ee_gl_new[nw][k][i] - ee_gl_old[nw][k][i]) - delta_ee_gl[nw][i][k]) < 1.e-12);
  assert(fabs((een_gl_new[nw][k][i] - een_gl_old[nw][k][i]) - delta_een_gl[nw][k][i]) < 1.e-12);
}
}
}

for (int nw = 0; nw < walk_num; nw++){
for (int l = 0; l <= cord_num; l++){
for (int i = 0; i < elec_num; i++) {
  //printf("rescaled_een_ee_distance[%d][%d][elec][%d] = %f\n", nw, l, i, rescaled_een_ee_distance[nw][l][elec][i]);
  //printf("single_rescaled_een_ee_distance[%d][%d][%d] = %f\n", nw, l, i, single_rescaled_een_ee_distance[nw][l][i]);
  assert(fabs((rescaled_een_ee_distance[nw][l][elec][i]-single_rescaled_een_ee_distance[nw][l][i])) < 1.e-12);
  assert(fabs((rescaled_een_ee_distance[nw][l][i][elec]-single_rescaled_een_ee_distance[nw][l][i])) < 1.e-12);
}
}
}

for (int nw = 0; nw < walk_num; nw++){
for (int l = 0; l <= cord_num; l++){
for (int a = 0; a < nucl_num; a++) {
  //printf("rescaled_een_en_distance[%d][%d][%d][elec] = %f\n", nw, l, a, rescaled_een_en_distance[nw][l][a][elec]);
  //printf("single_rescaled_een_en_distance[%d][%d][%d] = %f\n", nw, l, a, single_rescaled_een_en_distance[nw][l][a]);
  assert(fabs((rescaled_een_en_distance[nw][l][a][elec]-single_rescaled_een_en_distance[nw][l][a])) < 1.e-12);
}
}
}
for (int nw = 0; nw < walk_num; nw++){
for (int l = 0; l < cord_num; l++){
for (int m = 0; m <= cord_num; m++){
  for (int a = 0; a < nucl_num; a++) {
    for (int i = 0; i < elec_num; i++){
      assert(fabs(((p_new[nw][l][m][a][i]-p_old[nw][l][m][a][i])-delta_p[nw][l][m][a][i])) < 1.e-12);
    }
  }
}
}
}

for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++){
assert(fabs(ee_rescaled[nw][elec][i]-single_ee_rescaled[nw][i]) < 1.e-12);
}
}
for (int nw = 0; nw < walk_num; nw++) {
for (int a = 0; a < nucl_num; a++){
assert(fabs(en_rescaled[nw][a][elec]-single_en_rescaled[nw][a]) < 1.e-12);
}
}

for (int l = 0; l < cord_num+1; l++) {
for (int nw = 0; nw < walk_num; nw++) {
for (int a = 0; a < nucl_num; a++) {
  for (int m = 0; m < 4; m++) {
    assert(fabs(een_rescaled_en_gl[nw][l][a][m][elec] - een_rescaled_single_n_gl[nw][l][a][m]) < 1.e-12);
  }
}
}
}

for (int l = 0; l < cord_num+1; l++) {
for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++) {
  for (int m = 0; m < 4; m++) {
    //printf("een_rescaled_ee_gl[nw][l][i][m][elec] %i %i %i %f \n", l, m ,i, een_rescaled_ee_gl[nw][l][i][m][elec]);
    //printf("een_rescaled_single_e_gl[nw][l][i][m] %i %i %i %f\n", l, m, i,een_rescaled_single_e_gl[nw][l][i][m]);
    assert(fabs(een_rescaled_ee_gl[nw][l][i][m][elec] - een_rescaled_single_e_gl[nw][l][i][m]) < 1.e-12);
    assert(fabs(een_rescaled_ee_gl[nw][l][elec][m][i] - metric[m] * een_rescaled_single_e_gl[nw][l][i][m]) < 1.e-12);
  }
}
}
}

for (int nw = 0; nw < walk_num; nw++){
for (int l = 0; l < cord_num; l++){
for (int m = 0; m <= cord_num; m++){
  for (int a = 0; a < nucl_num; a++) {
    for (int i = 0; i < elec_num; i++){
      for (int k = 0; k < 4; k++){
        //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][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][k][a][i])) < 1.e-12);
      }
    }
  }
}
}
}

for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++) {
for (int m = 0; m < 4; m++) {
  if (i == 2) continue;
  //printf("%f\n", ee_rescaled_gl[nw][elec][i][m]);
  //printf("%f\n", single_ee_rescaled_gl[nw][i][m]);
  assert(fabs(ee_rescaled_gl[nw][elec][i][m] - single_ee_rescaled_gl[nw][i][m]) < 1.e-12);
  assert(fabs(ee_rescaled_gl[nw][i][elec][m] - metric[m] * single_ee_rescaled_gl[nw][i][m]) < 1.e-12);     
}
}
}

for (int nw = 0; nw < walk_num; nw++) {
for (int a = 0; a < nucl_num; a++) {
  for (int m = 0; m < 4; m++) {
    assert(fabs(en_rescaled_gl[nw][a][elec][m] - single_en_rescaled_gl[nw][a][m]) < 1.e-12);
  
  }
}
}

for (int nw = 0; nw < walk_num; nw++){
for (int i = 0; i < elec_num; i++) {
if (i == 2) continue;
assert(fabs((ee_distance[nw][elec][i]-single_ee_distance[nw][i])) < 1.e-12);
}
}

for (int a = 0; a < nucl_num; a++){
  assert(fabs((en_distance[elec][a]-single_en_distance[a])) < 1.e-12);
}
}
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));

for (int elec = 0; elec < elec_num; elec++){

rc = qmckl_set_point(context, 'N', elec_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_en(context, &jastrow_en_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee(context, &jastrow_ee_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een(context, &jastrow_een_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_en_gl(context, &en_gl_old[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee_gl(context, &ee_gl_old[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
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_ee_distance(context, &ee_distance[0][0][0]);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_en_distance(context, &en_distance[0][0]);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_ee_distance_rescaled(context, &ee_rescaled[0][0][0]);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_ee_distance_rescaled_gl(context, &ee_rescaled_gl[0][0][0][0]);
assert (rc == QMCKL_SUCCESS);


rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_set_single_point(context, 'N', 2, new_coords, 3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_single_en(context, &delta_en[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_ee(context, &delta_ee[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_een(context, &delta_een[0], walk_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_single_en_gl(context, &delta_en_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_ee_gl(context, &delta_ee_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_een_gl(context, &delta_een_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_single_electron_ee_distance(context, &single_ee_distance[0][0]);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_single_electron_en_distance(context, &single_en_distance[0]);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_ee_rescaled_single(context, &single_ee_rescaled[0][0], walk_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_ee_rescaled_single_gl(context, &single_ee_rescaled_gl[0][0][0]);
assert (rc == QMCKL_SUCCESS);

coords[0][2][0] = new_coords[0];
coords[0][2][1] = new_coords[1];
coords[0][2][2] = new_coords[2];

rc = qmckl_get_jastrow_champ_single_accept(context);
assert (rc == QMCKL_SUCCESS);

//rc = qmckl_context_touch(context);

rc = qmckl_get_jastrow_champ_factor_en(context, &jastrow_en_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee(context, &jastrow_ee_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een(context, &jastrow_een_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_en_gl(context, &en_gl_old[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee_gl(context, &ee_gl_old[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
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_ee_distance(context, &ee_distance[0][0][0]);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_en_distance(context, &en_distance[0][0]);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_ee_distance_rescaled(context, &ee_rescaled[0][0][0]);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_ee_distance_rescaled_gl(context, &ee_rescaled_gl[0][0][0][0]);
assert (rc == QMCKL_SUCCESS);


double new_coords2[3] = {3.0,2.0,1.0};


rc = qmckl_set_single_point(context, 'N', elec, new_coords2, 3);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_single_en(context, &delta_en[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_ee(context, &delta_ee[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_een(context, &delta_een[0], walk_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_single_en_gl(context, &delta_en_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_ee_gl(context, &delta_ee_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_een_gl(context, &delta_een_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_single_electron_ee_distance(context, &single_ee_distance[0][0]);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_single_electron_en_distance(context, &single_en_distance[0]);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_ee_rescaled_single(context, &single_ee_rescaled[0][0], walk_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_ee_rescaled_single_gl(context, &single_ee_rescaled_gl[0][0][0]);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);

coords[0][elec][0] = new_coords2[0];
coords[0][elec][1] = new_coords2[1];
coords[0][elec][2] = new_coords2[2];

rc = qmckl_set_point(context, 'N', elec_num, &coords[0][0][0], walk_num*elec_num*3);
rc = qmckl_context_touch(context);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_en(context, &jastrow_en_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee(context, &jastrow_ee_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een(context, &jastrow_een_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_factor_en_gl(context, &en_gl_new[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee_gl(context, &ee_gl_new[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een_gl(context, &een_gl_new[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_electron_ee_distance(context, &ee_distance[0][0][0]);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_en_distance(context, &en_distance[0][0]);
assert (rc == QMCKL_SUCCESS);

rc = qmckl_get_jastrow_champ_ee_distance_rescaled(context, &ee_rescaled[0][0][0]);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_ee_distance_rescaled_gl(context, &ee_rescaled_gl[0][0][0][0]);
assert (rc == QMCKL_SUCCESS);

for (int nw = 0; nw < walk_num; nw++) {
//printf("jastrow_en_new[%d] = %f\t", nw, jastrow_en_new[nw]);
//printf("jastrow_en_old[%d] = %f\t", nw, jastrow_en_old[nw]);
//printf("delta_en[%d] = %f\n", nw, delta_en[nw]);
//printf("jastrow_ee_new[%d] = %f\t", nw, jastrow_ee_new[nw]);
//printf("jastrow_ee_old[%d] = %f\t", nw, jastrow_ee_old[nw]);
//printf("delta_ee[%d] = %f\n", nw, delta_ee[nw]);
assert(fabs((jastrow_en_new[nw] - jastrow_en_old[nw]) - delta_en[nw]) < 1.e-12);
assert(fabs((jastrow_ee_new[nw] - jastrow_ee_old[nw]) - delta_ee[nw]) < 1.e-12);
assert(fabs((jastrow_een_new[nw] - jastrow_een_old[nw]) - delta_een[nw]) < 1.e-12);
for (int i = 0; i < elec_num; i++){
for (int k = 0; k < 4; k++){
  //printf("ee_gl_new[%d][%d][%d] = %f\n", nw, k, i, ee_gl_new[nw][k][i]);
  //printf("ee_gl_old[%d][%d][%d] = %f\n", nw, k, i, ee_gl_old[nw][k][i]);
  //printf("delta_ee_gl[%d][%d][%d] = %f\n", nw, i, k, delta_ee_gl[nw][i][k]);
  assert(fabs((en_gl_new[nw][k][i] - en_gl_old[nw][k][i]) - delta_en_gl[nw][i][k]) < 1.e-12);
  assert(fabs((ee_gl_new[nw][k][i] - ee_gl_old[nw][k][i]) - delta_ee_gl[nw][i][k]) < 1.e-12);
  assert(fabs((een_gl_new[nw][k][i] - een_gl_old[nw][k][i]) - delta_een_gl[nw][k][i]) < 1.e-12);
}
}
}

for (int nw = 0; nw < walk_num; nw++){
for (int i = 0; i < elec_num; i++) {
if (i == 1) continue;
//printf("ee_distance[%d][elec][%d] = %f\n", nw, i, ee_distance[nw][elec][i]);
//printf("single_ee_distance[%d][%d] = %f\n", nw, i, single_ee_distance[nw][i]);
assert(fabs((ee_distance[nw][elec][i]-single_ee_distance[nw][i])) < 1.e-12);
}
}

for (int a = 0; a < nucl_num; a++){
  assert(fabs((en_distance[elec][a]-single_en_distance[a])) < 1.e-12);
}
for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++){
assert(fabs(ee_rescaled[nw][elec][i]-single_ee_rescaled[nw][i]) < 1.e-12);
}
}

for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++) {
for (int m = 0; m < 4; m++) {
  if (i == elec) continue;
  //printf("%f\n", ee_rescaled_gl[nw][elec][i][m]);
  //printf("%f\n", single_ee_rescaled_gl[nw][i][m]);
  assert(fabs(ee_rescaled_gl[nw][elec][i][m] - single_ee_rescaled_gl[nw][i][m]) < 1.e-12);

}
}
}

}