TREX/qmckl

Fork 0

mirror of https://github.com/TREX-CoE/qmckl.git synced 2025-04-30 04:15:00 +02:00

Emiel Slootman b52ba449cd working 2 body gl

2024-12-05 15:19:48 +01:00

230 KiB

Raw Blame History

CHAMP Jastrow Factor Single

Introduction
Context
- Data structure
Single point
- Set
Electron-electron distances single point
- Get
- Compute
ee distance rescaled single point
- Get
- Compute
Electron-nucleus distances single point
- Get
- Compute
en distance rescaled single point
- Get
- Compute
Delta p
- provide
- Compute
Delta e-e-n
- get
- Compute
ee distance rescaled single point
- Get
- Compute
en distance rescaled single point
- Get
- Compute
Delta ee
- Get
- Compute
- Compute
En rescaled derivative een
- Get
- Compute
EE rescaled distance derivative for een
- Get
- Compute
gl delta p
- provide
- Compute
Delta grad e-e-n
- get
- Compute
ee distance rescaled single point gl
- Get
- Compute
en distance rescaled single point gl
- Get
- Provide
- Compute
Delta ee gl
- Get
- Compute
Delta en gl
- Get
- Compute

Introduction

Context

Data structure

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

} qmckl_jastrow_champ_single_struct;

Single point

Set

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

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

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

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

if (size_max != 3) {
   return qmckl_failwith( context,
                          QMCKL_INVALID_ARG_4,
                          "qmckl_set_single_point",
                          "Array too small");
}

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

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

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

qmckl_exit_code rc;

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

 ctx->single_point.coord = qmckl_matrix_alloc(context, 1, 3);
 if (ctx->single_point.coord.data == NULL) {
     return qmckl_failwith( context,
                             QMCKL_ALLOCATION_FAILED,
                             "qmckl_set_single_point",
                             NULL);
 }

ctx->single_point.num = num;

if (transp == 'T') {
 double *a = ctx->single_point.coord.data;
#ifdef HAVE_OPENMP
 #pragma omp for
#endif
 for (int64_t i=0 ; i<3 ; ++i) {
   a[i] = coord[i];
 }
} else {
 qmckl_mat(ctx->single_point.coord, 0, 0) = coord[0];
 qmckl_mat(ctx->single_point.coord, 0, 1) = coord[1];
 qmckl_mat(ctx->single_point.coord, 0, 2) = coord[2];

}

/* Increment the date of the context */
ctx->single_point.date += 1UL;

return QMCKL_SUCCESS;

}

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

Electron-electron distances single point

Get

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

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`elec_num`	`int64_t`	in	Number of electrons
`walk_num`	`int64_t`	in	Number of walkers
`coord`	`double[3][walk_num][elec_num]`	in	Electron coordinates
`single_coord`	`double[1][3]`	in	Single electron coordinates
`single_ee_distance`	`double[walk_num][elec_num]`	out	Electron-electron distances

integer function qmckl_compute_single_ee_distance_f(context, elec_num, walk_num, coord, single_coord, single_ee_distance) &
 result(info)
use qmckl
implicit none
integer(qmckl_context), intent(in)  :: context
integer*8             , intent(in)  :: elec_num
integer*8             , intent(in)  :: walk_num
double precision      , intent(in)  :: coord(elec_num,walk_num,3)
double precision      , intent(in)  :: single_coord(1,3)
double precision      , intent(out) :: single_ee_distance(elec_num,walk_num)


integer*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,walk_num
 info = qmckl_distance(context, 'T', 'T', 1, elec_num, &
      single_coord(1,1), 1, &
      coord(1,k,1), elec_num * walk_num, &
      single_ee_distance(1,k), 1)
 if (info /= QMCKL_SUCCESS) then
    exit
 endif
end do

end function qmckl_compute_single_ee_distance_f

ee distance rescaled single point

Get

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

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`num`	`int64_t`	in	Number of walkers
`walk_num`	`int64_t`	in	Number of walkers
`elec_num`	`int64_t`	in	Number of electrons
`cord_num`	`int64_t`	in	Order of polynomials
`rescale_factor_ee`	`double`	in	Factor to rescale ee distances
`single_ee_distance`	`double[walk_num][elec_num]`	in	Single electron-electron distances for each walker
`een_rescaled_e`	`double[walk_num][0:cord_num][elec_num][elec_num]`	in	Rescaled electron-electron distances for each walker
`een_rescaled_single_e`	`double[walk_num][0:cord_num][elec_num]`	out	Single electron-electron rescaled distances for each walker

integer function qmckl_compute_een_rescaled_single_e_doc_f( &
context, num, walk_num, elec_num, cord_num, rescale_factor_ee,  &
single_ee_distance, een_rescaled_e, een_rescaled_single_e) &
result(info)
use qmckl
implicit none
integer(qmckl_context), intent(in)  :: context
integer*8             , intent(in)  :: num
integer*8             , intent(in)  :: walk_num
integer*8             , intent(in)  :: elec_num
integer*8             , intent(in)  :: cord_num
double precision      , intent(in)  :: rescale_factor_ee
double precision      , intent(in)  :: single_ee_distance(elec_num,walk_num)
double precision      , intent(in)  :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num)
double precision      , intent(out) :: een_rescaled_single_e(elec_num,0:cord_num,walk_num)
double precision,dimension(:,:),allocatable :: een_rescaled_single_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_single_e_ij(elec_num, cord_num + 1))

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


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


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

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

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

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

end do

end function qmckl_compute_een_rescaled_single_e_doc_f

qmckl_exit_code qmckl_compute_een_rescaled_single_e_doc (
const qmckl_context context,
const int64_t num,
const int64_t walk_num,
const int64_t elec_num,
const int64_t cord_num,
const double rescale_factor_ee,
const double* single_ee_distance,
const double* een_rescaled_e,
double* const een_rescaled_single_e );

qmckl_exit_code qmckl_compute_een_rescaled_single_e (
const qmckl_context context,
const int64_t num,
const int64_t walk_num,
const int64_t elec_num,
const int64_t cord_num,
const double rescale_factor_ee,
const double* single_ee_distance,
const double* een_rescaled_e,
double* const een_rescaled_single_e ) {

#ifdef HAVE_HPC
return qmckl_compute_een_rescaled_single_e_doc
#else
return qmckl_compute_een_rescaled_single_e_doc
#endif
 (context, num, walk_num, elec_num, cord_num, rescale_factor_ee, single_ee_distance, een_rescaled_e, een_rescaled_single_e);
}

Electron-nucleus distances single point

Get

qmckl_exit_code qmckl_get_single_electron_en_distance(qmckl_context context, double* distance);

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`nucl_num`	`int64_t`	in	Number of nuclei
`elec_coord`	`double[3]`	in	Electron coordinates
`nucl_coord`	`double[3][nucl_num]`	in	Nuclear coordinates
`single_en_distance`	`double[nucl_num]`	out	Electron-nucleus distances

integer function qmckl_compute_single_en_distance_f(context, nucl_num, elec_coord, nucl_coord, single_en_distance) &
 result(info)
use qmckl
implicit none
integer(qmckl_context), intent(in)  :: context
integer*8             , intent(in)  :: nucl_num
double precision      , intent(in)  :: elec_coord(3)
double precision      , intent(in)  :: nucl_coord(nucl_num,3)
double precision      , intent(out) :: single_en_distance(nucl_num)

integer*8 :: k

info = QMCKL_SUCCESS

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

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

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

end function qmckl_compute_single_en_distance_f

en distance rescaled single point

Get

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

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`num`	`int64_t`	in	Number of single electron
`walk_num`	`int64_t`	in	Number of walkers
`elec_num`	`int64_t`	in	Number of atoms
`nucl_num`	`int64_t`	in	Number of atoms
`type_nucl_num`	`int64_t`	in	Number of atom types
`type_nucl_vector`	`int64_t[nucl_num]`	in	Types of atoms
`cord_num`	`int64_t`	in	Order of polynomials
`rescale_factor_en`	`double[nucl_num]`	in	Factor to rescale ee distances
`single_en_distance`	`double[walk_num][nucl_num]`	in	Electron-nucleus distances
`een_rescaled_n`	`double[walk_num][0:cord_num][nucl_num][elec_num]`	in	Electron-nucleus rescaled distances
`een_rescaled_single_n`	`double[walk_num][0:cord_num][nucl_num]`	out	Single electron-nucleus rescaled distances

integer function qmckl_compute_een_rescaled_single_n_f( &
context, num, walk_num, elec_num, nucl_num, &
type_nucl_num, type_nucl_vector, cord_num, rescale_factor_en,  &
single_en_distance, een_rescaled_n, een_rescaled_single_n) &
result(info)
use qmckl
implicit none
integer(qmckl_context), intent(in)  :: context
integer*8             , intent(in)  :: num
integer*8             , intent(in)  :: walk_num
integer*8             , intent(in)  :: elec_num
integer*8             , intent(in)  :: nucl_num
integer*8             , intent(in)  :: type_nucl_num
integer*8             , intent(in)  :: type_nucl_vector(nucl_num)
integer*8             , intent(in)  :: cord_num
double precision      , intent(in)  :: rescale_factor_en(type_nucl_num)
double precision      , intent(in)  :: single_en_distance(nucl_num,walk_num)
double precision      , intent(in)  :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num)
double precision      , intent(out) :: een_rescaled_single_n(nucl_num,0:cord_num,walk_num)
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, walk_num

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

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

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

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

end do

end function qmckl_compute_een_rescaled_single_n_f

Delta p

provide

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`num`	`int64_t`	in	Single point number
`walk_num`	`int64_t`	in	Number of walkers
`elec_num`	`int64_t`	in	Number of electrons
`nucl_num`	`int64_t`	in	Number of nuclei
`cord_num`	`int64_t`	in	order of polynomials
`een_rescaled_n`	`double[walk_num][0:cord_num][nucl_num][elec_num]`	in	Electron-nucleus rescaled distances
`een_rescaled_e`	`double[walk_num][0:cord_num][elec_num][elec_num]`	in	Electron-electron rescaled distances
`een_rescaled_delta_n`	`double[walk_num][0:cord_num][nucl_num]`	in	Electron-nucleus single rescaled distances
`een_rescaled_delta_e`	`double[walk_num][0:cord_num][elec_num]`	in	Electron-electron single rescaled distances
`delta_p`	`double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]`	out	Electron-nucleus jastrow

integer function qmckl_compute_jastrow_champ_delta_p_doc_f( &
context, num, walk_num, elec_num, nucl_num, cord_num,   &
een_rescaled_n, een_rescaled_e, een_rescaled_delta_n, een_rescaled_delta_e, delta_p) &
result(info)
use qmckl
implicit none
integer(qmckl_context), intent(in)  :: context
integer*8             , intent(in)  :: num, walk_num, elec_num, cord_num, nucl_num
double precision      , intent(in)  :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num)
double precision      , intent(in)  :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num)
double precision      , intent(in)  :: een_rescaled_delta_n(nucl_num, 0:cord_num, walk_num)
double precision      , intent(in)  :: een_rescaled_delta_e(elec_num, 0:cord_num, walk_num)
double precision      , intent(out)  :: delta_p(elec_num, nucl_num,0:cord_num, 0:cord_num-1,  walk_num)

double precision        :: delta_c(nucl_num,0:cord_num, 0:cord_num-1,  walk_num)
double precision        :: delta_c2(elec_num, nucl_num,0:cord_num, 0:cord_num-1,  walk_num)



integer*8 :: i, a, j, l, k, p, m, n, nw
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



if (cord_num == 0) return

! First calculate delta p
do nw=1, walk_num
do i=0, cord_num-1 

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


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


delta_c2(num,:,:,i,nw) = delta_c2(num,:,:,i,nw) + delta_c(:,:,i,nw)
delta_p(:,:,:,i,nw) = delta_c2(:,:,:,i,nw)


info = qmckl_dgemm(context, 'N', 'T', elec_num, nucl_num * (cord_num+1), 1, 1.0d0,     &
                een_rescaled_e(:,num,i,nw),elec_num,                     &
                een_rescaled_delta_n(:,:,nw),nucl_num* (cord_num+1),                     &
                0.0d0,                                       &
                delta_c2(:,:,:,i,nw),elec_num)


delta_p(:,:,:,i,nw) = delta_p(:,:,:,i,nw) + delta_c2(:,:,:,i,nw)

info = qmckl_dgemm(context, 'N', 'T', elec_num, nucl_num * (cord_num+1), 1, 1.0d0,     &
                een_rescaled_delta_e(:,i,nw),elec_num,                     &
                een_rescaled_delta_n(:,:,nw),nucl_num* (cord_num+1),                     &
                0.0d0,                                       &
                delta_c2(:,:,:,i,nw),elec_num)

 delta_p(:,:,:,i,nw) = delta_p(:,:,:,i,nw) + delta_c2(:,:,:,i,nw)


end do
end do


end function qmckl_compute_jastrow_champ_delta_p_doc_f

Delta e-e-n

get

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

interface
  integer(qmckl_exit_code) function qmckl_get_jastrow_champ_single_een (context, &
       delta_een, size_max) bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (qmckl_context) , intent(in), value :: context
    integer(c_int64_t), intent(in), value       :: size_max
    real(c_double),   intent(out)               :: delta_een(size_max)
  end function
end interface

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`num`	`int64_t`	in	Single point number
`walk_num`	`int64_t`	in	Number of walkers
`elec_num`	`int64_t`	in	Number of electrons
`nucl_num`	`int64_t`	in	Number of nuclei
`cord_num`	`int64_t`	in	order of polynomials
`dim_c_vector`	`int64_t`	in	dimension of full coefficient vector
`c_vector_full`	`double[dim_c_vector][nucl_num]`	in	full coefficient vector
`lkpm_combined_index`	`int64_t[4][dim_c_vector]`	in	combined indices
`tmp_c`	`double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]`	in	vector of non-zero coefficients
`delta_p`	`double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]`	in	vector of non-zero coefficients
`een_rescaled_n`	`double[walk_num][0:cord_num][nucl_num][elec_num]`	in	Electron-nucleus rescaled distances
`een_rescaled_e`	`double[walk_num][0:cord_num][elec_num][elec_num]`	in	Electron-electron rescaled distances
`een_rescaled_delta_n`	`double[walk_num][0:cord_num][nucl_num]`	in	Electron-nucleus single rescaled distances
`een_rescaled_delta_e`	`double[walk_num][0:cord_num][elec_num]`	in	Electron-electron single rescaled distances
`delta_een`	`double[walk_num]`	out	Electron-nucleus jastrow

integer function qmckl_compute_jastrow_champ_factor_single_een_doc_f( &
context, num, walk_num, elec_num, nucl_num, cord_num,   &
dim_c_vector, c_vector_full, lkpm_combined_index, &
tmp_c, delta_p, een_rescaled_n, een_rescaled_e, een_rescaled_delta_n, een_rescaled_delta_e, delta_een) &
result(info)
use qmckl
implicit none
integer(qmckl_context), intent(in)  :: context
integer*8             , intent(in)  :: num, walk_num, elec_num, cord_num, nucl_num, dim_c_vector
integer*8             , intent(in)  :: lkpm_combined_index(dim_c_vector,4)
double precision      , intent(in)  :: c_vector_full(nucl_num, dim_c_vector)
double precision      , intent(in)  :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1,  walk_num)
double precision      , intent(in)  :: delta_p(elec_num, nucl_num,0:cord_num, 0:cord_num-1,  walk_num)
double precision      , intent(in)  :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num)
double precision      , intent(in)  :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num)
double precision      , intent(in)  :: een_rescaled_delta_n(nucl_num, 0:cord_num, walk_num)
double precision      , intent(in)  :: een_rescaled_delta_e(elec_num, 0:cord_num, walk_num)
double precision      , intent(out) :: delta_een(walk_num)

double precision        :: delta_c(nucl_num,0:cord_num, 0:cord_num-1,  walk_num)
double precision        :: delta_c2(elec_num, nucl_num,0:cord_num, 0:cord_num-1,  walk_num)


integer*8 :: i, a, j, l, k, p, m, n, nw
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, walk_num
do n = 1, dim_c_vector
   l = lkpm_combined_index(n, 1)
   k = lkpm_combined_index(n, 2)
   p = lkpm_combined_index(n, 3)
   m = lkpm_combined_index(n, 4)

   do a = 1, nucl_num
      cn = c_vector_full(a, n)
      if(cn == 0.d0) cycle

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

end function qmckl_compute_jastrow_champ_factor_single_een_doc_f

ee distance rescaled single point

Get

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

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`elec_num`	`int64_t`	in	Number of electrons
`rescale_factor_ee`	`double`	in	Factor to rescale ee distances
`walk_num`	`int64_t`	in	Number of walkers
`single_ee_distance`	`double[walk_num][elec_num]`	in	Electron coordinates
`ee_rescaled_single`	`double[walk_num][elec_num]`	out	Electron-electron rescaled distances

function qmckl_compute_ee_rescaled_single_doc(context, &
elec_num, rescale_factor_ee, walk_num, &
single_ee_distance, ee_rescaled_single) &
bind(C) result(info)
use qmckl
implicit none

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

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

inverse_rescale_factor_ee = 1.0d0 / rescale_factor_ee

info = QMCKL_SUCCESS

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

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

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

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

end function qmckl_compute_ee_rescaled_single_doc

en distance rescaled single point

Get

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

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`elec_num`	`int64_t`	in	Number of electrons
`nucl_num`	`int64_t`	in	Number of nuclei
`type_nucl_num`	`int64_t`	in	Number of types of nuclei
`type_nucl_vector`	`int64_t[nucl_num]`	in	Number of types of nuclei
`rescale_factor_en`	`double[type_nucl_num]`	in	The factor for rescaled distances
`walk_num`	`int64_t`	in	Number of walkers
`single_en_distance`	`double[walk_num][nucl_num]`	in	Electron coordinates
`en_rescaled_single`	`double[walk_num][nucl_num]`	out	Electron-electron rescaled distances

function qmckl_compute_en_rescaled_single_doc(context, &
nucl_num, type_nucl_num, &
type_nucl_vector, rescale_factor_en, walk_num, single_en_distance, en_rescaled_single) &
bind(C) result(info)
use qmckl
implicit none
integer (qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in)  , value :: nucl_num
integer (c_int64_t) , intent(in)  , value :: type_nucl_num
integer (c_int64_t) , intent(in)          :: type_nucl_vector(nucl_num)
real    (c_double ) , intent(in)          :: rescale_factor_en(type_nucl_num)
integer (c_int64_t) , intent(in)  , value :: walk_num
real    (c_double ) , intent(in)         :: single_en_distance(nucl_num,walk_num)
real    (c_double ) , intent(out)         :: en_rescaled_single(nucl_num,walk_num)
integer(qmckl_exit_code)                   :: info

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

info = QMCKL_SUCCESS

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


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

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

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

end function qmckl_compute_en_rescaled_single_doc

Delta ee

Get

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

interface
  integer(qmckl_exit_code) function qmckl_get_jastrow_champ_single_ee (context, &
       delta_ee, size_max) bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (qmckl_context) , intent(in), value :: context
    integer(c_int64_t), intent(in), value       :: size_max
    real(c_double),   intent(out)               :: delta_ee(size_max)
  end function qmckl_get_jastrow_champ_single_ee
end interface

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`num`	`int64_t`	in	Number of walkers
`walk_num`	`int64_t`	in	Number of walkers
`elec_num`	`int64_t`	in	Number of electrons
`up_num`	`int64_t`	in	Number of alpha electrons
`bord_num`	`int64_t`	in	Number of coefficients
`b_vector`	`double[bord_num+1]`	in	List of coefficients
`ee_distance_rescaled`	`double[walk_num][elec_num][elec_num]`	in	Electron-electron distances
`ee_rescaled_single`	`double[walk_num][][elec_num]`	in	Electron-electron distances
`delta_ee`	`double[walk_num]`	out	$f_{ee}$

function qmckl_compute_jastrow_champ_single_ee_doc(context, &
num, walk_num, elec_num, up_num, bord_num, b_vector, &
ee_distance_rescaled, ee_rescaled_single, spin_independent, delta_ee) &
bind(C) result(info)
use qmckl
implicit none

integer (qmckl_context), intent(in), value :: context
integer (c_int64_t)    , intent(in), value :: num
integer (c_int64_t)    , intent(in), value :: walk_num
integer (c_int64_t)    , intent(in), value :: elec_num
integer (c_int64_t)    , intent(in), value :: up_num
integer (c_int64_t)    , intent(in), value :: bord_num
real    (c_double )    , intent(in)        :: b_vector(bord_num+1)
real    (c_double )    , intent(in)        :: ee_distance_rescaled(elec_num,elec_num,walk_num)
real    (c_double )    , intent(in)        :: ee_rescaled_single(elec_num,walk_num)
integer (c_int32_t)    , intent(in), value :: spin_independent
real    (c_double )    , intent(out)       :: delta_ee(walk_num)
integer(qmckl_exit_code)                   :: info

integer*8 :: i, j, k, nw
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, walk_num

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

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

end do

end function qmckl_compute_jastrow_champ_single_ee_doc

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

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

Delta en

** Get

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

interface
  integer(qmckl_exit_code) function qmckl_get_jastrow_champ_single_en (context, &
       delta_en, size_max) bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (qmckl_context) , intent(in), value :: context
    integer(c_int64_t), intent(in), value       :: size_max
    real(c_double),   intent(out)               :: delta_en(size_max)
  end function qmckl_get_jastrow_champ_single_en
end interface

** Provide :noexport:

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`wnum`	`int64_t`	in	Number of single point
`walk_num`	`int64_t`	in	Number of walkers
`elec_num`	`int64_t`	in	Number of electrons
`nucl_num`	`int64_t`	in	Number of nuclei
`type_nucl_num`	`int64_t`	in	Number of unique nuclei
`type_nucl_vector`	`int64_t[nucl_num]`	in	IDs of unique nuclei

nt64_t~ | in | Number of coefficients | | aord_num | ~i

`a_vector`	`double[type_nucl_num][aord_num+1]`	in	List of coefficients
`en_distance_rescaled`	`double[walk_num][nucl_num][elec_num]`	in	Electron-nucleus distances
~en_rescaled_single ~	`double[walk_num][nucl_num]`	in	Electron-nucleus distances
`delta_en`	`double[walk_num]`	out	Electron-nucleus jastrow

function qmckl_compute_jastrow_champ_single_en_doc( &
context, num, walk_num, elec_num, nucl_num, type_nucl_num, &
type_nucl_vector, aord_num, a_vector, &
en_distance_rescaled, en_rescaled_single, delta_en) &
bind(C) result(info)
use qmckl
implicit none

integer (qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in)  , value :: num
integer (c_int64_t) , intent(in)  , value :: walk_num
integer (c_int64_t) , intent(in)  , value :: elec_num
integer (c_int64_t) , intent(in)  , value :: nucl_num
integer (c_int64_t) , intent(in)  , value :: type_nucl_num
integer (c_int64_t) , intent(in)          :: type_nucl_vector(nucl_num)
integer (c_int64_t) , intent(in)  , value :: aord_num
real    (c_double ) , intent(in)          :: a_vector(aord_num+1,type_nucl_num)
real    (c_double ) , intent(in)          :: en_distance_rescaled(elec_num,nucl_num,walk_num)
real    (c_double ) , intent(in)          :: en_rescaled_single(nucl_num,walk_num)
real    (c_double ) , intent(out)         :: delta_en(walk_num)
integer(qmckl_exit_code)                  :: info

integer*8 :: i, a, p, nw
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, walk_num
delta_en(nw) = 0.0d0
do a = 1, nucl_num
     x = en_distance_rescaled(num, a, nw)
     y = en_rescaled_single(a, nw)

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

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

end do
end do

end function qmckl_compute_jastrow_champ_single_en_doc

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

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

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

En rescaled derivative een

Get

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

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`walk_num`	`int64_t`	in	Number of walkers
`nucl_num`	`int64_t`	in	Number of atoms
`type_nucl_num`	`int64_t`	in	Number of atom types
`type_nucl_vector`	`int64_t[nucl_num]`	in	Types of atoms
`cord_num`	`int64_t`	in	Order of polynomials
`rescale_factor_en`	`double[nucl_num]`	in	Factor to rescale ee distances
`coord_ee`	`double[walk_num][3]`	in	Electron coordinates
`coord_n`	`double[3][nucl_num]`	in	Nuclear coordinates
`single_en_distance`	`double[walk_num][nucl_num]`	in	Electron-nucleus distances
`een_rescaled_single_n`	`double[walk_num][0:cord_num][nucl_num]`	in	Electron-nucleus distances
`een_rescaled_single_n_gl`	`double[walk_num][0:cord_num][nucl_num][4]`	out	Electron-nucleus rescaled distances

integer function qmckl_compute_een_rescaled_single_n_gl_f( &
context, walk_num, nucl_num, type_nucl_num, type_nucl_vector, &
cord_num, rescale_factor_en, &
coord_ee, coord_n, single_en_distance, een_rescaled_single_n, een_rescaled_single_n_gl) &
result(info)
use qmckl
implicit none
integer(qmckl_context), intent(in)  :: context
integer*8             , intent(in)  :: walk_num
integer*8             , intent(in)  :: nucl_num
integer*8             , intent(in)  :: type_nucl_num
integer*8             , intent(in)  :: type_nucl_vector(nucl_num)
integer*8             , intent(in)  :: cord_num
double precision      , intent(in)  :: rescale_factor_en(type_nucl_num)
double precision      , intent(in)  :: coord_ee(3)
double precision      , intent(in)  :: coord_n(nucl_num,3)
double precision      , intent(in)  :: single_en_distance(nucl_num,walk_num)
double precision      , intent(in)  :: een_rescaled_single_n(nucl_num,0:cord_num,walk_num)
double precision      , intent(out) :: een_rescaled_single_n_gl(4,nucl_num,0:cord_num,walk_num)
double precision,dimension(:,:),allocatable :: elnuc_dist_gl
double precision                    :: x, ria_inv, kappa_l
integer*8                           :: i, a, k, l, nw, ii

allocate(elnuc_dist_gl(4, nucl_num))

info = QMCKL_SUCCESS

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

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


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

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

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

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

do l = 0, cord_num
   do a = 1, nucl_num
      kappa_l = - dble(l) * rescale_factor_en(type_nucl_vector(a)+1)
       een_rescaled_single_n_gl(1, a, l, nw) = kappa_l * elnuc_dist_gl(1, a)
       een_rescaled_single_n_gl(2, a, l, nw) = kappa_l * elnuc_dist_gl(2, a)
       een_rescaled_single_n_gl(3, a, l, nw) = kappa_l * elnuc_dist_gl(3, a)
       een_rescaled_single_n_gl(4, a, l, nw) = kappa_l * elnuc_dist_gl(4, a)

       een_rescaled_single_n_gl(4, a, l, nw) = een_rescaled_single_n_gl(4, a, l, nw)           &
             + een_rescaled_single_n_gl(1, a, l, nw) * een_rescaled_single_n_gl(1, a, l, nw) &
             + een_rescaled_single_n_gl(2, a, l, nw) * een_rescaled_single_n_gl(2, a, l, nw) &
             + een_rescaled_single_n_gl(3, a, l, nw) * een_rescaled_single_n_gl(3, a, l, nw)

       een_rescaled_single_n_gl(1, a, l, nw) = een_rescaled_single_n_gl(1, a, l, nw) * &
             een_rescaled_single_n(a, l, nw)
       een_rescaled_single_n_gl(2, a, l, nw) = een_rescaled_single_n_gl(2, a, l, nw) * &
             een_rescaled_single_n(a, l, nw)
       een_rescaled_single_n_gl(3, a, l, nw) = een_rescaled_single_n_gl(3, a, l, nw) * &
             een_rescaled_single_n(a, l, nw)
       een_rescaled_single_n_gl(4, a, l, nw) = een_rescaled_single_n_gl(4, a, l, nw) * &
             een_rescaled_single_n(a, l, nw)
   end do
end do
end do

end function qmckl_compute_een_rescaled_single_n_gl_f

EE rescaled distance derivative for een

Get

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

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`num`	`int64_t`	in	Number of walkers
`walk_num`	`int64_t`	in	Number of walkers
`elec_num`	`int64_t`	in	Number of electrons
`cord_num`	`int64_t`	in	Order of polynomials
`rescale_factor_ee`	`double`	in	Factor to rescale ee distances
`coord`	`double[3]`	in	Electron coordinates
`coord_ee`	`double[walk_num][3][elec_num]`	in	Electron coordinates
`single_ee_distance`	`double[walk_num][elec_num]`	in	Electron-electron distances
`een_rescaled_single_e`	`double[walk_num][0:cord_num][elec_num]`	in	Electron-electron distances
`een_rescaled_single_e_gl`	`double[walk_num][0:cord_num][elec_num][4]`	out	Electron-electron rescaled distances

integer function qmckl_compute_een_rescaled_single_e_gl_f( &
context, num, walk_num, elec_num, cord_num, rescale_factor_ee,  &
coord, coord_ee, single_ee_distance, een_rescaled_single_e, een_rescaled_single_e_gl) &
result(info)
use qmckl
implicit none
integer(qmckl_context), intent(in)  :: context
integer*8             , intent(in)  :: num
integer*8             , intent(in)  :: walk_num
integer*8             , intent(in)  :: elec_num
integer*8             , intent(in)  :: cord_num
double precision      , intent(in)  :: rescale_factor_ee
double precision      , intent(in)  :: coord(3)
double precision      , intent(in)  :: coord_ee(elec_num,3,walk_num)
double precision      , intent(in)  :: single_ee_distance(elec_num,walk_num)
double precision      , intent(in)  :: een_rescaled_single_e(elec_num,0:cord_num,walk_num)
double precision      , intent(out) :: een_rescaled_single_e_gl(4,elec_num,0:cord_num,walk_num)
double precision,dimension(:,:),allocatable  :: elec_dist_gl
double precision                    :: x, rij_inv, kappa_l
integer*8                           :: i, j, k, l, nw, ii

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

! Prepare table of exponentiated distances raised to appropriate power
do nw = 1, walk_num
do i = 1, elec_num
   rij_inv = 1.0d0 / single_ee_distance(i, nw)
   do ii = 1, 3
     elec_dist_gl(ii, i) = (coord(ii) - coord_ee(i, ii, nw)) * rij_inv
   end do
   elec_dist_gl(4, i) = 2.0d0 * rij_inv
 end do
end do
elec_dist_gl(:, num) = 0.0d0


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

     een_rescaled_single_e_gl(4, i, l, nw) = een_rescaled_single_e_gl(4, i, l, nw)              &
               + een_rescaled_single_e_gl(1, i, l, nw) * een_rescaled_single_e_gl(1, i, l, nw)  &
               + een_rescaled_single_e_gl(2, i, l, nw) * een_rescaled_single_e_gl(2, i, l, nw)  &
               + een_rescaled_single_e_gl(3, i, l, nw) * een_rescaled_single_e_gl(3, i, l, nw)

     een_rescaled_single_e_gl(1,i,l,nw) = een_rescaled_single_e_gl(1,i,l,nw) * een_rescaled_single_e(i,l,nw)
     een_rescaled_single_e_gl(2,i,l,nw) = een_rescaled_single_e_gl(2,i,l,nw) * een_rescaled_single_e(i,l,nw)
     een_rescaled_single_e_gl(3,i,l,nw) = een_rescaled_single_e_gl(3,i,l,nw) * een_rescaled_single_e(i,l,nw)
     een_rescaled_single_e_gl(4,i,l,nw) = een_rescaled_single_e_gl(4,i,l,nw) * een_rescaled_single_e(i,l,nw)
end do
end do

end function qmckl_compute_een_rescaled_single_e_gl_f

qmckl_exit_code qmckl_compute_een_rescaled_single_e_gl (
        const qmckl_context context,
         const int64_t num,
        const int64_t walk_num,
        const int64_t elec_num,
        const int64_t cord_num,
        const double rescale_factor_ee,
        const double* coord,
        const double* coord_ee,
        const double* single_ee_distance,
        const double* een_rescaled_single_e,
        double* const een_rescaled_single_e_gl )
{
#ifdef HAVE_HPC
 return qmckl_compute_een_rescaled_single_e_gl_doc
#else
 return qmckl_compute_een_rescaled_single_e_gl_doc
#endif
   (context, num, walk_num, elec_num, cord_num, rescale_factor_ee, coord,
   coord_ee, single_ee_distance, een_rescaled_single_e, een_rescaled_single_e_gl );
}

gl delta p

provide

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`num`	`int64_t`	in	Single point number
`walk_num`	`int64_t`	in	Number of walkers
`elec_num`	`int64_t`	in	Number of electrons
`nucl_num`	`int64_t`	in	Number of nuclei
`cord_num`	`int64_t`	in	order of polynomials
`een_rescaled_n`	`double[walk_num][0:cord_num][nucl_num][elec_num]`	in	Electron-nucleus rescaled distances
`een_rescaled_e`	`double[walk_num][0:cord_num][elec_num][elec_num]`	in	Electron-electron rescaled distances
`een_rescaled_delta_n`	`double[walk_num][0:cord_num][nucl_num]`	in	Electron-nucleus single rescaled distances
`een_rescaled_delta_e`	`double[walk_num][0:cord_num][elec_num]`	in	Electron-electron single rescaled distances
`een_rescaled_n_gl`	`double[walk_num][0:cord_num][nucl_num][elec_num][4]`	in	Electron-nucleus rescaled distances
`een_rescaled_e_gl`	`double[walk_num][0:cord_num][elec_num][elec_num][4]`	in	Electron-electron rescaled distances
`een_rescaled_delta_n_gl`	`double[walk_num][0:cord_num][nucl_num][4]`	in	Electron-nucleus single rescaled distances
`een_rescaled_delta_e_gl`	`double[walk_num][0:cord_num][elec_num][4]`	in	Electron-electron single rescaled distances
`delta_p_gl`	`double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num][4]`	out	Electron-nucleus jastrow

integer function qmckl_compute_jastrow_champ_delta_p_gl_doc_f( &
context, num, walk_num, elec_num, nucl_num, cord_num,   &
een_rescaled_n, een_rescaled_e, een_rescaled_delta_n, een_rescaled_delta_e, &
een_rescaled_n_gl, een_rescaled_e_gl, een_rescaled_delta_n_gl, een_rescaled_delta_e_gl, delta_p_gl) &
result(info)
use qmckl
implicit none
integer(qmckl_context), intent(in)  :: context
integer*8             , intent(in)  :: num, walk_num, elec_num, cord_num, nucl_num
double precision      , intent(in)  :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num)
double precision      , intent(in)  :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num)
double precision      , intent(in)  :: een_rescaled_delta_n(nucl_num, 0:cord_num, walk_num)
double precision      , intent(in)  :: een_rescaled_delta_e(elec_num, 0:cord_num, walk_num)
double precision      , intent(in)  :: een_rescaled_n_gl(elec_num, 4, nucl_num, 0:cord_num, walk_num)
double precision      , intent(in)  :: een_rescaled_e_gl(elec_num, 4, elec_num, 0:cord_num, walk_num)
double precision      , intent(in)  :: een_rescaled_delta_n_gl(4, nucl_num, 0:cord_num, walk_num)
double precision      , intent(in)  :: een_rescaled_delta_e_gl(4, elec_num, 0:cord_num, walk_num)
double precision      , intent(out)  :: delta_p_gl(4,elec_num, nucl_num,0:cord_num, 0:cord_num-1,  walk_num)

double precision        :: delta_e_gl(4, elec_num, 0:cord_num, walk_num)
double precision        :: delta_n_gl(4, nucl_num, 0:cord_num, walk_num)

double precision        :: delta_e_gl_2(elec_num, 0:cord_num, walk_num)
double precision        :: een_rescaled_e_gl_2(elec_num, elec_num, 0:cord_num, walk_num)

double precision        :: delta_c(nucl_num,0:cord_num, 0:cord_num-1,  walk_num)
double precision        :: delta_c2(elec_num, nucl_num,0:cord_num, 0:cord_num-1,  walk_num)



integer*8 :: i, a, j, l, k, p, m, n, nw
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


if (cord_num == 0) return

delta_e_gl(:,:,:,:) = een_rescaled_delta_e_gl(:,:,:,:) - een_rescaled_e_gl(num, :, :, :, :)
delta_n_gl(:,:,:,:) = een_rescaled_delta_n_gl(:,:,:,:) - een_rescaled_n_gl(num, :, :, :, :)
delta_e_gl(:, num, :, :) = 0.0d0



! First calculate delta p
do nw=1, walk_num
do i=0, cord_num-1 
do k = 1, 4
delta_e_gl_2(:,:,:) = delta_e_gl(k, :,:,:)
een_rescaled_e_gl_2(:,:,:,:) = een_rescaled_e_gl(:,k, :,:,:)

info = qmckl_dgemm(context, 'T', 'N', 1, nucl_num * (cord_num+1), elec_num, 1.0d0,     &
                delta_e_gl_2(1,i,nw),elec_num,                     &
                een_rescaled_n(1,1,0,nw),elec_num,                     &
                0.0d0,                                       &
                delta_c(1,0,i,nw),1)

info = qmckl_dgemm(context, 'N', 'N', elec_num, nucl_num * (cord_num+1), 1, 1.0d0,     &
                delta_e_gl_2(1,i,nw),elec_num,                     &
                een_rescaled_n(num,1,0,nw),elec_num,                     &
                0.0d0,                                       &
                delta_c2(1,1,0,i,nw),elec_num)

delta_c2(num,:,:,i,nw) = delta_c2(num,:,:,i,nw) + delta_c(:,:,i,nw)        
delta_p_gl(k,:,:,:,i,nw) = delta_c2(:,:,:,i,nw)


info = qmckl_dgemm(context, 'N', 'T', elec_num, nucl_num * (cord_num+1), 1, 1.0d0,     &
                een_rescaled_e_gl_2(1,num,i,nw),elec_num,                     &
                een_rescaled_delta_n(1,0,nw),nucl_num* (cord_num+1),                     &
                0.0d0,                                       &
                delta_c2(1,1,0,i,nw),elec_num)



delta_p_gl(k,:,:,:,i,nw) = delta_p_gl(k,:,:,:,i,nw) + delta_c2(:,:,:,i,nw)

info = qmckl_dgemm(context, 'N', 'T', elec_num, nucl_num * (cord_num+1), 1, 1.0d0,     &
                delta_e_gl_2(1,i,nw),elec_num,                     &
                een_rescaled_delta_n(1,0,nw),nucl_num* (cord_num+1),                     &
                0.0d0,                                       &
                delta_c2(1,1,0,i,nw),elec_num)

delta_p_gl(k,:,:,:,i,nw) = delta_p_gl(k,:,:,:,i,nw) + delta_c2(:,:,:,i,nw)

end do
end do
end do


end function qmckl_compute_jastrow_champ_delta_p_gl_doc_f

Delta grad e-e-n

get

qmckl_exit_code
qmckl_get_jastrow_champ_single_een_gl(qmckl_context context,
                            double* const delta_een_gl,
                            const int64_t size_max);

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

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`num`	`int64_t`	in	Single point number
`walk_num`	`int64_t`	in	Number of walkers
`elec_num`	`int64_t`	in	Number of electrons
`nucl_num`	`int64_t`	in	Number of nuclei
`cord_num`	`int64_t`	in	order of polynomials
`dim_c_vector`	`int64_t`	in	dimension of full coefficient vector
`c_vector_full`	`double[dim_c_vector][nucl_num]`	in	full coefficient vector
`lkpm_combined_index`	`int64_t[4][dim_c_vector]`	in	combined indices
`tmp_c`	`double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]`	in	vector of non-zero coefficients
`dtmp_c`	`double[walk_num][0:cord_num-1][0:cord_num][nucl_num][4][elec_num]`	in	vector of non-zero coefficients
`delta_p`	`double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]`	in	vector of non-zero coefficients
`delta_p_gl`	`double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num][4]`	in	vector of non-zero coefficients
`een_rescaled_n`	`double[walk_num][0:cord_num][nucl_num][elec_num]`	in	Electron-nucleus rescaled distances
`een_rescaled_delta_n`	`double[walk_num][0:cord_num][nucl_num]`	in	Electron-nucleus single rescaled distances
`een_rescaled_n_gl`	`double[walk_num][0:cord_num][nucl_num][4][elec_num]`	in	Electron-nucleus rescaled distances
`een_rescaled_delta_n_gl`	`double[walk_num][0:cord_num][nucl_num][4]`	in	Electron-nucleus single rescaled distances
`delta_een_gl`	`double[walk_num][elec_num][4]`	out	Electron-nucleus jastrow

integer function qmckl_compute_jastrow_champ_factor_single_een_gl_doc_f( &
context, num, walk_num, elec_num, nucl_num, cord_num,   &
dim_c_vector, c_vector_full, lkpm_combined_index, &
tmp_c, dtmp_c, delta_p, delta_p_gl, een_rescaled_n, een_rescaled_delta_n, een_rescaled_n_gl, een_rescaled_delta_n_gl,   delta_een_gl) &
result(info)
use qmckl
implicit none
integer(qmckl_context), intent(in)  :: context
integer*8             , intent(in)  :: num, walk_num, elec_num, cord_num, nucl_num, dim_c_vector
integer*8             , intent(in)  :: lkpm_combined_index(dim_c_vector,4)
double precision      , intent(in)  :: c_vector_full(nucl_num, dim_c_vector)
double precision      , intent(in)  :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1,  walk_num)
double precision      , intent(in)  :: dtmp_c(elec_num, 4, nucl_num,0:cord_num, 0:cord_num-1,  walk_num)
double precision      , intent(in)  :: delta_p(elec_num, nucl_num,0:cord_num, 0:cord_num-1,  walk_num)
double precision      , intent(in)  :: delta_p_gl(4, elec_num, nucl_num,0:cord_num, 0:cord_num-1,  walk_num)
double precision      , intent(in)  :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num)
double precision      , intent(in)  :: een_rescaled_delta_n(nucl_num, 0:cord_num, walk_num)
double precision      , intent(in)  :: een_rescaled_n_gl(elec_num, 4, nucl_num, 0:cord_num, walk_num)
double precision      , intent(in)  :: een_rescaled_delta_n_gl(4, nucl_num, 0:cord_num, walk_num)
double precision      , intent(out) :: delta_een_gl(4, elec_num, walk_num)  

integer*8 :: i, a, j, l, k, p, m, n, nw, kk
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_gl = 0.0d0


if (cord_num == 0) return

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

   do a = 1, nucl_num
     cn = c_vector_full(a, n)
      if(cn == 0.d0) cycle
   do kk = 1, 4
   do i = 1, elec_num
   delta_een_gl(kk,i,nw) = delta_een_gl(kk,i,nw) + ( &
                 delta_p(i,a,m,k,nw) * een_rescaled_n_gl(i,kk,a,m+l,nw) + &
                 (delta_p_gl(kk,i,a,m,k,nw)) * een_rescaled_n(i,a,m+l,nw) + &
                 (delta_p_gl(kk,i,a,m+l,k,nw)) * een_rescaled_n(i,a,m,nw) + &
                 delta_p(i,a,m+l,k,nw) * een_rescaled_n_gl(i,kk,a,m,nw)  &
                 ) * cn
   end do
   delta_een_gl(kk,num,nw) = delta_een_gl(kk,num,nw) + ( &
       (tmp_c(num,a,m,k,nw) + delta_p(num,a,m,k,nw)) * (een_rescaled_delta_n_gl(kk,a,m+l,nw) - een_rescaled_n_gl(num,kk,a,m+l,nw)) + &
       (dtmp_c(num,kk,a,m,k,nw) + delta_p_gl(kk,num, a,m,k,nw)) * een_rescaled_delta_n(a,m+l,nw) + &
       (dtmp_c(num,kk,a,m+l,k,nw) + delta_p_gl(kk,num,a,m+l,k,nw)) * een_rescaled_delta_n(a,m  ,nw) + &
       (tmp_c(num,a,m+l,k,nw) + delta_p(num,a,m+l,k,nw)) * (een_rescaled_delta_n_gl(kk,a,m,nw) - een_rescaled_n_gl(num,kk,a,m,nw)) &
   ) * cn
   end do
   end do
end do
end do

end function qmckl_compute_jastrow_champ_factor_single_een_gl_doc_f

ee distance rescaled single point gl

Get

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

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`num`	`int64_t`	in	Number of electrons
`elec_num`	`int64_t`	in	Number of electrons
`rescale_factor_ee`	`double`	in	Factor to rescale ee distances
`walk_num`	`int64_t`	in	Number of walkers
`single_ee_distance`	`double[elec_num][walk_num]`	in	Electron coordinates
`elec_coord`	`double[3][walk_num][elec_num]`	in	Electron coordinates
`coord`	`double[3]`	in	Electron coordinates
`ee_rescaled_single_gl`	`double[walk_num][elec_num][4]`	out	Electron-electron rescaled distance derivatives

function qmckl_compute_ee_rescaled_single_gl_doc(context, num,  &
elec_num, rescale_factor_ee, walk_num, single_ee_distance, elec_coord, coord, ee_rescaled_single_gl) &
bind(C) result(info)
use qmckl
implicit none

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

integer*8 :: nw, i, ii
double precision :: rij_inv, elel_dist_gl(4, 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_single_gl = 0.0d0
do nw = 1, walk_num

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

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

   ee_rescaled_single_gl(4, i, nw) = ee_rescaled_single_gl(4, i, nw) &
         + ee_rescaled_single_gl(1, i, nw) * ee_rescaled_single_gl(1, i, nw) * kappa_l &
         + ee_rescaled_single_gl(2, i, nw) * ee_rescaled_single_gl(2, i, nw) * kappa_l &
         + ee_rescaled_single_gl(3, i, nw) * ee_rescaled_single_gl(3, i, nw) * kappa_l

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

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


end function qmckl_compute_ee_rescaled_single_gl_doc

en distance rescaled single point gl

Get

qmckl_exit_code qmckl_get_en_rescaled_single_gl(qmckl_context context, double* distance_rescaled_gl);

Provide

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`nucl_num`	`int64_t`	in	Number of nuclei
`type_nucl_num`	`int64_t`	in	Number of nucleus types
`type_nucl_vector`	`int64_t[nucl_num]`	in	Array of nucleus types
`rescale_factor_en`	`double[nucl_num]`	in	The factors for rescaled distances
`walk_num`	`int64_t`	in	Number of walkers
`single_en_distance`	`double[walk_num][nucl_num]`	in	Electron coordinates
`coord`	`double[3]`	in	Electron coordinates
`nucl_coord`	`double[3][nucl_num]`	in	Electron coordinates
`en_rescaled_single_gl`	`double[walk_num][nucl_num][4]`	out	Electron-nucleus distance derivatives

integer function qmckl_compute_en_rescaled_single_gl_doc_f(context, nucl_num, &
type_nucl_num, type_nucl_vector, rescale_factor_en, walk_num, &
single_en_distance, coord, nucl_coord, en_rescaled_single_gl) &
result(info)
use qmckl
implicit none
integer(qmckl_context), intent(in)  :: context
integer*8             , intent(in)  :: nucl_num
integer*8             , intent(in)  :: type_nucl_num
integer*8             , intent(in)  :: type_nucl_vector(nucl_num)
double precision      , intent(in)  :: rescale_factor_en(nucl_num)
integer*8             , intent(in)  :: walk_num
double precision      , intent(in)  :: single_en_distance(nucl_num, walk_num)
double precision      , intent(in)  :: coord(3)
double precision      , intent(in)  :: nucl_coord(nucl_num,3)
double precision      , intent(out) :: en_rescaled_single_gl(4,nucl_num,walk_num)

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

info = QMCKL_SUCCESS

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


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

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


en_rescaled_single_gl = 0.0d0
do nw = 1, walk_num

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

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

   en_rescaled_single_gl(4, a, nw) = en_rescaled_single_gl(4, a, nw)           &
         + en_rescaled_single_gl(1, a, nw) * en_rescaled_single_gl(1, a, nw) * kappa_l &
         + en_rescaled_single_gl(2, a, nw) * en_rescaled_single_gl(2, a, nw) * kappa_l &
         + en_rescaled_single_gl(3, a, nw) * en_rescaled_single_gl(3, a, nw) * kappa_l

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

end do


end function qmckl_compute_en_rescaled_single_gl_doc_f

Delta ee gl

Get

qmckl_exit_code
qmckl_get_jastrow_champ_single_ee_gl(qmckl_context context,
                               double* const delta_ee_gl,
                               const int64_t size_max);

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

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`num`	`int64_t`	in	Number of walkers
`walk_num`	`int64_t`	in	Number of walkers
`elec_num`	`int64_t`	in	Number of electrons
`up_num`	`int64_t`	in	Number of alpha electrons
`bord_num`	`int64_t`	in	Number of coefficients
`b_vector`	`double[bord_num+1]`	in	List of coefficients
`ee_distance_rescaled`	`double[walk_num][elec_num][elec_num]`	in	Electron-electron distances
`ee_distance_rescaled_gl`	`double[walk_num][4][elec_num][elec_num]`	in	Electron-electron distances
`ee_rescaled_single`	`double[walk_num][elec_num]`	in	Electron-electron distances
`ee_rescaled_single_gl`	`double[walk_num][4][elec_num]`	in	Electron-electron distances
`spin_independent`	`int32_t`	in	If 1, same parameters for parallel and antiparallel spins
`delta_ee_gl`	`double[walk_num][elec_num][4]`	out	Electron-electron distances

function qmckl_compute_jastrow_champ_single_ee_gl_doc( &
context, num, walk_num, elec_num, up_num, bord_num, &
b_vector, ee_distance_rescaled, ee_distance_rescaled_gl,  &
ee_rescaled_single, ee_rescaled_single_gl,  &
spin_independent, delta_ee_gl) &
bind(C) result(info)
use qmckl
implicit none

integer (qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in)  , value :: num
integer (c_int64_t) , intent(in)  , value :: walk_num
integer (c_int64_t) , intent(in)  , value :: elec_num
integer (c_int64_t) , intent(in)  , value :: up_num
integer (c_int64_t) , intent(in)  , value :: bord_num
real    (c_double ) , intent(in)          :: b_vector(bord_num+1)
real    (c_double ) , intent(in)          :: ee_distance_rescaled(elec_num,elec_num,walk_num)
real    (c_double ) , intent(in)          :: ee_distance_rescaled_gl(4,elec_num,elec_num,walk_num)
real    (c_double ) , intent(in)          :: ee_rescaled_single(elec_num,walk_num)
real    (c_double ) , intent(in)          :: ee_rescaled_single_gl(4,elec_num,walk_num)
integer (c_int32_t) , intent(in)  , value :: spin_independent
real    (c_double ) , intent(out)         :: delta_ee_gl(4,elec_num,walk_num)
integer(qmckl_exit_code)                  :: info

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

info = QMCKL_SUCCESS

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

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

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

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

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

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

   do i = 1, elec_num
      if (i == num) cycle

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

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

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

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

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

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

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

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


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

     delta_ee_gl(4,i,nw) = delta_ee_gl(4,i,nw) * 2

   end do

end do

end function qmckl_compute_jastrow_champ_single_ee_gl_doc

qmckl_exit_code
qmckl_compute_jastrow_champ_single_ee_gl_doc (const qmckl_context context,
                                         const int64_t num,
                                         const int64_t walk_num,
                                         const int64_t elec_num,
                                         const int64_t up_num,
                                         const int64_t bord_num,
                                         const double* b_vector,
                                         const double* ee_distance_rescaled,
                                         const double* ee_distance_rescaled_gl,
                                         const double* ee_rescaled_single,
                                         const double* ee_rescaled_single_gl,
                                         const int32_t spin_independent,
                                         double* const delta_ee_gl );

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

Delta en gl

Get

qmckl_exit_code
qmckl_get_jastrow_champ_single_en_gl(qmckl_context context,
                               double* const delta_en_gl,
                               const int64_t size_max);

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

** Provide :noexport:

Compute

Variable	Type	In/Out	Description
`context`	`qmckl_context`	in	Global state
`wnum`	`int64_t`	in	Number of walkers
`walk_num`	`int64_t`	in	Number of walkers
`elec_num`	`int64_t`	in	Number of electrons
`nucl_num`	`int64_t`	in	Number of nuclei
`type_nucl_num`	`int64_t`	in	Number of unique nuclei
`type_nucl_vector`	`int64_t[nucl_num]`	in	IDs of unique nuclei
`aord_num`	`int64_t`	in	Number of coefficients
`a_vector`	`double[type_nucl_num][aord_num+1]`	in	List of coefficients
`en_distance_rescaled`	`double[walk_num][nucl_num][elec_num]`	in	Electron-nucleus distances
`en_distance_rescaled_gl`	`double[walk_num][nucl_num][elec_num][4]`	in	Electron-nucleus distance derivatives
`en_rescaled_single`	`double[walk_num][nucl_num]`	in	Electron-nucleus distances
`en_rescaled_single_gl`	`double[walk_num][nucl_num][4]`	in	Electron-nucleus distance derivatives
`delta_en_gl`	`double[walk_num][elec_num][4]`	out	Electron-nucleus jastrow

function qmckl_compute_jastrow_champ_single_en_gl_doc( &
context, num, walk_num, elec_num, nucl_num, type_nucl_num, &
type_nucl_vector, aord_num, a_vector, &
en_distance_rescaled, en_distance_rescaled_gl, en_rescaled_single, en_rescaled_single_gl, delta_en_gl) &
bind(C) result(info)
use qmckl
implicit none

integer (qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in)  , value :: num
integer (c_int64_t) , intent(in)  , value :: walk_num
integer (c_int64_t) , intent(in)  , value :: elec_num
integer (c_int64_t) , intent(in)  , value :: nucl_num
integer (c_int64_t) , intent(in)  , value :: type_nucl_num
integer (c_int64_t) , intent(in)          :: type_nucl_vector(nucl_num)
integer (c_int64_t) , intent(in)  , value :: aord_num
real    (c_double ) , intent(in)          :: a_vector(aord_num+1,type_nucl_num)
real    (c_double ) , intent(in)          :: en_distance_rescaled(elec_num,nucl_num,walk_num)
real    (c_double ) , intent(in)          :: en_distance_rescaled_gl(4, elec_num,nucl_num,walk_num)
real    (c_double ) , intent(in)          :: en_rescaled_single(nucl_num,walk_num)
real    (c_double ) , intent(in)          :: en_rescaled_single_gl(4, nucl_num,walk_num)
real    (c_double ) , intent(out)         :: delta_en_gl(4,elec_num,walk_num)
integer(qmckl_exit_code)                   :: info

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

info = QMCKL_SUCCESS

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

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

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

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

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


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

do a = 1, nucl_num

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


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

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

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

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

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

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

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


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

end function qmckl_compute_jastrow_champ_single_en_gl_doc

230 KiB Raw Blame History

CHAMP Jastrow Factor Single

Introduction

Context

Data structure

Single point

Set

Electron-electron distances single point

Get

Compute

ee distance rescaled single point

Get

Compute

Electron-nucleus distances single point

Get

Compute

en distance rescaled single point

Get

Compute

Delta p

provide

Compute

Delta e-e-n

get

Compute

ee distance rescaled single point

Get

Compute

en distance rescaled single point

Get

Compute

Delta ee

Get

Compute

Compute

En rescaled derivative een

Get

Compute

EE rescaled distance derivative for een

Get

Compute

gl delta p

provide

Compute

Delta grad e-e-n

get

Compute

ee distance rescaled single point gl

Get

Compute

en distance rescaled single point gl

Get

Provide

Compute

Delta ee gl

Get

Compute

Delta en gl

Get

Compute

230 KiB

Raw Blame History