qmckl/org/qmckl_jastrow_champ_quad.org

CHAMP Jastrow Factor Quad

• Context
  • Data structure
• Set quad points
  • Set
  • Touch
• Electron-electron and electron-nucleus distances for quad point
  • Electron-electron distances
    • Get
    • Compute
  • Electron-nucleus distances
    • Get
    • Compute
• Electron-electron-nucleus Jastrow
  • Electron-electron rescaled distances
    • Get
    • Compute
  • Electron-nucleus rescaled distances
    • Get
    • Compute
  • $\delta P$ matrix
    • Get
    • Compute
  • Electron-electron-nucleus Jastrow value
    • Get
    • Compute
  • Electron-nucleus rescaled distance derivative
    • Get
    • Compute
  • Electron-electron rescaled distances derivative
    • Get
    • Compute
  • $\delta P$ matrix gradients and Laplacian
    • Get
    • Compute
  • Electron-electron-nucleus Jastrow gradients and Laplacian
    • Get
    • Compute
• Electron-electron Jastrow
  • Electron-electron rescaled distance
    • Get
    • Compute
  • Electron-electron Jastrow value
    • Get
    • Compute
  • Electron-electron rescaled distances derivatives
    • Get
    • Compute
  • Electron-electron Jastrow gradients and Laplacian
    • Get
    • Compute
• Electron-nucleus Jastrow
  • Electron-nucleus rescaled distance
    • Get
    • Compute
  • quad electron-nucleus Jastrow value
    • Get
    • Compute
  • Electron-nucleus rescaled distances derivatives
    • Get
    • Compute
  • Electron-nucleus Jastrow gradients and Laplacian
    • Get
    • Compute
• Force of quad en Jastrow
  • Get
  • Compute
  • Test
• Force of delta_p matrix
  • Get
  • Compute
• Force of quad een Jastrow
  • Get
  • Compute
  • Test

todo –optimize een_gl –optimized delta_p_gl

Context

Data structure

typedef struct qmckl_jastrow_champ_quad_struct{
int64_t      num;
int64_t*     indices;
uint64_t     date;
qmckl_matrix coord;
double  *    een_rescaled_quad_e;
uint64_t     een_rescaled_quad_e_date;
uint64_t     een_rescaled_quad_e_maxsize;
double  *    een_rescaled_quad_n;
uint64_t     een_rescaled_quad_n_date;
uint64_t     een_rescaled_quad_n_maxsize;
double*      quad_ee_distance;
uint64_t     quad_ee_distance_date;
uint64_t     quad_ee_distance_maxsize;
double*      quad_en_distance;
uint64_t     quad_en_distance_date;
uint64_t     quad_en_distance_maxsize;
double*      delta_een;
uint64_t     delta_een_date;
uint64_t     delta_een_maxsize;
double*      delta_p;
uint64_t     delta_p_date;
uint64_t     delta_p_maxsize;
double*      ee_rescaled_quad;
uint64_t     ee_rescaled_quad_date;
uint64_t     ee_rescaled_quad_maxsize;
double*      en_rescaled_quad;
uint64_t     en_rescaled_quad_date;
uint64_t     en_rescaled_quad_maxsize;
double*      delta_en;
uint64_t     delta_en_date;
uint64_t     delta_en_maxsize;
double*      delta_ee;
uint64_t     delta_ee_date;
uint64_t     delta_ee_maxsize;
double  *    een_rescaled_quad_e_gl;
uint64_t     een_rescaled_quad_e_gl_date;
uint64_t     een_rescaled_quad_e_gl_maxsize;
double  *    een_rescaled_quad_n_gl;
uint64_t     een_rescaled_quad_n_gl_date;
uint64_t     een_rescaled_quad_n_gl_maxsize;
double*      delta_p_gl;
uint64_t     delta_p_gl_date;
uint64_t     delta_p_gl_maxsize;
double*      delta_een_gl;
uint64_t     delta_een_gl_date;
uint64_t     delta_een_gl_maxsize;
double*      delta_een_g;
uint64_t     delta_een_g_date;
uint64_t     delta_een_g_maxsize;
double*      ee_rescaled_quad_gl;
uint64_t     ee_rescaled_quad_gl_date;
uint64_t     ee_rescaled_quad_gl_maxsize;
double*      en_rescaled_quad_gl;
uint64_t     en_rescaled_quad_gl_date;
uint64_t     en_rescaled_quad_gl_maxsize;
double*      delta_en_gl;
uint64_t     delta_en_gl_date;
uint64_t     delta_en_gl_maxsize;
double*      delta_ee_gl;
uint64_t     delta_ee_gl_date;
uint64_t     delta_ee_gl_maxsize;
double  * forces_jastrow_quad_en;
uint64_t  forces_jastrow_quad_en_date;
uint64_t  forces_jastrow_quad_en_maxsize;
double  * forces_jastrow_quad_een;
uint64_t  forces_jastrow_quad_een_date;
uint64_t  forces_jastrow_quad_een_maxsize;
double  * forces_delta_p;
uint64_t  forces_delta_p_date;
uint64_t  forces_delta_p_maxsize;

} qmckl_jastrow_champ_quad_struct;

Set quad points

Set

We set the coordinates of the num-th electron for all walkers, where num is the electron which has to be moved. The dimension of coord is

• [walk_num][3] if transp is 'N'
• [3][walk_num] if transp is 'T'

Internally, the coordinates are stored in 'N' format as opposed to elec_coord.

qmckl_exit_code qmckl_set_quad_points (qmckl_context context,
                              const char transp,
                              const int64_t num,
                              const int64_t* indices,
                              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_quad_points_f (qmckl_context context,
                              const char transp,
                              const int64_t num,
                              const int64_t* indices,
                              const double* coord,
                              const int64_t size_max);

qmckl_exit_code
qmckl_set_quad_points (qmckl_context context,
              const char transp,
              const int64_t num,
              const int64_t* indices,
              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_quad_points",
                          "Incorrect point number");
}

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

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

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

if (ctx->electron.walker.num > 1) {
 return qmckl_failwith( context,
                        QMCKL_FAILURE,
                        "qmckl_set_quad_points",
                        "Not implemented for multiple walkers");
}

if (size_max < 3*num) {
   return qmckl_failwith( context,
                          QMCKL_INVALID_ARG_4,
                          "qmckl_set_quad_points",
                          "Array too small");
}

qmckl_exit_code rc;

if (ctx->quad_point.coord.data != NULL) {
 rc = qmckl_matrix_free(context, &(ctx->quad_point.coord));
 assert (rc == QMCKL_SUCCESS);
}

ctx->quad_point.coord = qmckl_matrix_alloc(context, num, 3);
if (ctx->quad_point.coord.data == NULL) {
 return qmckl_failwith( context,
                        QMCKL_ALLOCATION_FAILED,
                        "qmckl_set_quad_points",
                        NULL);
}

if (ctx->quad_point.indices != NULL) {
 rc = qmckl_free(context, ctx->quad_point.indices);
 assert (rc == QMCKL_SUCCESS);
}

qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size =  num * sizeof(int64_t);

ctx->quad_point.indices = qmckl_malloc(context, mem_info);
if (ctx->quad_point.indices == NULL) {
 return qmckl_failwith( context,
                        QMCKL_ALLOCATION_FAILED,
                        "qmckl_set_quad_points",
                        NULL);
}

ctx->quad_point.num = num;

int64_t *b = ctx->quad_point.indices;
for (int i = 0; i < num; i++){
 b[i] = indices[i];
}


if (transp == 'N') {
 double *a = ctx->quad_point.coord.data;
 for (int64_t i=0 ; i<3*num ; ++i) {
   a[i] = coord[i];
 }
} else {
 for (int64_t i=0 ; i<num ; ++i) {
   qmckl_mat(ctx->quad_point.coord, i, 0) = coord[i*num + 0];
   qmckl_mat(ctx->quad_point.coord, i, 1) = coord[i*num + 1];
   qmckl_mat(ctx->quad_point.coord, i, 2) = coord[i*num + 2];
 }
}

/* Increment the date of the quad point */
ctx->quad_point.date += 1UL;

return QMCKL_SUCCESS;

}

interface
integer(qmckl_exit_code) function qmckl_set_quad_points(context, &
    transp, num, indices, coord, size_max) bind(C)
 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
 integer (c_int64_t) , intent(in)          :: indices(*)
 real    (c_double ) , intent(in)          :: coord(*)
 integer (c_int64_t) , intent(in)  , value :: size_max
end function
end interface

Touch

qmckl_exit_code
qmckl_quad_touch (const qmckl_context context);

Electron-electron and electron-nucleus distances for quad point

In order to calculate the $\delta J$, we need to have to updated distances for the quad electron.

Electron-electron distances

Electron-electron distance between the quad electron and all electrons for all walkers. Dimension is [walk_num][elec_num].

Get

qmckl_exit_code qmckl_get_quad_electron_ee_distance(qmckl_context context,
                                                  double* const distance,
                                                  const int64_t size_max);

Compute

Variable	Type	In/Out	Description
context	qmckl_context	in	Global state
num	int64_t	in	Index of quad electron
indices	int64_t[num]	in	Indices of quad electron
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
quad_coord	double[num][3]	in	quad electron coordinates
quad_ee_distance	double[num][elec_num]	out	Electron-electron distances for quad electron

integer(qmckl_exit_code) function qmckl_compute_quad_ee_distance(context, &
 num, indices, elec_num, walk_num, coord, quad_coord, quad_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
integer (c_int64_t) , intent(in)          :: indices(num)
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)          :: quad_coord(3,num)
real    (c_double ) , intent(out)         :: quad_ee_distance(elec_num,num)

integer*8 :: k, i, j
double precision :: x, y, z

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,num
 info = qmckl_distance(context, 'T', 'N', elec_num, 1_8, &
      coord(1,1,1), elec_num*walk_num, &
      quad_coord(1,k), 3_8, &
      quad_ee_distance(1,k), elec_num)
 if (info /= QMCKL_SUCCESS) then
    exit
 endif
 quad_ee_distance(indices(k)+1,k) = 0.0d0
end do



end function qmckl_compute_quad_ee_distance

Electron-nucleus distances

Get

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

qmckl_exit_code
qmckl_get_quad_electron_en_distance(qmckl_context context,
                                  double* distance,
                                  const int64_t size_max);

Compute

Variable	Type	In/Out	Description
context	qmckl_context	in	Global state
num	int64_t	in	Number of quad electrons
indices	int64_t[num]	in	Indices of quad electron
nucl_num	int64_t	in	Number of nuclei
walk_num	int64_t	in	Number of walkers
elec_coord	double[num][3]	in	Electron coordinates
nucl_coord	double[3][nucl_num]	in	Nuclear coordinates
quad_en_distance	double[num][nucl_num]	out	Electron-nucleus distances for quad-electron

integer function qmckl_compute_quad_en_distance(context, num, indices, nucl_num, walk_num,  &
 elec_coord, nucl_coord, quad_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 :: num
integer (c_int64_t) , intent(in)          :: indices(num)
integer (c_int64_t) , intent(in)  , value :: nucl_num, walk_num
real    (c_double ) , intent(in)          :: elec_coord(3,num)
real    (c_double ) , intent(in)          :: nucl_coord(nucl_num,3)
real    (c_double ) , intent(out)         :: quad_en_distance(nucl_num, 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

do k=1,num
info = qmckl_distance(context, 'T', 'N', nucl_num, 1_8, &
      nucl_coord(:,:), nucl_num, &
      elec_coord(:,k), 3_8, &
      quad_en_distance(:,k), nucl_num)
end do

end function qmckl_compute_quad_en_distance

Electron-electron-nucleus Jastrow

Electron-electron rescaled distances

Get

qmckl_exit_code
qmckl_get_een_rescaled_quad_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 quad electron
indices	int64_t[num]	in	Indices of quad electron
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
quad_ee_distance	double[num][elec_num]	in	quad 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_quad_e	double[num][0:cord_num][elec_num]	out	quad electron-electron rescaled distances for each walker

integer function qmckl_compute_een_rescaled_quad_e_doc( &
context, num, indices, walk_num, elec_num, cord_num, rescale_factor_ee,  &
quad_ee_distance, een_rescaled_e, een_rescaled_quad_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
integer(c_int64_t)    , intent(in)         :: indices(num)
integer(c_int64_t)    , intent(in), value  :: walk_num
integer(c_int64_t)    , intent(in), value  :: elec_num
integer(c_int64_t)    , intent(in), value  :: cord_num
real(c_double)        , intent(in), value  :: rescale_factor_ee
real(c_double)        , intent(in)         :: quad_ee_distance(elec_num,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_quad_e(elec_num,0:cord_num,num)

double precision,allocatable        :: een_rescaled_quad_e_ij(:,:)
double precision                    :: x
integer*8                           :: i, j, k, l, nw

info = QMCKL_SUCCESS

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

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

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

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

allocate(een_rescaled_quad_e_ij(elec_num, cord_num + 1))

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


do j = 1, elec_num
   een_rescaled_quad_e_ij(j, 2) = dexp(-rescale_factor_ee * quad_ee_distance(j, nw))
end do


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

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

do l = 1, cord_num
   do j = 1, elec_num
       x = een_rescaled_quad_e_ij(j, l + 1)
       een_rescaled_quad_e(j, l, nw) = x
   end do
end do

een_rescaled_quad_e(indices(nw)+1, :, nw) = 0.0d0

end do

end function qmckl_compute_een_rescaled_quad_e_doc

qmckl_exit_code qmckl_compute_een_rescaled_quad_e_doc (
const qmckl_context context,
const int64_t num,
const int64_t* indices,
const int64_t walk_num,
const int64_t elec_num,
const int64_t cord_num,
const double rescale_factor_ee,
const double* quad_ee_distance,
const double* een_rescaled_e,
double* const een_rescaled_quad_e );

qmckl_exit_code
qmckl_compute_een_rescaled_quad_e (const qmckl_context context,
                                const int64_t num,
                               const int64_t* indices,
                                const int64_t walk_num,
                                const int64_t elec_num,
                                const int64_t cord_num,
                                const double rescale_factor_ee,
                                const double* quad_ee_distance,
                                const double* een_rescaled_e,
                                double* const een_rescaled_quad_e )
{

#ifdef HAVE_HPC
return qmckl_compute_een_rescaled_quad_e_doc
#else
return qmckl_compute_een_rescaled_quad_e_doc
#endif
(context, num, indices, walk_num, elec_num, cord_num, rescale_factor_ee, quad_ee_distance, een_rescaled_e, een_rescaled_quad_e);
}

Electron-nucleus rescaled distances

Get

qmckl_exit_code
qmckl_get_een_rescaled_quad_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 quad electron
indices	int64_t[num]	in	Indices of quad 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
quad_en_distance	double[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_quad_n	double[num][0:cord_num][nucl_num]	out	quad electron-nucleus rescaled distances

integer function qmckl_compute_een_rescaled_quad_n( &
context, num, indices, walk_num, elec_num, nucl_num, &
type_nucl_num, type_nucl_vector, cord_num, rescale_factor_en,  &
quad_en_distance, een_rescaled_n, een_rescaled_quad_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
integer(c_int64_t)    , intent(in)         :: indices(num)
integer(c_int64_t)    , intent(in), value  :: walk_num
integer(c_int64_t)    , intent(in), value  :: elec_num
integer(c_int64_t)    , intent(in), value  :: nucl_num
integer(c_int64_t)    , intent(in), value  :: type_nucl_num
integer(c_int64_t)    , intent(in)         :: type_nucl_vector(nucl_num)
integer(c_int64_t)    , intent(in), value  :: cord_num
real(c_double)        , intent(in)         :: rescale_factor_en(type_nucl_num)
real(c_double)        , intent(in)         :: quad_en_distance(nucl_num,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_quad_n(nucl_num,0:cord_num,num)

double precision                    :: x
integer*8                           :: i, a, k, l, nw


info = QMCKL_SUCCESS

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

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

if (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, num

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

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

do l = 2, cord_num
   do a = 1, nucl_num
      een_rescaled_quad_n(a, l, nw) = een_rescaled_quad_n(a, l - 1, nw) * een_rescaled_quad_n(a, 1, nw)
   end do
end do

end do

end function qmckl_compute_een_rescaled_quad_n

$\delta P$ matrix

Get

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

Compute

Variable	Type	In/Out	Description
context	qmckl_context	in	Global state
num	int64_t	in	quad point index
indices	int64_t[num]	in	Indices of quad points
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_quad_n	double[num][0:cord_num][nucl_num]	in	Electron-nucleus quad rescaled distances
een_rescaled_quad_e	double[num][0:cord_num][elec_num]	in	Electron-electron quad rescaled distances
delta_p	double[num][0:cord_num-1][0:cord_num][nucl_num][elec_num]	out	quad point matrix P

integer function qmckl_compute_jastrow_champ_quad_delta_p_doc( &
context, num, indices, walk_num, elec_num, nucl_num, cord_num,   &
een_rescaled_n, een_rescaled_e, een_rescaled_quad_n, een_rescaled_quad_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, walk_num, elec_num, cord_num, nucl_num
integer(c_int64_t) , intent(in)        :: indices(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_quad_n(nucl_num, 0:cord_num, num)
real(c_double) , intent(in)            :: een_rescaled_quad_e(elec_num, 0:cord_num, num)
real(c_double) , intent(out)           :: delta_p(elec_num, nucl_num,0:cord_num, 0:cord_num-1,  num)

double precision        :: een_rescaled_delta_e(elec_num)

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



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, num
idx = indices(nw)+1

do i=0, cord_num-1

   een_rescaled_delta_e(:) = een_rescaled_quad_e(:,i,nw) - een_rescaled_e(:,idx,i,1)

   do c=0,cord_num
      do a=1,nucl_num
         dn = een_rescaled_quad_n(a,c,nw) - een_rescaled_n(idx,a,c,1)
         dn2 = een_rescaled_quad_n(a,c,nw)
         do j=1,elec_num
            delta_p(j,a,c,i,nw) = een_rescaled_e(j,idx,i,1)*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,1),elec_num,     &
        1.0d0,                                 &
        delta_p(idx,1,0,i,nw),elec_num)

enddo

end do

end function qmckl_compute_jastrow_champ_quad_delta_p_doc

Electron-electron-nucleus Jastrow value

Get

qmckl_exit_code
qmckl_get_jastrow_champ_quad_een(qmckl_context context,
                            double* const delta_een,
                            const int64_t size_max);

interface
  integer(qmckl_exit_code) function qmckl_get_jastrow_champ_quad_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	quad point number
indices	int64_t[num]	in	Indices of quad points
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	P matrix
delta_p	double[num][0:cord_num-1][0:cord_num][nucl_num][elec_num]	in	quad electron P matrix
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_quad_n	double[num][0:cord_num][nucl_num]	in	Electron-nucleus quad rescaled distances
een_rescaled_quad_e	double[wnum][0:cord_num][elec_num]	in	Electron-electron quad rescaled distances
delta_een	double[num]	out	Electron-nucleus jastrow

integer function qmckl_compute_jastrow_champ_factor_quad_een_doc( &
context, num, indices, 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_quad_n, &
een_rescaled_quad_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, walk_num, elec_num, cord_num, nucl_num, dim_c_vector
integer(c_int64_t)    , intent(in)  :: indices(num)
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,  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_quad_n(nucl_num, 0:cord_num, num)
real(c_double)        , intent(in)  :: een_rescaled_quad_e(elec_num, 0:cord_num, num)
real(c_double)        , intent(out) :: delta_een(num)


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

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

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, num
idx= indices(nw)+1
een_rescaled_delta_n(:,:) = een_rescaled_quad_n(:,:,nw) - een_rescaled_n(idx,:,:,1)
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,1) * delta_p(j,a,m+l,k,nw)
      end do

      accu = accu + een_rescaled_delta_n(a,m) * (tmp_c(idx,a,m+l,k,1) + delta_p(idx,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_quad_een_doc

Electron-nucleus rescaled distance derivative

Get

qmckl_exit_code
qmckl_get_een_rescaled_quad_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
num	int64_t	in	Number of quad points
indices	int64_t[num]	in	Indices of quad points
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[num][3]	in	Electron coordinates
coord_n	double[3][nucl_num]	in	Nuclear coordinates
quad_en_distance	double[num][nucl_num]	in	Electron-nucleus quad distances
een_rescaled_quad_n	double[num][0:cord_num][nucl_num]	in	Electron-nucleus rescaled quad distances
een_rescaled_quad_n_gl	double[num][0:cord_num][nucl_num][3]	out	Electron-nucleus rescaled quad distances derivative

integer function qmckl_compute_een_rescaled_quad_n_gl( &
context, num, indices, walk_num, nucl_num, type_nucl_num, type_nucl_vector, &
cord_num, rescale_factor_en, coord_ee, coord_n, quad_en_distance, &
een_rescaled_quad_n, een_rescaled_quad_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  :: num
integer(c_int64_t)    , intent(in)         :: indices(num)
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,num)
real(c_double)        , intent(in)         :: coord_n(nucl_num,3)
real(c_double)        , intent(in)         :: quad_en_distance(nucl_num,num)
real(c_double)        , intent(in)         :: een_rescaled_quad_n(nucl_num,0:cord_num,num)
real(c_double)        , intent(out)        :: een_rescaled_quad_n_gl(3,nucl_num,0:cord_num,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(3, 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_quad_n_gl             = 0.0d0
do nw = 1, num
! prepare the actual een table
do a = 1, nucl_num
   ria_inv = 1.0d0 / quad_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
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_quad_n_gl(1, a, l, nw) = kappa_l * elnuc_dist_gl(1, a)
      een_rescaled_quad_n_gl(2, a, l, nw) = kappa_l * elnuc_dist_gl(2, a)
      een_rescaled_quad_n_gl(3, a, l, nw) = kappa_l * elnuc_dist_gl(3, a)

      een_rescaled_quad_n_gl(1, a, l, nw) = een_rescaled_quad_n_gl(1, a, l, nw) * &
           een_rescaled_quad_n(a, l, nw)
      een_rescaled_quad_n_gl(2, a, l, nw) = een_rescaled_quad_n_gl(2, a, l, nw) * &
           een_rescaled_quad_n(a, l, nw)
      een_rescaled_quad_n_gl(3, a, l, nw) = een_rescaled_quad_n_gl(3, a, l, nw) * &
           een_rescaled_quad_n(a, l, nw)
   end do
end do
end do

end function qmckl_compute_een_rescaled_quad_n_gl

Electron-electron rescaled distances derivative

Get

qmckl_exit_code
qmckl_get_een_rescaled_quad_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	Index of quad electron
indices	int64_t[num]	in	Indices of quad points
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[num][3]	in	quad electron coordinates
coord_ee	double[3][walk_num][elec_num]	in	Electron coordinates
quad_ee_distance	double[num][elec_num]	in	Electron-electron quad distances
een_rescaled_quad_e	double[num][0:cord_num][elec_num]	in	Electron-electron rescaled quad distances
een_rescaled_quad_e_gl	double[num][0:cord_num][elec_num][3]	out	Electron-electron rescaled quad distances derivative

integer function qmckl_compute_een_rescaled_quad_e_gl_doc( &
context, num, indices, walk_num, elec_num, cord_num, rescale_factor_ee,  &
coord, coord_ee, quad_ee_distance, een_rescaled_quad_e, een_rescaled_quad_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
integer(c_int64_t)    , intent(in)        :: indices(num)
integer(c_int64_t)    , intent(in), value :: walk_num
integer(c_int64_t)    , intent(in), value :: elec_num
integer(c_int64_t)    , intent(in), value :: cord_num
real(c_double)        , intent(in), value :: rescale_factor_ee
real(c_double)        , intent(in)        :: coord(3,num)
real(c_double)        , intent(in)        :: coord_ee(elec_num,walk_num,3)
real(c_double)        , intent(in)        :: quad_ee_distance(elec_num,num)
real(c_double)        , intent(in)        :: een_rescaled_quad_e(elec_num,0:cord_num,num)
real(c_double)        , intent(out)       :: een_rescaled_quad_e_gl(3,elec_num,0:cord_num,num)

double precision,allocatable   :: elec_dist_gl(:,:)
double precision               :: x, rij_inv, kappa_l
integer*8                      :: i, j, k, l, nw, ii


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_quad_e_gl = 0.0d0

! Prepare table of exponentiated distances raised to appropriate power

do nw = 1, num
do i = 1, elec_num
   if (i == indices(nw)+1) cycle
   rij_inv = 1.0d0 / quad_ee_distance(i, nw)
   do ii = 1, 3
      elec_dist_gl(ii, i) = (coord(ii, nw) - coord_ee(i, 1, ii)) * rij_inv
   end do
end do

elec_dist_gl(:, indices(nw)+1) = 0.0d0

do l = 1, cord_num
   kappa_l = - dble(l) * rescale_factor_ee
   do i = 1, elec_num
      een_rescaled_quad_e_gl(1, i, l, nw) = kappa_l * elec_dist_gl(1, i)
      een_rescaled_quad_e_gl(2, i, l, nw) = kappa_l * elec_dist_gl(2, i)
      een_rescaled_quad_e_gl(3, i, l, nw) = kappa_l * elec_dist_gl(3, i)

      een_rescaled_quad_e_gl(1,i,l,nw) = een_rescaled_quad_e_gl(1,i,l,nw) * een_rescaled_quad_e(i,l,nw)
      een_rescaled_quad_e_gl(2,i,l,nw) = een_rescaled_quad_e_gl(2,i,l,nw) * een_rescaled_quad_e(i,l,nw)
      een_rescaled_quad_e_gl(3,i,l,nw) = een_rescaled_quad_e_gl(3,i,l,nw) * een_rescaled_quad_e(i,l,nw)

   end do
end do
end do



end function qmckl_compute_een_rescaled_quad_e_gl_doc

qmckl_exit_code qmckl_compute_een_rescaled_quad_e_gl (
        const qmckl_context context,
        const int64_t num,
        const int64_t* indices,
        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* quad_ee_distance,
        const double* een_rescaled_quad_e,
        double* const een_rescaled_quad_e_gl )
{
#ifdef HAVE_HPC
 return qmckl_compute_een_rescaled_quad_e_gl_doc
#else
 return qmckl_compute_een_rescaled_quad_e_gl_doc
#endif
   (context, num, indices, walk_num, elec_num, cord_num, rescale_factor_ee, coord,
   coord_ee, quad_ee_distance, een_rescaled_quad_e, een_rescaled_quad_e_gl );
}

$\delta P$ matrix gradients and Laplacian

Get

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

Compute

Variable	Type	In/Out	Description
context	qmckl_context	in	Global state
num	int64_t	in	Index of quad electron
indices	int64_t[num]	in	Indices of quad points
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_quad_n	double[num][0:cord_num][nucl_num]	in	Electron-nucleus quad rescaled distances
een_rescaled_quad_e	double[num][0:cord_num][elec_num]	in	Electron-electron quad rescaled distances
een_rescaled_n_gl	double[walk_num][0:cord_num][nucl_num][4][elec_num]	in	Electron-nucleus rescaled distances derivatives
een_rescaled_e_gl	double[walk_num][0:cord_num][elec_num][4][elec_num]	in	Electron-electron rescaled distances derivatives
een_rescaled_quad_n_gl	double[num][0:cord_num][nucl_num][3]	in	Electron-nucleus quad rescaled distances derivatives
een_rescaled_quad_e_gl	double[num][0:cord_num][elec_num][3]	in	Electron-electron quad rescaled distances derivatives
delta_p_gl	double[num][0:cord_num-1][0:cord_num][3][nucl_num]	out	Delta P matrix gradient and Laplacian

integer(qmckl_exit_code) function qmckl_compute_jastrow_champ_quad_delta_p_gl_doc( &
context, num, indices, walk_num, elec_num, nucl_num, cord_num,   &
een_rescaled_n, een_rescaled_e, een_rescaled_quad_n, een_rescaled_quad_e, &
een_rescaled_n_gl, een_rescaled_e_gl, een_rescaled_quad_n_gl, een_rescaled_quad_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, walk_num, elec_num, cord_num, nucl_num
integer(c_int64_t)    , intent(in)  :: indices(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_quad_n(nucl_num, 0:cord_num, num)
real(c_double)        , intent(in)  :: een_rescaled_quad_e(elec_num, 0:cord_num, 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_quad_n_gl(3, nucl_num, 0:cord_num, num)
real(c_double)        , intent(in)  :: een_rescaled_quad_e_gl(3,elec_num, 0:cord_num, num)
real(c_double)        , intent(out)  :: delta_p_gl(nucl_num,3,0:cord_num, 0:cord_num-1,  num)

double precision        :: delta_e_gl(elec_num,3)

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

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

do nw=1, num
idx = indices(nw)+1
do m=0, cord_num-1
   do k = 1, 3
      do j = 1, elec_num
         delta_e_gl(j,k) = een_rescaled_quad_e_gl(k,j,m,nw) - een_rescaled_e_gl(idx, k, j, m, 1)
      end do
      delta_e_gl(idx,k) = 0.0d0
   end do

   do l=0, cord_num
      do k = 1, 3
         do a = 1, nucl_num
            accu = 0.0d0
            do j = 1, elec_num
                accu = accu +  delta_e_gl(j,k) * een_rescaled_n(j,a,l,1)
            end do
            delta_p_gl(a,k,l,m,nw) =  accu
         end do
      end do
   end do
end do
end do

end function qmckl_compute_jastrow_champ_quad_delta_p_gl_doc

Electron-electron-nucleus Jastrow gradients and Laplacian

Get

qmckl_exit_code
qmckl_get_jastrow_champ_quad_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_quad_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	Index of quad electron
indices	int64_t[num]	in	Indices of quad points
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	P matrix
dtmp_c	double[walk_num][0:cord_num-1][0:cord_num][nucl_num][4][elec_num]	in	P matrix derivative
delta_p	double[num][0:cord_num-1][0:cord_num][nucl_num][elec_num]	in	Delta P matrix
delta_p_gl	double[num][0:cord_num-1][0:cord_num][3][nucl_num]	in	Delta P matrix derivative
een_rescaled_n	double[walk_num][0:cord_num][nucl_num][elec_num]	in	Electron-nucleus rescaled distances
een_rescaled_quad_n	double[num][0:cord_num][nucl_num]	in	Electron-nucleus quad rescaled distances
een_rescaled_n_gl	double[walk_num][0:cord_num][nucl_num][4][elec_num]	in	Electron-nucleus rescaled distances derivatives
een_rescaled_quad_n_gl	double[num][0:cord_num][nucl_num][3]	in	Electron-nucleus quad rescaled distances derivatives
delta_een_gl	double[num][3][elec_num]	out	Delta electron-electron-nucleus jastrow gradient and Laplacian

integer(qmckl_exit_code) function qmckl_compute_jastrow_champ_factor_quad_een_gl_doc( &
context, num, indices, 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_quad_n, &
een_rescaled_n_gl, een_rescaled_quad_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, walk_num, elec_num, cord_num, nucl_num, dim_c_vector
integer(c_int64_t)    , intent(in)  :: indices(num)
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,  num)
real(c_double)        , intent(in)  :: delta_p_gl(nucl_num, 3, 0:cord_num, 0:cord_num-1,  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_quad_n(nucl_num, 0:cord_num, 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_quad_n_gl(3, nucl_num, 0:cord_num, num)
real(c_double)        , intent(out) :: delta_een_gl(3, num)

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

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


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


do nw =1, num

idx = indices(nw)+1

een_rescaled_delta_n(:,:) = een_rescaled_quad_n(:,:,nw) - een_rescaled_n(idx, :, :, 1)
een_rescaled_delta_n_gl(:,:,:) = een_rescaled_quad_n_gl(:,:,:,nw) - een_rescaled_n_gl(idx, :,:,:,1)

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, 3
      do a = 1, nucl_num
         cn = c_vector_full(a, n)
         if(cn == 0.d0) cycle
         delta_een_gl(kk,nw) = delta_een_gl(kk,nw) + ( &
             delta_p_gl(a,kk,m  ,k,nw) * een_rescaled_n(idx,a,m+l,1) + &
             delta_p_gl(a,kk,m+l,k,nw) * een_rescaled_n(idx,a,m  ,1) + &
             delta_p(idx,a,m  ,k,nw) * een_rescaled_n_gl(idx,kk,a,m+l,1) + &
             delta_p(idx,a,m+l,k,nw) * een_rescaled_n_gl(idx,kk,a,m  ,1) ) * cn

         delta_een_gl(kk,nw) = delta_een_gl(kk,nw) + ( &
              (dtmp_c(idx,kk,a,m  ,k,1) + delta_p_gl(a,kk,m  ,k,nw)) * een_rescaled_delta_n(a,m+l) + &
              (dtmp_c(idx,kk,a,m+l,k,1) + delta_p_gl(a,kk,m+l,k,nw)) * een_rescaled_delta_n(a,m) + &
              (tmp_c(idx,a,m  ,k,1) + delta_p(idx,a,m  ,k,nw)) * een_rescaled_delta_n_gl(kk,a,m+l)  + &
              (tmp_c(idx,a,m+l,k,1) + delta_p(indices(nw)+1,a,m+l,k,nw)) * een_rescaled_delta_n_gl(kk,a,m) )* cn
      end do
   end do
end do
end do

end function qmckl_compute_jastrow_champ_factor_quad_een_gl_doc

Electron-electron Jastrow

Electron-electron rescaled distance

Get

qmckl_exit_code
qmckl_get_ee_rescaled_quad(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	Index of quad electron
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
quad_ee_distance	double[num][elec_num]	in	quad electron-electron distances
ee_rescaled_quad	double[num][elec_num]	out	Electron-electron rescaled distances

function qmckl_compute_ee_rescaled_quad_doc(context, num,&
elec_num, rescale_factor_ee, walk_num, &
quad_ee_distance, ee_rescaled_quad) &
bind(C) result(info)
use qmckl
implicit none

integer(qmckl_context), intent(in), value :: context
integer(c_int64_t)    , intent(in)  , value :: num
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)          :: quad_ee_distance(elec_num,num)
real    (c_double ) , intent(out)         :: ee_rescaled_quad(elec_num,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,num
 do i=1,elec_num
ee_rescaled_quad(i,k) = (1.0d0 - dexp(-rescale_factor_ee * quad_ee_distance(i,k))) * inverse_rescale_factor_ee
enddo
end do

end function qmckl_compute_ee_rescaled_quad_doc

Electron-electron Jastrow value

Get

qmckl_exit_code
qmckl_get_jastrow_champ_quad_ee(qmckl_context context,
                       double* const delta_ee,
                       const int64_t size_max);

interface
  integer(qmckl_exit_code) function qmckl_get_jastrow_champ_quad_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_quad_ee
end interface

Compute

Variable	Type	In/Out	Description
context	qmckl_context	in	Global state
num	int64_t	in	Index of quad point
num	int64_t	in	Index of quad point
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 rescaled distances
ee_rescaled_quad	double[num][elec_num]	in	Electron-electron rescaled quad distances
delta_ee	double[num]	out	quad electron-electron Jastrow

function qmckl_compute_jastrow_champ_quad_ee_doc(context, &
num, indices, walk_num, elec_num, up_num, bord_num, b_vector, &
ee_distance_rescaled, ee_rescaled_quad, 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
integer (c_int64_t)    , intent(in)        :: indices(num)
integer (c_int64_t)    , intent(in), value :: walk_num
integer (c_int64_t)    , intent(in), value :: elec_num
integer (c_int64_t)    , intent(in), value :: 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_quad(elec_num,num)
integer (c_int32_t)    , intent(in), value :: spin_independent
real    (c_double )    , intent(out)       :: delta_ee(num)
integer(qmckl_exit_code)                   :: info

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

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

delta_ee(nw) = 0.0d0
do i=1,elec_num
   if (i.ne.(indices(nw)+1)) then
      x = ee_distance_rescaled(i,indices(nw)+1,1)
      y = ee_rescaled_quad(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. (indices(nw)+1) <= up_num ) .or. (i >  up_num .and. (indices(nw)+1) >  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_quad_ee_doc

qmckl_exit_code
qmckl_compute_jastrow_champ_quad_ee (const qmckl_context context,
                                      const int64_t num,
                                      const int64_t* indices,
                                      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_quad,
                                      const int32_t spin_independent,
                                      double* const delta_ee )
{

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

Electron-electron rescaled distances derivatives

Get

qmckl_exit_code qmckl_get_ee_rescaled_quad_gl(qmckl_context context,
                                           double* const distance_rescaled_gl,
                                           const int64_t size_max);

Compute

Variable	Type	In/Out	Description
context	qmckl_context	in	Global state
num	int64_t	in	Index of quad electron
indices	int64_t[num]	in	Index of quad electron
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
quad_ee_distance	double[elec_num][num]	in	quad electron-electron distances
elec_coord	double[3][walk_num][elec_num]	in	Electron coordinates
coord	double[num][3]	in	quad electron coordinates
ee_rescaled_quad_gl	double[num][elec_num][3]	out	Electron-electron rescaled quad distance derivatives

function qmckl_compute_ee_rescaled_quad_gl_doc(context, num, indices,  &
elec_num, rescale_factor_ee, walk_num, quad_ee_distance, elec_coord, coord, ee_rescaled_quad_gl) &
bind(C) result(info)
use qmckl
implicit none

integer(qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in)  , value :: num
integer (c_int64_t) , intent(in)          :: indices(num)
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)          :: quad_ee_distance(elec_num,num)
real    (c_double ) , intent(in)          :: elec_coord(elec_num,walk_num,3)
real    (c_double ) , intent(in)          :: coord(3,num)
real    (c_double ) , intent(out)         :: ee_rescaled_quad_gl(3,elec_num,num)
integer(qmckl_exit_code)                  :: info

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

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_quad_gl = 0.0d0
do nw = 1, num

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

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


   ee_rescaled_quad_gl(1, i, nw) = ee_rescaled_quad_gl(1, i, nw)  * dexp(kappa_l * quad_ee_distance(i,nw))
   ee_rescaled_quad_gl(2, i, nw) = ee_rescaled_quad_gl(2, i, nw)  * dexp(kappa_l * quad_ee_distance(i,nw))
   ee_rescaled_quad_gl(3, i, nw) = ee_rescaled_quad_gl(3, i, nw)  * dexp(kappa_l * quad_ee_distance(i,nw))
end do

ee_rescaled_quad_gl(1, indices(nw)+1, nw) = 0.0d0
ee_rescaled_quad_gl(2, indices(nw)+1, nw) = 0.0d0
ee_rescaled_quad_gl(3, indices(nw)+1, nw) = 0.0d0
end do


end function qmckl_compute_ee_rescaled_quad_gl_doc

Electron-electron Jastrow gradients and Laplacian

Get

qmckl_exit_code
qmckl_get_jastrow_champ_quad_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_quad_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_quad_ee_gl
end interface

Compute

Variable	Type	In/Out	Description
context	qmckl_context	in	Global state
num	int64_t	in	Index of quad electron
indices	int64_t[num]	in	Index of quad electron
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 rescaled distances
ee_distance_rescaled_gl	double[walk_num][4][elec_num][elec_num]	in	Electron-electron rescaled distances derivatives
ee_rescaled_quad	double[num][elec_num]	in	Electron-electron rescaled quad distances
ee_rescaled_quad_gl	double[num][3][elec_num]	in	Electron-electron rescaled quad distances derivatives
spin_independent	int32_t	in	If 1, same parameters for parallel and antiparallel spins
delta_ee_gl	double[num][elec_num][3]	out	quad electron-electron jastrow gradients and Laplacian

function qmckl_compute_jastrow_champ_quad_ee_gl_doc( &
context, num, indices, walk_num, elec_num, up_num, bord_num, &
b_vector, ee_distance_rescaled, ee_distance_rescaled_gl,  &
ee_rescaled_quad, ee_rescaled_quad_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
integer (c_int64_t) , intent(in)          :: indices(num)
integer (c_int64_t) , intent(in)  , value :: walk_num
integer (c_int64_t) , intent(in)  , value :: elec_num
integer (c_int64_t) , intent(in)  , value :: 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_quad(elec_num,num)
real    (c_double ) , intent(in)          :: ee_rescaled_quad_gl(3,elec_num,num)
integer (c_int32_t) , intent(in)  , value :: spin_independent
real    (c_double ) , intent(out)         :: delta_ee_gl(3,elec_num,num)
integer(qmckl_exit_code)                  :: info

integer*8 :: i, j, k, nw, ii
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(3), dx_old(3)

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, num
delta_ee_gl(:,:,nw) = 0.0d0
   do i = 1, elec_num
      if (i == (indices(nw)+1)) cycle

      x = ee_rescaled_quad(i,nw)
      x_old = ee_distance_rescaled(i,indices(nw)+1,1)

      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_quad_gl(1, i, nw)
      dx(2) = ee_rescaled_quad_gl(2, i, nw)
      dx(3) = ee_rescaled_quad_gl(3, i, nw)

      dx_old(1) = ee_distance_rescaled_gl(1, i, indices(nw)+1, 1)
      dx_old(2) = ee_distance_rescaled_gl(2, i, indices(nw)+1, 1)
      dx_old(3) = ee_distance_rescaled_gl(3, i, indices(nw)+1, 1)

      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. (indices(nw)+1) <= up_num ) .or. (i >  up_num .and. (indices(nw)+1) >  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(1,indices(nw)+1,nw) = delta_ee_gl(1,indices(nw)+1,nw) - f * dx(1) + f_old * dx_old(1)
      delta_ee_gl(2,indices(nw)+1,nw) = delta_ee_gl(2,indices(nw)+1,nw) - f * dx(2) + f_old * dx_old(2)
      delta_ee_gl(3,indices(nw)+1,nw) = delta_ee_gl(3,indices(nw)+1,nw) - f * dx(3) + f_old * dx_old(3)


      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(1,indices(nw)+1,nw) = delta_ee_gl(1,indices(nw)+1,nw) - f * x1 * dx(1) + f_old * x1_old * dx_old(1)
         delta_ee_gl(2,indices(nw)+1,nw) = delta_ee_gl(2,indices(nw)+1,nw) - f * x1 * dx(2) + f_old * x1_old * dx_old(2)
         delta_ee_gl(3,indices(nw)+1,nw) = delta_ee_gl(3,indices(nw)+1,nw) - f * x1 * dx(3) + f_old * x1_old * dx_old(3)
         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_quad_ee_gl_doc

qmckl_exit_code
qmckl_compute_jastrow_champ_quad_ee_gl_doc (const qmckl_context context,
                                         const int64_t num,
                                         const int64_t* indices,
                                         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_quad,
                                         const double* ee_rescaled_quad_gl,
                                         const int32_t spin_independent,
                                         double* const delta_ee_gl );

qmckl_exit_code
qmckl_compute_jastrow_champ_quad_ee_gl (const qmckl_context context,
                                     const int64_t num,
                                     const int64_t* indices,
                                     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_quad,
                                     const double* ee_rescaled_quad_gl,
                                     const int32_t spin_independent,
                                     double* const delta_ee_gl )
{
#ifdef HAVE_HPC
return qmckl_compute_jastrow_champ_quad_ee_gl_doc
#else
return qmckl_compute_jastrow_champ_quad_ee_gl_doc
#endif
(context, num, indices, walk_num, elec_num, up_num, bord_num, b_vector,
ee_distance_rescaled, ee_distance_rescaled_gl, ee_rescaled_quad, ee_rescaled_quad_gl, spin_independent, delta_ee_gl );
}

Electron-nucleus Jastrow

Electron-nucleus rescaled distance

Get

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

Compute

Variable	Type	In/Out	Description
context	qmckl_context	in	Global state
nucl_num	int64_t	in	Number of nuclei
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
quad_en_distance	double[num][nucl_num]	in	quad electron-nucleus distances
en_rescaled_quad	double[num][nucl_num]	out	Electron-nucleus rescaled distances

function qmckl_compute_en_rescaled_quad_doc(context, num,&
nucl_num, type_nucl_num, type_nucl_vector, rescale_factor_en, &
walk_num, quad_en_distance, en_rescaled_quad) &
bind(C) result(info)
use qmckl
implicit none
integer (qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in)  , value  :: num
integer (c_int64_t) , intent(in)  , value  :: nucl_num
integer (c_int64_t) , intent(in)  , value  :: type_nucl_num
integer (c_int64_t) , intent(in)           :: type_nucl_vector(nucl_num)
real    (c_double ) , intent(in)           :: rescale_factor_en(type_nucl_num)
integer (c_int64_t) , intent(in)  , value  :: walk_num
real    (c_double ) , intent(in)           :: quad_en_distance(nucl_num,num)
real    (c_double ) , intent(out)          :: en_rescaled_quad(nucl_num,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 k=1,num
do i=1, nucl_num
   en_rescaled_quad(i,k) = (1.0d0 - dexp(-rescale_factor_en(type_nucl_vector(i)+1) * &
        quad_en_distance(i,k))) / rescale_factor_en(type_nucl_vector(i)+1)
end do
end do

end function qmckl_compute_en_rescaled_quad_doc

quad electron-nucleus Jastrow value

Get

qmckl_exit_code
qmckl_get_jastrow_champ_quad_en(qmckl_context context,
                       double* const delta_en,
                       const int64_t size_max);

interface
  integer(qmckl_exit_code) function qmckl_get_jastrow_champ_quad_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_quad_en
end interface

Compute

Variable	Type	In/Out	Description
context	qmckl_context	in	Global state
num	int64_t	in	Index of quad point
indices	int64_t[num]	in	Indices of electrons
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 rescaled distances
~en_rescaled_quad ~	double[num][nucl_num]	in	Electron-nucleus rescaled quad distances
delta_en	double[num]	out	quad electron-nucleus jastrow

function qmckl_compute_jastrow_champ_quad_en_doc( &
context, num, indices, walk_num, elec_num, nucl_num, type_nucl_num, &
type_nucl_vector, aord_num, a_vector, &
en_distance_rescaled, en_rescaled_quad, 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
integer (c_int64_t) , intent(in)          :: indices(num)
integer (c_int64_t) , intent(in)  , value :: walk_num
integer (c_int64_t) , intent(in)  , value :: elec_num
integer (c_int64_t) , intent(in)  , value :: nucl_num
integer (c_int64_t) , intent(in)  , value :: type_nucl_num
integer (c_int64_t) , intent(in)          :: type_nucl_vector(nucl_num)
integer (c_int64_t) , intent(in)  , value :: 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_quad(nucl_num,num)
real    (c_double ) , intent(out)         :: delta_en(num)
integer(qmckl_exit_code)                  :: info

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

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, num
delta_en(nw) = 0.0d0
do a = 1, nucl_num
     x = en_distance_rescaled(indices(nw)+1, a, 1)
     y = en_rescaled_quad(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(indices(nw)+1, a, 1)
       y = y * en_rescaled_quad(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_quad_en_doc

qmckl_exit_code qmckl_compute_jastrow_champ_quad_en (
     const qmckl_context context,
     const int64_t num,
     const int64_t* indices,
     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_quad,
     double* const delta_en );

qmckl_exit_code qmckl_compute_jastrow_champ_quad_en_doc (
     const qmckl_context context,
     const int64_t num,
     const int64_t* indices,
     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_quad,
     double* const delta_en );

qmckl_exit_code qmckl_compute_jastrow_champ_quad_en (
     const qmckl_context context,
     const int64_t num,
     const int64_t* indices,
     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_quad,
     double* const delta_en )
{
#ifdef HAVE_HPC
return qmckl_compute_jastrow_champ_quad_en_doc
#else
return qmckl_compute_jastrow_champ_quad_en_doc
#endif
(context, num, indices, walk_num, elec_num, nucl_num, type_nucl_num,
 type_nucl_vector, aord_num, a_vector, en_distance_rescaled,
 en_rescaled_quad, delta_en );
}

Electron-nucleus rescaled distances derivatives

Get

qmckl_exit_code qmckl_get_en_rescaled_quad_gl(qmckl_context context,
                                           double* distance_rescaled_gl,
                                           const int64_t size_max);

Compute

Variable	Type	In/Out	Description
context	qmckl_context	in	Global state
num	int64_t	in	Number of quad points
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
quad_en_distance	double[num][nucl_num]	in	quad electorn distances
coord	double[num][3]	in	quad electron coordinates
nucl_coord	double[3][nucl_num]	in	Nucleus coordinates
en_rescaled_quad_gl	double[num][nucl_num][3]	out	Electron-nucleus rescaled quad distance derivatives

integer function qmckl_compute_en_rescaled_quad_gl_doc_f(context, num, nucl_num, &
type_nucl_num, type_nucl_vector, rescale_factor_en, walk_num, &
quad_en_distance, coord, nucl_coord, en_rescaled_quad_gl) &
result(info)
use qmckl
implicit none
integer(qmckl_context), intent(in)  :: context
integer*8             , intent(in)  :: num
integer*8             , intent(in)  :: nucl_num
integer*8             , intent(in)  :: type_nucl_num
integer*8             , intent(in)  :: type_nucl_vector(nucl_num)
double precision      , intent(in)  :: rescale_factor_en(nucl_num)
integer*8             , intent(in)  :: walk_num
double precision      , intent(in)  :: quad_en_distance(nucl_num, num)
double precision      , intent(in)  :: coord(3,num)
double precision      , intent(in)  :: nucl_coord(nucl_num,3)
double precision      , intent(out) :: en_rescaled_quad_gl(3,nucl_num,num)

integer*8 :: nw, a, ii
double precision :: ria_inv, elnuc_dist_gl(3, 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_quad_gl = 0.0d0
do nw = 1, num

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

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


   en_rescaled_quad_gl(1, a, nw) = en_rescaled_quad_gl(1, a, nw)  * dexp(kappa_l * quad_en_distance(a,nw))
   en_rescaled_quad_gl(2, a, nw) = en_rescaled_quad_gl(2, a, nw)  * dexp(kappa_l * quad_en_distance(a,nw))
   en_rescaled_quad_gl(3, a, nw) = en_rescaled_quad_gl(3, a, nw)  * dexp(kappa_l * quad_en_distance(a,nw))
end do

end do


end function qmckl_compute_en_rescaled_quad_gl_doc_f

Electron-nucleus Jastrow gradients and Laplacian

Get

qmckl_exit_code
qmckl_get_jastrow_champ_quad_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_quad_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_quad_en_gl
end interface

Compute

Variable	Type	In/Out	Description
context	qmckl_context	in	Global state
num	int64_t	in	Index of quad electron
indices	int64_t[num]	in	Indices of quad electrons
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 rescaled distances
en_distance_rescaled_gl	double[walk_num][nucl_num][elec_num][4]	in	Electron-nucleus rescaled distance derivatives
en_rescaled_quad	double[num][nucl_num]	in	Electron-nucleus rescaled quad distances
en_rescaled_quad_gl	double[num][nucl_num][3]	in	Electron-nucleus rescaled quad distance derivatives
delta_en_gl	double[num][elec_num][3]	out	quad electron-nucleus Jastrow gradients and Laplacian

function qmckl_compute_jastrow_champ_quad_en_gl_doc( &
context, num, indices, 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_quad, en_rescaled_quad_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
integer (c_int64_t) , intent(in)          :: indices(num)
integer (c_int64_t) , intent(in)  , value :: walk_num
integer (c_int64_t) , intent(in)  , value :: elec_num
integer (c_int64_t) , intent(in)  , value :: nucl_num
integer (c_int64_t) , intent(in)  , value :: type_nucl_num
integer (c_int64_t) , intent(in)          :: type_nucl_vector(nucl_num)
integer (c_int64_t) , intent(in)  , value :: 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_quad(nucl_num,num)
real    (c_double ) , intent(in)          :: en_rescaled_quad_gl(3, nucl_num,num)
real    (c_double ) , intent(out)         :: delta_en_gl(3,elec_num,num)
integer(qmckl_exit_code)                   :: info

integer*8 :: i, a, k, nw, ii
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(3), dx_old(3)


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, num
delta_en_gl(:,:,nw) = 0.0d0

do a = 1, nucl_num

     x_old = en_distance_rescaled(indices(nw)+1,a,1)
     x = en_rescaled_quad(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_quad_gl(1,a,nw)
     dx(2) = en_rescaled_quad_gl(2,a,nw)
     dx(3) = en_rescaled_quad_gl(3,a,nw)

     dx_old(1) = en_distance_rescaled_gl(1,indices(nw)+1,a,1)
     dx_old(2) = en_distance_rescaled_gl(2,indices(nw)+1,a,1)
     dx_old(3) = en_distance_rescaled_gl(3,indices(nw)+1,a,1)

     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,indices(nw)+1,nw) = delta_en_gl(1,indices(nw)+1,nw) + f * dx(1) - f_old * dx_old(1)
     delta_en_gl(2,indices(nw)+1,nw) = delta_en_gl(2,indices(nw)+1,nw) + f * dx(2) - f_old * dx_old(2)
     delta_en_gl(3,indices(nw)+1,nw) = delta_en_gl(3,indices(nw)+1,nw) + f * dx(3) - f_old * dx_old(3)



      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,indices(nw)+1,nw) = delta_en_gl(1,indices(nw)+1,nw) + f * x1 * dx(1) - f_old * x1_old * dx_old(1)
         delta_en_gl(2,indices(nw)+1,nw) = delta_en_gl(2,indices(nw)+1,nw) + f * x1 * dx(2) - f_old * x1_old * dx_old(2)
         delta_en_gl(3,indices(nw)+1,nw) = delta_en_gl(3,indices(nw)+1,nw) + f * x1 * dx(3) - f_old * x1_old * dx_old(3)

         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_quad_en_gl_doc

Force of quad en Jastrow

Get

qmckl_exit_code
qmckl_get_forces_jastrow_quad_en(qmckl_context context,
                      double* const forces_jastrow_quad_en,
                      const int64_t size_max);

Compute

Variable	Type	In/Out	Description
context	qmckl_context	in	Global state
num	int64_t	in	Index of quad electron
indices	int64_t[num]	in	Indices of quad electrons
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 rescaled distances
en_distance_rescaled_gl	double[walk_num][nucl_num][elec_num][4]	in	Electron-nucleus rescaled distance derivatives
en_rescaled_quad	double[num][nucl_num]	in	Electron-nucleus rescaled quad distances
en_rescaled_quad_gl	double[num][nucl_num][3]	in	Electron-nucleus rescaled quad distance derivatives
forces_jastrow_quad_en	double[num][nucl_num][3]	out	quad electron-nucleus forces

function qmckl_compute_forces_jastrow_quad_en_doc( &
context, num, indices, 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_quad, en_rescaled_quad_gl, forces_jastrow_quad_en) &
bind(C) result(info)
use qmckl
implicit none

integer (qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in)  , value :: num
integer (c_int64_t) , intent(in)          :: indices(num)
integer (c_int64_t) , intent(in)  , value :: walk_num
integer (c_int64_t) , intent(in)  , value :: elec_num
integer (c_int64_t) , intent(in)  , value :: nucl_num
integer (c_int64_t) , intent(in)  , value :: type_nucl_num
integer (c_int64_t) , intent(in)          :: type_nucl_vector(nucl_num)
integer (c_int64_t) , intent(in)  , value :: 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_quad(nucl_num,num)
real    (c_double ) , intent(in)          :: en_rescaled_quad_gl(3, nucl_num,num)
real    (c_double ) , intent(out)         :: forces_jastrow_quad_en(3,nucl_num,num)
integer(qmckl_exit_code)                   :: info

integer*8 :: i, a, k, nw, ii
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   :: dx(3), dx_old(3)


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, num
forces_jastrow_quad_en(:,:,nw) = 0.0d0

do a = 1, nucl_num

 x_old = en_distance_rescaled(indices(nw)+1,a,1)
 x = en_rescaled_quad(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_quad_gl(1,a,nw)
 dx(2) = -en_rescaled_quad_gl(2,a,nw)
 dx(3) = -en_rescaled_quad_gl(3,a,nw)

 dx_old(1) = -en_distance_rescaled_gl(1,indices(nw)+1,a,1)
 dx_old(2) = -en_distance_rescaled_gl(2,indices(nw)+1,a,1)
 dx_old(3) = -en_distance_rescaled_gl(3,indices(nw)+1,a,1)

 f = a_vector(1, type_nucl_vector(a)+1) * invdenom2

 f_old = a_vector(1, type_nucl_vector(a)+1) * invdenom2_old

 forces_jastrow_quad_en(1,a,nw) = forces_jastrow_quad_en(1,a,nw) + f * dx(1) - f_old * dx_old(1)
 forces_jastrow_quad_en(2,a,nw) = forces_jastrow_quad_en(2,a,nw) + f * dx(2) - f_old * dx_old(2)
 forces_jastrow_quad_en(3,a,nw) = forces_jastrow_quad_en(3,a,nw) + f * dx(3) - f_old * dx_old(3)


 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
   forces_jastrow_quad_en(1,a,nw) = forces_jastrow_quad_en(1,a,nw) + f * x1 * dx(1) - f_old * x1_old * dx_old(1)
   forces_jastrow_quad_en(2,a,nw) = forces_jastrow_quad_en(2,a,nw) + f * x1 * dx(2) - f_old * x1_old * dx_old(2)
   forces_jastrow_quad_en(3,a,nw) = forces_jastrow_quad_en(3,a,nw) + f * x1 * dx(3) - f_old * x1_old * dx_old(3)
   x = x*x1
   x_old = x_old*x1_old
   kf = kf + 1.d0
 end do
end do
end do

end function qmckl_compute_forces_jastrow_quad_en_doc

Test

Force of delta_p matrix

Get

qmckl_exit_code
qmckl_get_forces_jastrow_quad_delta_p(qmckl_context context,
                            double* const forces_delta_p,
                            const int64_t size_max);

Compute

Variable	Type	In/Out	Description
context	qmckl_context	in	Global state
num	int64_t	in	Index of quad electron
indices	int64_t[num]	in	Indices of quad electrons
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_quad_n	double[num][0:cord_num][nucl_num]	in	Electron-nucleus quad rescaled distances
een_rescaled_quad_e	double[num][0:cord_num][elec_num]	in	Electron-electron quad rescaled distances
een_rescaled_n_gl	double[walk_num][0:cord_num][nucl_num][4][elec_num]	in	Electron-nucleus rescaled distances derivatives
een_rescaled_quad_n_gl	double[num][0:cord_num][nucl_num][3]	in	Electron-nucleus quad rescaled distances derivatives
forces_delta_p	double[num][0:cord_num-1][0:cord_num][nucl_num][3][elec_num]	out	Delta P matrix gradient and Laplacian

integer(qmckl_exit_code) function qmckl_compute_forces_jastrow_quad_delta_p_doc( &
context, num, indices, walk_num, elec_num, nucl_num, cord_num,   &
een_rescaled_n, een_rescaled_e, een_rescaled_quad_n, een_rescaled_quad_e, &
een_rescaled_n_gl, een_rescaled_quad_n_gl, forces_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, walk_num, elec_num, cord_num, nucl_num
integer(c_int64_t)    , intent(in)  :: indices(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_quad_n(nucl_num, 0:cord_num, num)
real(c_double)        , intent(in)  :: een_rescaled_quad_e(elec_num, 0:cord_num, 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_quad_n_gl(3, nucl_num, 0:cord_num, num)
real(c_double)        , intent(out)  :: forces_delta_p(elec_num,3,nucl_num,0:cord_num, 0:cord_num-1,  num)

double precision        :: delta_n_gl, accu
double precision        :: delta_e(elec_num)


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


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
forces_delta_p = 0.d0
return
endif


do nw=1, num
idx = indices(nw)+1
do m=1, cord_num-1

 do j = 1, elec_num
   delta_e(j) = een_rescaled_quad_e(j,m,nw) - een_rescaled_e(j,idx,m,1)
 end do

 do l=0, cord_num
   do a = 1, nucl_num
     do k = 1, 3
       delta_n_gl = een_rescaled_quad_n_gl(k,a,l,nw) - een_rescaled_n_gl(idx, k, a, l, 1)
       tmp = -een_rescaled_quad_n_gl(k,a,l,nw)
       do j = 1, elec_num
         forces_delta_p(j,k,a,l,m,nw) =  delta_e(j) * tmp + &
               een_rescaled_e(idx,j,m,1) * delta_n_gl
       end do
       accu = 0.0d0
       do j = 1, elec_num
         accu = accu - delta_e(j) * een_rescaled_n_gl(j,k,a,l,1)
       end do
       forces_delta_p(idx,k,a,l,m,nw) = forces_delta_p(idx,k,a,l,m,nw) + accu
     end do
   end do
 end do
end do
end do

end function qmckl_compute_forces_jastrow_quad_delta_p_doc

** Test

Force of quad een Jastrow

Get

qmckl_exit_code
qmckl_get_forces_jastrow_quad_een(qmckl_context context,
                      double* const forces_jastrow_quad_een,
                      const int64_t size_max);

Compute

Variable	Type	In/Out	Description
context	qmckl_context	in	Global state
num	int64_t	in	Index of quad electron
indices	int64_t[num]	in	Indices of quad electrons
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
delta_p	double[num][0:cord_num-1][0:cord_num][nucl_num][elec_num]	in	quad electron P matrix
forces_delta_p	double[num][0:cord_num-1][0:cord_num][nucl_num][3][elec_num]	in	quad electron P matrix
tmp_c	double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]	in	quad electron P matrix
forces_tmp_c	double[walk_num][0:cord_num-1][0:cord_num][nucl_num][4][elec_num]	in	quad electron P matrix
een_rescaled_n	double[walk_num][0:cord_num][nucl_num][elec_num]	in	Electron-nucleus rescaled distances
een_rescaled_quad_n	double[num][0:cord_num][nucl_num]	in	Electron-nucleus quad rescaled distances
een_rescaled_n_gl	double[walk_num][0:cord_num][nucl_num][4][elec_num]	in	Electron-nucleus rescaled distances derivatives
een_rescaled_quad_n_gl	double[num][0:cord_num][nucl_num][3]	in	Electron-nucleus quad rescaled distances derivatives
forces_jastrow_quad_een	double[num][nucl_num][3]	out	quad electron-nucleus forces

function qmckl_compute_forces_jastrow_quad_een_doc( &
context, num, indices, walk_num, elec_num, nucl_num, cord_num, &
dim_c_vector, c_vector_full, lkpm_combined_index, &
delta_p, forces_delta_p, tmp_c, forces_tmp_c, &
een_rescaled_n, een_rescaled_quad_n, een_rescaled_n_gl, een_rescaled_quad_n_gl, forces_jastrow_quad_een) &
bind(C) result(info)
use qmckl
implicit none

integer (qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in)  , value :: num
integer (c_int64_t) , intent(in)          :: indices(num)
integer (c_int64_t) , intent(in)  , value :: walk_num
integer (c_int64_t) , intent(in)  , value :: elec_num
integer (c_int64_t) , intent(in)  , value :: nucl_num
integer (c_int64_t) , intent(in)  , value :: dim_c_vector
integer (c_int64_t) , intent(in)  , value :: cord_num
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)          :: delta_p(elec_num, nucl_num,0:cord_num, 0:cord_num-1, num)
real    (c_double ) , intent(in)          :: forces_delta_p(elec_num, 3, nucl_num,0:cord_num, 0:cord_num-1, num)
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)          :: forces_tmp_c(elec_num, 4, nucl_num,0:cord_num, 0:cord_num-1, walk_num)
real    (c_double ) , intent(in)          :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num)
real    (c_double ) , intent(in)          :: een_rescaled_quad_n(nucl_num, 0:cord_num, 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_quad_n_gl(3, nucl_num, 0:cord_num, num)
real    (c_double ) , intent(out)         :: forces_jastrow_quad_een(3,nucl_num,num)
integer(qmckl_exit_code)                   :: info

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

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

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

forces_jastrow_quad_een = 0.0d0

if (cord_num == 0) return

do nw = 1, num
idx = indices(nw)+1
do kk = 1, 3
 een_rescaled_delta_n(:,:) = een_rescaled_quad_n(:,:,nw) - een_rescaled_n(idx,:,:,1)
 een_rescaled_delta_n_gl(:,:) = een_rescaled_quad_n_gl(kk,:,:,nw) - een_rescaled_n_gl(idx,kk,:,:,1)
 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_gl(j,kk,a,m,1) * delta_p(j,a,m+l,k,nw) + &
               een_rescaled_n(j,a,m,1) * forces_delta_p(j,kk,a,m+l,k,nw)
       end do
       accu = accu - een_rescaled_delta_n_gl(a,m) * (tmp_c(idx,a,m+l,k,1) + delta_p(idx,a,m+l,k,nw)) + &
           een_rescaled_delta_n(a,m) * (forces_tmp_c(idx,kk,a,m+l,k,1) + forces_delta_p(idx,kk,a,m+l,k,nw))
       forces_jastrow_quad_een(kk,a,nw) = forces_jastrow_quad_een(kk,a,nw) + accu * cn
     end do
 end do
end do
end do


end function qmckl_compute_forces_jastrow_quad_een_doc

Test