TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2025-04-29 20:04:50 +02:00
Code Issues Projects Releases Wiki Activity
qmckl/org/qmckl_jastrow_champ_single.org
Emiel Slootman 040b7a3fe9 optimizations
2025-02-10 16:43:38 +01:00

8937 lines
360 KiB
Org Mode
Raw Blame History

#+TITLE: CHAMP Jastrow Factor Single
#+SETUPFILE: ../tools/theme.setup
#+INCLUDE: ../tools/lib.org
* Introduction
Single-electron move version of the Jastrow factor functions. The single-electron move calculates the difference between the old Jastrow values, gradients and derivatives and the new ones (if the single electron would have been moved).
That is to say, it calculates
\[
\delta J = J(\mathbf{r}^\prime,\mathbf{R}) - J(\mathbf{r},\mathbf{R})
\]
for all the neccessery quantities.
* Headers :noexport:
#+begin_src elisp :noexport :results none
(org-babel-lob-ingest "../tools/lib.org")
#+end_src
#+begin_src c :tangle (eval h_private_func)
#ifndef QMCKL_JASTROW_CHAMP_SINGLE_HPF
#define QMCKL_JASTROW_CHAMP_SINGLE_HPF
#+end_src
#+begin_src c :tangle (eval h_private_type)
#ifndef QMCKL_JASTROW_CHAMP_SINGLE_HPT
#define QMCKL_JASTROW_CHAMP_SINGLE_HPT
#include <stdbool.h>
#+end_src
#+begin_src c :tangle (eval c_test) :noweb yes
#include "qmckl.h"
#include <assert.h>
#include <math.h>
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdbool.h>
#include <stdio.h>
#include "n2.h"
#include "qmckl_jastrow_champ_private_func.h"
#include "qmckl_jastrow_champ_single_private_func.h"
int main() {
qmckl_context context;
context = qmckl_context_create();
#+end_src
#+begin_src c :tangle (eval c)
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#ifdef HAVE_STDINT_H
#include <stdint.h>
#elif HAVE_INTTYPES_H
#include <inttypes.h>
#endif
#include <stdlib.h>
#include <string.h>
#include <stdbool.h>
#include <assert.h>
#include <math.h>
#include <stdio.h>
#include "qmckl.h"
#include "qmckl_context_private_type.h"
#include "qmckl_memory_private_type.h"
#include "qmckl_memory_private_func.h"
#include "qmckl_jastrow_champ_private_type.h"
#include "qmckl_jastrow_champ_private_func.h"
#include "qmckl_jastrow_champ_single_private_type.h"
#include "qmckl_jastrow_champ_single_private_func.h"
#+end_src
* Context
** Data structure
#+begin_src c :comments org :tangle (eval h_private_type)
typedef struct qmckl_jastrow_champ_single_struct{
int64_t num;
uint64_t date;
qmckl_matrix coord;
double * een_rescaled_single_e;
uint64_t een_rescaled_single_e_date;
uint64_t een_rescaled_single_e_maxsize;
double * een_rescaled_single_n;
uint64_t een_rescaled_single_n_date;
uint64_t een_rescaled_single_n_maxsize;
double* single_ee_distance;
uint64_t single_ee_distance_date;
uint64_t single_ee_distance_maxsize;
double* single_en_distance;
uint64_t single_en_distance_date;
uint64_t single_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_single;
uint64_t ee_rescaled_single_date;
uint64_t ee_rescaled_single_maxsize;
double* en_rescaled_single;
uint64_t en_rescaled_single_date;
uint64_t en_rescaled_single_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_single_e_gl;
uint64_t een_rescaled_single_e_gl_date;
uint64_t een_rescaled_single_e_gl_maxsize;
double * een_rescaled_single_n_gl;
uint64_t een_rescaled_single_n_gl_date;
uint64_t een_rescaled_single_n_gl_maxsize;
double* delta_p_gl;
uint64_t delta_p_gl_date;
uint64_t delta_p_gl_maxsize;
double* delta_p_g;
uint64_t delta_p_g_date;
uint64_t delta_p_g_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_single_gl;
uint64_t ee_rescaled_single_gl_date;
uint64_t ee_rescaled_single_gl_maxsize;
double* en_rescaled_single_gl;
uint64_t en_rescaled_single_gl_date;
uint64_t en_rescaled_single_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;
} qmckl_jastrow_champ_single_struct;
#+end_src
** Test :noexport:
#+begin_src c :tangle (eval c_test)
/* Reference input data */
int64_t walk_num = n2_walk_num;
int64_t elec_num = n2_elec_num;
int64_t elec_up_num = n2_elec_up_num;
int64_t elec_dn_num = n2_elec_dn_num;
int64_t nucl_num = n2_nucl_num;
double rescale_factor_ee = 0.6;
double rescale_factor_en[2] = { 0.6, 0.6 };
double* elec_coord = &(n2_elec_coord[0][0][0]);
const double* nucl_charge = n2_charge;
double* nucl_coord = &(n2_nucl_coord[0][0]);
/* Provide Electron data */
qmckl_exit_code rc;
assert(!qmckl_electron_provided(context));
rc = qmckl_check(context,
qmckl_set_electron_num (context, elec_up_num, elec_dn_num)
);
assert(rc == QMCKL_SUCCESS);
assert(qmckl_electron_provided(context));
rc = qmckl_check(context,
qmckl_set_electron_coord (context, 'N', walk_num, elec_coord, walk_num*3*elec_num)
);
assert(rc == QMCKL_SUCCESS);
double elec_coord2[walk_num*3*elec_num];
rc = qmckl_check(context,
qmckl_get_electron_coord (context, 'N', elec_coord2, walk_num*3*elec_num)
);
assert(rc == QMCKL_SUCCESS);
for (int64_t i=0 ; i<3*elec_num ; ++i) {
assert( elec_coord[i] == elec_coord2[i] );
}
/* Provide Nucleus data */
assert(!qmckl_nucleus_provided(context));
rc = qmckl_check(context,
qmckl_set_nucleus_num (context, nucl_num)
);
assert(rc == QMCKL_SUCCESS);
assert(!qmckl_nucleus_provided(context));
double nucl_coord2[3*nucl_num];
rc = qmckl_get_nucleus_coord (context, 'T', nucl_coord2, 3*nucl_num);
assert(rc == QMCKL_NOT_PROVIDED);
rc = qmckl_check(context,
qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0]), 3*nucl_num)
);
assert(rc == QMCKL_SUCCESS);
assert(!qmckl_nucleus_provided(context));
rc = qmckl_check(context,
qmckl_get_nucleus_coord (context, 'N', nucl_coord2, nucl_num*3)
);
assert(rc == QMCKL_SUCCESS);
for (int64_t k=0 ; k<3 ; ++k) {
for (int64_t i=0 ; i<nucl_num ; ++i) {
assert( nucl_coord[nucl_num*k+i] == nucl_coord2[3*i+k] );
}
}
rc = qmckl_check(context,
qmckl_get_nucleus_coord (context, 'T', nucl_coord2, nucl_num*3)
);
assert(rc == QMCKL_SUCCESS);
for (int64_t i=0 ; i<3*nucl_num ; ++i) {
assert( nucl_coord[i] == nucl_coord2[i] );
}
double nucl_charge2[nucl_num];
rc = qmckl_get_nucleus_charge(context, nucl_charge2, nucl_num);
assert(rc == QMCKL_NOT_PROVIDED);
rc = qmckl_check(context,
qmckl_set_nucleus_charge(context, nucl_charge, nucl_num)
);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_check(context,
qmckl_get_nucleus_charge(context, nucl_charge2, nucl_num)
);
assert(rc == QMCKL_SUCCESS);
for (int64_t i=0 ; i<nucl_num ; ++i) {
assert( nucl_charge[i] == nucl_charge2[i] );
}
assert(qmckl_nucleus_provided(context));
assert(qmckl_electron_provided(context));
int64_t type_nucl_num = n2_type_nucl_num;
int64_t* type_nucl_vector = &(n2_type_nucl_vector[0]);
int64_t aord_num = n2_aord_num;
int64_t bord_num = n2_bord_num;
int64_t cord_num = n2_cord_num;
double* a_vector = &(n2_a_vector[0][0]);
double* b_vector = &(n2_b_vector[0]);
double* c_vector = &(n2_c_vector[0][0]);
int64_t dim_c_vector=0;
assert(!qmckl_jastrow_champ_provided(context));
/* Set the data */
rc = qmckl_check(context,
qmckl_set_jastrow_champ_spin_independent(context, 0)
);
rc = qmckl_check(context,
qmckl_set_jastrow_champ_aord_num(context, aord_num)
);
rc = qmckl_check(context,
qmckl_set_jastrow_champ_bord_num(context, bord_num)
);
rc = qmckl_check(context,
qmckl_set_jastrow_champ_cord_num(context, cord_num)
);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_check(context,
qmckl_set_jastrow_champ_type_nucl_num(context, type_nucl_num)
);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_check(context,
qmckl_set_jastrow_champ_type_nucl_vector(context, type_nucl_vector, nucl_num)
);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_check(context,
qmckl_set_jastrow_champ_a_vector(context, a_vector,(aord_num+1)*type_nucl_num)
);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_check(context,
qmckl_set_jastrow_champ_b_vector(context, b_vector,(bord_num+1))
);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_check(context,
qmckl_get_jastrow_champ_dim_c_vector(context, &dim_c_vector)
);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_check(context,
qmckl_set_jastrow_champ_c_vector(context, c_vector, dim_c_vector*type_nucl_num)
);
assert(rc == QMCKL_SUCCESS);
double k_ee = 0.;
double k_en[2] = { 0., 0. };
rc = qmckl_check(context,
qmckl_set_jastrow_champ_rescale_factor_en(context, rescale_factor_en, type_nucl_num)
);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_check(context,
qmckl_set_jastrow_champ_rescale_factor_ee(context, rescale_factor_ee)
);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_check(context,
qmckl_get_jastrow_champ_rescale_factor_ee (context, &k_ee)
);
assert(rc == QMCKL_SUCCESS);
assert(k_ee == rescale_factor_ee);
rc = qmckl_check(context,
qmckl_get_jastrow_champ_rescale_factor_en (context, &(k_en[0]), type_nucl_num)
);
assert(rc == QMCKL_SUCCESS);
for (int i=0 ; i<type_nucl_num ; ++i) {
assert(k_en[i] == rescale_factor_en[i]);
}
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double new_coords[6] = {1.0,2.0,3.0,4.0,5.0,6.0};
double coords[walk_num][elec_num][3];
#+end_src
* Single point
** 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.
#+begin_src c :comments org :tangle (eval h_func)
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);
#+end_src
The Fortran function shifts the ~num~ by 1 because of 1-based
indexing.
#+begin_src c :comments org :tangle (eval h_private_func)
qmckl_exit_code qmckl_set_single_point_f (qmckl_context context,
const char transp,
const int64_t num,
const double* coord,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes
qmckl_exit_code
qmckl_set_single_point (qmckl_context context,
const char transp,
const int64_t num,
const double* coord,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
if (num < 0) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_set_single_point",
"Incorrect point number");
}
if (transp != 'N' && transp != 'T') {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_set_single_point",
"transp should be 'N' or 'T'");
}
if (coord == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_set_single_point",
"coord is a NULL pointer");
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
int64_t walk_num = ctx->electron.walker.num;
if (size_max < 3*walk_num) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_4,
"qmckl_set_single_point",
"Array too small");
}
qmckl_exit_code rc;
//if (ctx->single_point.coord.data != NULL) {
// rc = qmckl_matrix_free(context, &(ctx->single_point.coord));
// assert (rc == QMCKL_SUCCESS);
//}
if (ctx->single_point.coord.data == NULL) {
ctx->single_point.coord = qmckl_matrix_alloc(context, walk_num, 3);
if (ctx->single_point.coord.data == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_set_single_point",
NULL);
}
}
ctx->single_point.num = num;
if (transp == 'N') {
double *a = ctx->single_point.coord.data;
for (int64_t i=0 ; i<3*walk_num ; ++i) {
a[i] = coord[i];
}
} else {
for (int64_t i=0 ; i<walk_num ; ++i) {
qmckl_mat(ctx->single_point.coord, i, 0) = coord[i*walk_num + 0];
qmckl_mat(ctx->single_point.coord, i, 1) = coord[i*walk_num + 1];
qmckl_mat(ctx->single_point.coord, i, 2) = coord[i*walk_num + 2];
}
}
/* Increment the date of the single point */
ctx->single_point.date += 1UL;
return QMCKL_SUCCESS;
}
qmckl_exit_code
qmckl_set_single_point_f (qmckl_context context,
const char transp,
const int64_t num,
const double* coord,
const int64_t size_max)
{
return qmckl_set_single_point(context, transp, num-1, coord, size_max);
}
#+end_src
#+begin_src f90 :comments org :tangle (eval fh_func) :noweb yes
interface
integer(qmckl_exit_code) function qmckl_set_single_point(context, &
transp, num, coord, size_max) bind(C, name="qmckl_set_single_point_f")
use, intrinsic :: iso_c_binding
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
character(c_char) , intent(in) , value :: transp
integer (c_int64_t) , intent(in) , value :: num
real (c_double ) , intent(in) :: coord(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function
end interface
#+end_src
** Touch
#+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_single_touch (const qmckl_context context);
#+end_src
#+begin_src c :tangle (eval c) :exports none
qmckl_exit_code
qmckl_single_touch(const qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_single_touch",
NULL);
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
ctx->date += 1UL;
ctx->point.date = ctx-> date;
ctx->electron.walker.point.date = ctx-> date;
ctx->single_point.date = ctx-> date;
return QMCKL_SUCCESS;
}
#+end_src
* Electron-electron and electron-nucleus distances for single point
In order to calculate the $\delta J$, we need to have to updated distances for the single electron.
** Electron-electron distances
Electron-electron distance between the single electron and all
electrons for all walkers.
Dimension is ~[walk_num][elec_num]~.
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code qmckl_get_single_electron_ee_distance(qmckl_context context,
double* const distance,
const int64_t size_max);
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
integer(qmckl_exit_code) function qmckl_get_single_electron_ee_distance(context, distance, size_max) &
bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
real (c_double ) , intent(out) :: distance(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function
end interface
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_single_electron_ee_distance(qmckl_context context,
double* const distance,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_single_ee_distance(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
if (distance == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_get_single_electron_ee_distance",
"distance is a NULL pointer");
}
int64_t sze = ctx->electron.num * ctx->electron.walker.num;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_single_electron_ee_distance",
"Array too small. Expected ctx->electron.num * ctx->electron.walker.num");
}
memcpy(distance, ctx->single_point.single_ee_distance, sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
*** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_single_ee_distance(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_single_ee_distance(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.single_ee_distance_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->electron.num * ctx->electron.walker.num * sizeof(double);
if (mem_info.size > ctx->single_point.single_ee_distance_maxsize) {
if (ctx->single_point.single_ee_distance != NULL) {
rc = qmckl_free(context, ctx->single_point.single_ee_distance);
assert(rc == QMCKL_SUCCESS);
ctx->single_point.single_ee_distance = NULL;
}
}
/* Allocate array */
if (ctx->single_point.single_ee_distance == NULL) {
double* single_ee_distance = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.single_ee_distance_maxsize = mem_info.size;
if (single_ee_distance == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_single_ee_distance",
NULL);
}
ctx->single_point.single_ee_distance = single_ee_distance;
}
rc =
qmckl_compute_single_ee_distance(context,
ctx->single_point.num,
ctx->electron.num,
ctx->electron.walker.num,
ctx->electron.walker.point.coord.data,
ctx->single_point.coord.data,
ctx->single_point.single_ee_distance);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.single_ee_distance_date = ctx->single_point.date;
}
//printf("single_ee_distance_date %u\n", ctx->single_point.single_ee_distance_date);
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_single_ee_distance
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_single_ee_distance_args
|----------------------+---------------------------------+--------+-------------------------------------------------|
| Variable | Type | In/Out | Description |
|----------------------+---------------------------------+--------+-------------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~num~ | ~int64_t~ | in | Index of single 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 |
| ~single_coord~ | ~double[walk_num][3]~ | in | Single electron coordinates |
| ~single_ee_distance~ | ~double[walk_num][elec_num]~ | out | Electron-electron distances for single electron |
|----------------------+---------------------------------+--------+-------------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer(qmckl_exit_code) function qmckl_compute_single_ee_distance(context, &
num_in, elec_num, walk_num, coord, single_coord, single_ee_distance) &
result(info) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in) :: context
integer (c_int64_t) , intent(in) , value :: elec_num, num_in
integer (c_int64_t) , intent(in) , value :: walk_num
real (c_double ) , intent(in) :: coord(elec_num,walk_num,3)
real (c_double ) , intent(in) :: single_coord(3,walk_num)
real (c_double ) , intent(out) :: single_ee_distance(elec_num,walk_num)
integer*8 :: k, i, j, num
double precision :: x, y, z
info = QMCKL_SUCCESS
num = num_in + 1
if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif
if (elec_num <= 0) then
info = QMCKL_INVALID_ARG_2
return
endif
if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif
do k=1,walk_num
info = qmckl_distance(context, 'T', 'N', elec_num, 1_8, &
coord(1,k,1), elec_num*walk_num, &
single_coord(1,k), 3_8, &
single_ee_distance(1,k), elec_num)
if (info /= QMCKL_SUCCESS) then
exit
endif
single_ee_distance(num,k) = 0.0d0
end do
end function qmckl_compute_single_ee_distance
#+end_src
#+begin_src c :tangle (eval h_private_func) :comments org :exports none
qmckl_exit_code qmckl_compute_single_ee_distance (
const qmckl_context context,
const int64_t num,
const int64_t elec_num,
const int64_t walk_num,
const double* coord,
const double* single_coord,
double* const single_ee_distance );
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("Single e-e distance\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double ee_distance[walk_num][elec_num][elec_num];
double single_ee_distance[walk_num][elec_num];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
double ee_distance[walk_num][elec_num][elec_num];
rc = qmckl_get_electron_ee_distance(context, &ee_distance[0][0][0], walk_num*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
double single_ee_distance[walk_num][elec_num];
rc = qmckl_get_single_electron_ee_distance(context,&single_ee_distance[0][0],walk_num*elec_num);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_ee_distance(context, &ee_distance[0][0][0], walk_num*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++){
for (int i = 0; i < elec_num; i++) {
if (i == elec) continue;
assert(fabs((ee_distance[nw][elec][i]-single_ee_distance[nw][i])) < 1.e-12);
assert(fabs((ee_distance[nw][i][elec]-single_ee_distance[nw][i])) < 1.e-12);
}
}
}
printf("OK\n");
#+end_src
** Electron-nucleus distances
*** Get
Electron-nucleus distance between the single electron and all
nuclei for all walkers.
Dimension is ~[walk_num][nucl_num]~.
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_single_electron_en_distance(qmckl_context context,
double* distance,
const int64_t size_max);
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
integer(qmckl_exit_code) function qmckl_get_single_electron_en_distance(context, distance, size_max) &
bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
real (c_double ) , intent(out) :: distance(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function
end interface
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_single_electron_en_distance(qmckl_context context,
double* distance,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_single_en_distance(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
if (distance == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_get_single_electron_en_distance",
"distance is a NULL pointer");
}
int64_t sze = ctx->nucleus.num * ctx->electron.walker.num;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_single_electron_en_distance",
"Array too small. Expected ctx->nucleus.num * ctx->electron.walker.num");
}
memcpy(distance, ctx->single_point.single_en_distance, sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
*** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_single_en_distance(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_single_en_distance(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
if (!(ctx->nucleus.provided)) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_provide_single_en_distance",
NULL);
}
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.single_en_distance_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->nucleus.num * ctx->electron.walker.num * sizeof(double);
if (mem_info.size > ctx->single_point.single_en_distance_maxsize) {
if (ctx->single_point.single_en_distance != NULL) {
rc = qmckl_free(context, ctx->single_point.single_en_distance);
assert (rc == QMCKL_SUCCESS);
ctx->single_point.single_en_distance = NULL;
}
}
/* Allocate array */
if (ctx->single_point.single_en_distance == NULL) {
double* single_en_distance = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.single_en_distance_maxsize = mem_info.size;
if (single_en_distance == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_single_en_distance",
NULL);
}
ctx->single_point.single_en_distance = single_en_distance;
}
qmckl_exit_code rc =
qmckl_compute_single_en_distance(context,
ctx->nucleus.num,
ctx->electron.walker.num,
ctx->single_point.coord.data,
ctx->nucleus.coord.data,
ctx->single_point.single_en_distance);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.single_en_distance_date = ctx->single_point.date;
}
// printf("single_en_distance_date %u\n", ctx->single_point.single_en_distance_date);
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_single_en_distance
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_single_en_distance_args
|----------------------+-----------------------+--------+------------------------------------------------|
| Variable | Type | In/Out | Description |
|----------------------+-----------------------+--------+------------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~nucl_num~ | ~int64_t~ | in | Number of nuclei |
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
| ~elec_coord~ | ~double[3][walk_num]~ | in | Electron coordinates |
| ~nucl_coord~ | ~double[3][nucl_num]~ | in | Nuclear coordinates |
| ~single_en_distance~ | ~double[nucl_num]~ | out | Electron-nucleus distances for single-electron |
|----------------------+-----------------------+--------+------------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer function qmckl_compute_single_en_distance(context, nucl_num, walk_num, &
elec_coord, nucl_coord, single_en_distance) result(info) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in) :: context
integer (c_int64_t) , intent(in) , value :: nucl_num, walk_num
real (c_double ) , intent(in) :: elec_coord(3,walk_num)
real (c_double ) , intent(in) :: nucl_coord(nucl_num,3)
real (c_double ) , intent(out) :: single_en_distance(nucl_num, walk_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', 'N', nucl_num, walk_num, &
nucl_coord, nucl_num, &
elec_coord, 3_8, &
single_en_distance, nucl_num)
end function qmckl_compute_single_en_distance
#+end_src
#+begin_src c :tangle (eval h_private_func) :comments org :exports none
qmckl_exit_code qmckl_compute_single_en_distance (
const qmckl_context context,
const int64_t nucl_num,
const int64_t walk_num,
const double* elec_coord,
const double* nucl_coord,
double* const single_en_distance );
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("Single e-n distance\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double en_distance[walk_num][elec_num][nucl_num];
double single_en_distance[walk_num][nucl_num];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_en_distance(context, &en_distance[0][0][0],walk_num*elec_num*nucl_num);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_single_electron_en_distance(context, &single_en_distance[0][0],nucl_num*walk_num);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_en_distance(context, &en_distance[0][0][0], walk_num*elec_num*nucl_num);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0 ; nw < walk_num ; nw++) {
for (int a = 0; a < nucl_num; a++){
assert(fabs((en_distance[nw][elec][a]-single_en_distance[nw][a])) < 1.e-12);
}
}
}
printf("OK\n");
#+end_src
* Electron-electron-nucleus Jastrow
Here we calculate the single electron contributions to the electron-electron-nucleus Jastrow term.
To start, we need to calculate the rescaled distances for the single electron electron-nucleus and electron-electron distances.
These rescaled distances are calculates by
\[
\widetilde{R}_{\alpha} = e^{-\kappa l R_{\alpha}} \quad \text{and} \quad \widetilde{r}_{i} = e^{-\kappa l r_{i}}.
\]
Here, $\kappa$ is the rescaling factor and $l$ the power. The neccessery powers are stored in the same array.
From these, we can calculate the $\delta \widetilde{R}$ and $\delta \widetilde{r}$ using
\begin{eqnarray*}
\delta \widetilde{R}_{\alpha} &=& \widetilde{R}_{\alpha}^\text{new} - \widetilde{R}_{\alpha}^\text{old} \quad \text{and}\\
\delta \widetilde{r}_{i} &=& \widetilde{r}_{i}^\text{new} - \widetilde{r}_{i}^\text{old}.
\end{eqnarray*}
With these, we can now calculate the single electron contribution to the $\delta P$ matrix, using the equation
\begin{eqnarray*}
\delta P_{i,\alpha,k,l} &=& P^{\text{new}}_{i,\alpha,k,l} - P^{\text{old}}_{i,\alpha,k,l}\\
&=& \sum_{j=1}^{N_\text{elec}} \left(\widetilde{r}_{i,j,k} \delta \widetilde{R}_{j,\alpha,l}\delta_{j,\text{num}} +
\delta \widetilde{r}_{i,j,k} \widetilde{R}_{j,\alpha,l} (\delta_{j,\text{num}}
+ \delta_{i,\text{num}}) + \delta \widetilde{r}_{i,j,k} \delta \widetilde{R}_{j,\alpha,l} \delta_{j,\text{num}}\right)\\
&=& \sum_{j=1}^{N_\text{elec}} \left( \delta \widetilde{r}_{\text{num},j,k} \widetilde{R}_{j,\alpha,l} \right)
+ \widetilde{r}_{i,\text{num},k} \delta \widetilde{R}_{\text{num},\alpha,l} + \delta \widetilde{r}_{i,\text{num},k} \left( \widetilde{R}_{\text{num},\alpha,l}
+ \delta \widetilde{R}_{\text{num},\alpha,l} \right).
\end{eqnarray*}
Then, the electron-electron-nucleus Jastrow value can be calculated by
\begin{eqnarray*}
J_{een} &=& J_{een}^{\text{new}} - J_{een}^{\text{old}}\\
&=&\sum_{p=2}^{N_\text{nord}} \sum_{k=0}^{p-1} \sum_{l=0}^{p-k-2\delta_{k,0}}\sum_{\alpha=1}^{N_\text{nucl}} c_{l,k,p,\alpha}
\sum_{i=1}^{N_\text{elec}} \left( \delta \widetilde{R}_{i,\alpha,(p-k-l)/2} P_{i,\alpha,k,(p-k+l)/2} \delta_{i,\text{num}}
+ \widetilde{R}_{i,\alpha,(p-k-l)/2} \delta P_{i,\alpha,k,(p-k+l)/2}
+ \delta \widetilde{R}_{i,\alpha,(p-k-l)/2} \delta P_{i,\alpha,k,(p-k+l)/2} \delta_{i,\text{num}} \right)\\
&=& \sum_{p=2}^{N_\text{nord}} \sum_{k=0}^{p-1} \sum_{l=0}^{p-k-2\delta_{k,0}}\sum_{\alpha=1}^{N_\text{nucl}} c_{l,k,p,\alpha} \left(
\sum_{i=1}^{N_\text{elec}} \left( \widetilde{R}_{i,\alpha,(p-k-l)/2} \delta P_{i,\alpha,k,(p-k+l)/2} \right)
+ \delta \widetilde{R}_{\text{num},\alpha,(p-k-l)/2} \left(P_{\text{num},\alpha,k,(p-k+l)/2} + \delta P_{\text{num},\alpha,k,(p-k+l)/2} \right)\right)
\end{eqnarray*}
To calculate the gradients and Laplacian of the electron-electron-nucleus Jastrow,
we first have to calculate the gradients and Laplacian of the rescaled distances,
\[
\partial_{i,m} \widetilde{R}_{\alpha} = -\kappa l e^{-\kappa l R_{\alpha}} \frac{x_m - X_{m,\alpha}}{R_\alpha} \quad \text{and} \quad
\partial_{i,4} \widetilde{R}_{\alpha} = -\kappa l \left(\frac{2}{R_\alpha}- \kappa l \right) e^{-\kappa l R_{\alpha}},
\]
where $i$ is the electron of which we are taking the derivative and $m=1:3$ are the gradients and $m=4$ is the Laplacian.
The derivatives of the single electron rescaled electron-nucleus distances are only nonzero when $i=\text{num}$.
Similarly for $r$ we get
\[
\partial_{i,m} \widetilde{r}_{i} = -\kappa l e^{-\kappa l r_{i}} \frac{x_m - X_{m,i}}{r_i} \quad \text{and} \quad
\partial_{i,4} \widetilde{r}_{i} = -\kappa l \left(\frac{2}{r_i}- \kappa l \right) e^{-\kappa l r_{i}}.
\]
With these, we can now calculate the gradient and Laplacian of the $\delta P$ matrix, using the equation
\begin{eqnarray*}
\partial_{i,m} \delta P_{i,\alpha,k,l} &=& \partial_{i,m} P_{i,\alpha,k,l}^\text{new} - \partial_{i,m} P_{i,\alpha,k,l}^\text{old}\\
&=& \partial_{i,m}\delta \widetilde{r}_{\text{num},i,k} \left(\partial_{i,m}\delta \widetilde{R}_{\text{num},\alpha,l} + \partial_{i,m}\widetilde{R}_{\text{num},\alpha,l} \right) g_m
+ \partial_{i,m}\widetilde{r}_{\text{num},i,k} \delta \widetilde{R}_{\text{num},\alpha,l}
+ \delta_{i,\text{num}} \sum_{j=1}^{N_\text{elec}} \left( \partial_{j,m} \delta \widetilde{r}_{\text{num},j,k} \widetilde{R}_{j,\alpha,l} \right),
\end{eqnarray*}
where $g_m = \{-1,-1,-1,1\}$.
Then, the gradient and Laplacian of the electron-electron-nucleus Jastrow value can be calculated by
\begin{eqnarray*}
\partial_{i,m} J_{een} &=& \partial_{i,m} J_{een}^{\text{new}} - \partial_{i,m} J_{een}^{\text{old}}\\
&=&\sum_{p=2}^{N_\text{nord}} \sum_{k=0}^{p-1} \sum_{l=0}^{p-k-2\delta_{k,0}}\sum_{\alpha=1}^{N_\text{nucl}} c_{l,k,p,\alpha}
\left( \widetilde{R}_{i,\alpha,(p-k-l)/2} \partial_{i,m} \delta P_{i,\alpha,k,(p-k+l)/2}
+ \widetilde{R}_{i,\alpha,(p-k+l)/2} \partial_{i,m} \delta P_{i,\alpha,k,(p-k-l)/2} \right. \\
& &\ + \partial_{i,m}\widetilde{R}_{i,\alpha,(p-k-l)/2} \delta P_{i,\alpha,k,(p-k+l)/2}
+ \partial_{i,m}\widetilde{R}_{i,\alpha,(p-k+l)/2} \delta P_{i,\alpha,k,(p-k-l)/2} \\
& &\ + \delta_{i,\text{num}} \left( \delta \widetilde{R}_{i,\alpha,(p-k-l)/2} \left ( \partial_{i,m} P_{i,\alpha,k,(p-k+l)/2} + \partial_{i,m} \delta P_{i,\alpha,k,(p-k+l)/2} \right)
+ \delta \widetilde{R}_{i,\alpha,(p-k+l)/2} \left ( \partial_{i,m} P_{i,\alpha,k,(p-k-l)/2} + \partial_{i,m} \delta P_{i,\alpha,k,(p-k-l)/2} \right) \right. \\
& &\ \left. + \partial_{i,m} \delta \widetilde{R}_{i,\alpha,(p-k-l)/2} \left ( P_{i,\alpha,k,(p-k+l)/2} + \delta P_{i,\alpha,k,(p-k+l)/2} \right)
+ \partial_{i,m} \delta \widetilde{R}_{i,\alpha,(p-k+l)/2} \left ( P_{i,\alpha,k,(p-k-l)/2} + \delta P_{i,\alpha,k,(p-k-l)/2} \right) \right)\\
& &\ + \delta_{m,4} \sum_{d=1}^3 \left( \partial_{i,d} \widetilde{R}_{i,\alpha,(p-k-l)/2} \partial_{i,d} \delta P_{i,\alpha,k,(p-k+l)/2}
+ \partial_{i,d} \widetilde{R}_{i,\alpha,(p-k+l)/2} \partial_{i,d} \delta P_{i,\alpha,k,(p-k-l)/2} \right)\\
& &\ \left. + \delta_{m,4}\delta_{i,\text{num}} \sum_{d=1}^3\left( \partial_{i,d}\delta \widetilde{R}_{i,\alpha,(p-k-l)/2} \left( \partial_{i,d} P_{i,\alpha,k,(p-k+l)/2} + \partial_{i,d}\delta P_{i,\alpha,k,(p-k+l)/2} \right)
+ \partial_{i,d}\delta \widetilde{R}_{i,\alpha,(p-k+l)/2} \left( \partial_{i,d} P_{i,\alpha,k,(p-k-l)/2} + \partial_{i,d} \delta P_{i,\alpha,k,(p-k-l)/2} \right) \right) \right)
\end{eqnarray*}
** Electron-electron rescaled distances
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_een_rescaled_single_e(qmckl_context context,
double* const distance_rescaled,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_een_rescaled_single_e(qmckl_context context,
double* const distance_rescaled,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_een_rescaled_single_e(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
int64_t sze = ctx->electron.num * ctx->electron.walker.num * (ctx->jastrow_champ.cord_num + 1);
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_een_rescaled_single_e",
"Array too small. Expected ctx->electron.num * ctx->electron.num * ctx->electron.walker.num * (ctx->jastrow_champ.cord_num + 1)");
}
memcpy(distance_rescaled, ctx->single_point.een_rescaled_single_e, sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
*** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_een_rescaled_single_e(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_een_rescaled_single_e(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
/* Check if ee distance is provided */
qmckl_exit_code rc = qmckl_provide_single_ee_distance(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Check if rescaled ee distance is provided */
rc = qmckl_provide_een_rescaled_e(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.een_rescaled_single_e_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->electron.num * ctx->electron.walker.num *
(ctx->jastrow_champ.cord_num + 1) * sizeof(double);
if (mem_info.size > ctx->single_point.een_rescaled_single_e_maxsize) {
if (ctx->single_point.een_rescaled_single_e!= NULL) {
rc = qmckl_free(context, ctx->single_point.een_rescaled_single_e);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_een_rescaled_single_e",
"Unable to free ctx->single_point.een_rescaled_single_e");
}
ctx->single_point.een_rescaled_single_e = NULL;
}
}
/* Allocate array */
if (ctx->single_point.een_rescaled_single_e == NULL) {
double* een_rescaled_single_e = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.een_rescaled_single_e_maxsize = mem_info.size;
if (een_rescaled_single_e == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_een_rescaled_single_e",
NULL);
}
ctx->single_point.een_rescaled_single_e = een_rescaled_single_e;
}
rc = qmckl_compute_een_rescaled_single_e(context,
ctx->single_point.num,
ctx->electron.walker.num,
ctx->electron.num,
ctx->jastrow_champ.cord_num,
ctx->jastrow_champ.rescale_factor_ee,
ctx->single_point.single_ee_distance,
ctx->jastrow_champ.een_rescaled_e,
ctx->single_point.een_rescaled_single_e);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.een_rescaled_single_e_date = ctx->single_point.date;
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_een_rescaled_single_e
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_factor_een_rescaled_single_e_args
|-------------------------+----------------------------------------------------+--------+-------------------------------------------------------------|
| 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 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 |
|-------------------------+----------------------------------------------------+--------+-------------------------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer function qmckl_compute_een_rescaled_single_e_doc( &
context, num_in, walk_num, elec_num, cord_num, rescale_factor_ee, &
single_ee_distance, een_rescaled_e, een_rescaled_single_e) &
result(info) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in) :: context
integer(c_int64_t) , intent(in), value :: num_in
integer(c_int64_t) , intent(in), value :: walk_num
integer(c_int64_t) , intent(in), value :: elec_num
integer(c_int64_t) , intent(in), value :: cord_num
real(c_double) , intent(in), value :: rescale_factor_ee
real(c_double) , intent(in) :: single_ee_distance(elec_num,walk_num)
real(c_double) , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num)
real(c_double) , intent(out) :: een_rescaled_single_e(elec_num,0:cord_num,walk_num)
double precision,allocatable :: een_rescaled_single_e_ij(:,:)
double precision :: x
integer*8 :: i, j, k, l, nw, num
num = num_in + 1
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif
if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_2
return
endif
if (elec_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif
if (cord_num < 0) then
info = QMCKL_INVALID_ARG_4
return
endif
allocate(een_rescaled_single_e_ij(elec_num, cord_num + 1))
! Prepare table of exponentiated distances raised to appropriate power
do nw = 1, walk_num
een_rescaled_single_e_ij(:, 1) = 1.0d0
do j = 1, elec_num
een_rescaled_single_e_ij(j, 2) = dexp(-rescale_factor_ee * single_ee_distance(j, nw))
end do
do l = 2, cord_num
do k = 1, elec_num
een_rescaled_single_e_ij(k, l + 1) = een_rescaled_single_e_ij(k, l) * een_rescaled_single_e_ij(k, 2)
end do
end do
! prepare the actual een table
een_rescaled_single_e(:,0,nw) = 1.0d0
do l = 1, cord_num
do j = 1, elec_num
x = een_rescaled_single_e_ij(j, l + 1)
een_rescaled_single_e(j, l, nw) = x
end do
end do
!een_rescaled_single_e(:,:,:) = een_rescaled_single_e(:,:,:) - een_rescaled_e(num,:,:,:)
een_rescaled_single_e(num, :, :) = 0.0d0
end do
end function qmckl_compute_een_rescaled_single_e_doc
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_compute_een_rescaled_single_e (
const qmckl_context context,
const int64_t num,
const int64_t walk_num,
const int64_t elec_num,
const int64_t cord_num,
const double rescale_factor_ee,
const double* single_ee_distance,
const double* een_rescaled_e,
double* const een_rescaled_single_e );
#+end_src
#+begin_src c :tangle (eval h_private_func) :comments org
qmckl_exit_code qmckl_compute_een_rescaled_single_e_doc (
const qmckl_context context,
const int64_t num,
const int64_t walk_num,
const int64_t elec_num,
const int64_t cord_num,
const double rescale_factor_ee,
const double* single_ee_distance,
const double* een_rescaled_e,
double* const een_rescaled_single_e );
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes
qmckl_exit_code
qmckl_compute_een_rescaled_single_e (const qmckl_context context,
const int64_t num,
const int64_t walk_num,
const int64_t elec_num,
const int64_t cord_num,
const double rescale_factor_ee,
const double* single_ee_distance,
const double* een_rescaled_e,
double* const een_rescaled_single_e )
{
#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);
}
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("Single een rescaled e-e distance\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double rescaled_een_ee_distance[walk_num][cord_num+1][elec_num][elec_num];
double single_rescaled_een_ee_distance[walk_num][cord_num+1][elec_num];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_een_rescaled_e(context, &rescaled_een_ee_distance[0][0][0][0], walk_num*(cord_num+1)*elec_num*elec_num);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_een_rescaled_single_e(context, &single_rescaled_een_ee_distance[0][0][0], walk_num*(cord_num+1)*elec_num);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_een_rescaled_e(context, &rescaled_een_ee_distance[0][0][0][0], walk_num*(cord_num+1)*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++){
for (int l = 0; l <= cord_num; l++){
for (int i = 0; i < elec_num; i++) {
if (i == elec) continue;
assert(fabs((rescaled_een_ee_distance[nw][l][elec][i]-single_rescaled_een_ee_distance[nw][l][i])) < 1.e-12);
assert(fabs((rescaled_een_ee_distance[nw][l][i][elec]-single_rescaled_een_ee_distance[nw][l][i])) < 1.e-12);
}
}
}
}
printf("OK\n");
#+end_src
** Electron-nucleus rescaled distances
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_een_rescaled_single_n(qmckl_context context,
double* const distance_rescaled,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_een_rescaled_single_n(qmckl_context context,
double* const distance_rescaled,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_een_rescaled_single_n(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
int64_t sze = ctx->nucleus.num * ctx->electron.walker.num * (ctx->jastrow_champ.cord_num + 1);
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"mckl_get_een_rescaled_single_n",
"Array too small. Expected ctx->nucleus.num * ctx->electron.walker.num * (ctx->jastrow_champ.cord_num + 1)");
}
memcpy(distance_rescaled, ctx->single_point.een_rescaled_single_n, sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
*** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_een_rescaled_single_n(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_een_rescaled_single_n(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
/* Check if ee distance is provided */
qmckl_exit_code rc = qmckl_provide_single_en_distance(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Check if een rescaled distance is provided */
rc = qmckl_provide_een_rescaled_n(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.een_rescaled_single_n_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->nucleus.num *
ctx->electron.walker.num * (ctx->jastrow_champ.cord_num + 1) * sizeof(double);
if (mem_info.size > ctx->single_point.een_rescaled_single_n_maxsize) {
if (ctx->single_point.een_rescaled_single_n != NULL) {
rc = qmckl_free(context, ctx->single_point.een_rescaled_single_n);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_een_rescaled_single_n",
"Unable to free ctx->single_point.een_rescaled_single_n");
}
ctx->single_point.een_rescaled_single_n = NULL;
}
}
/* Allocate array */
if (ctx->single_point.een_rescaled_single_n == NULL) {
double* een_rescaled_single_n = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.een_rescaled_single_n_maxsize = mem_info.size;
if (een_rescaled_single_n == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_een_rescaled_single_n",
NULL);
}
ctx->single_point.een_rescaled_single_n = een_rescaled_single_n;
}
rc = qmckl_compute_een_rescaled_single_n(context,
ctx->single_point.num,
ctx->electron.walker.num,
ctx->electron.num,
ctx->nucleus.num,
ctx->jastrow_champ.type_nucl_num,
ctx->jastrow_champ.type_nucl_vector,
ctx->jastrow_champ.cord_num,
ctx->jastrow_champ.rescale_factor_en,
ctx->single_point.single_en_distance,
ctx->jastrow_champ.een_rescaled_n,
ctx->single_point.een_rescaled_single_n);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.een_rescaled_single_n_date = ctx->single_point.date;
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_een_rescaled_single_n
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_factor_een_rescaled_single_n_args
| 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 |
|-------------------------+----------------------------------------------------+--------+--------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer function qmckl_compute_een_rescaled_single_n( &
context, num_in, walk_num, elec_num, nucl_num, &
type_nucl_num, type_nucl_vector, cord_num, rescale_factor_en, &
single_en_distance, een_rescaled_n, een_rescaled_single_n) &
result(info) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in) :: context
integer(c_int64_t) , intent(in), value :: num_in
integer(c_int64_t) , intent(in), value :: walk_num
integer(c_int64_t) , intent(in), value :: elec_num
integer(c_int64_t) , intent(in), value :: nucl_num
integer(c_int64_t) , intent(in), value :: type_nucl_num
integer(c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
integer(c_int64_t) , intent(in), value :: cord_num
real(c_double) , intent(in) :: rescale_factor_en(type_nucl_num)
real(c_double) , intent(in) :: single_en_distance(nucl_num,walk_num)
real(c_double) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num)
real(c_double) , intent(out) :: een_rescaled_single_n(nucl_num,0:cord_num,walk_num)
double precision :: x
integer*8 :: i, a, k, l, nw, num
num = num_in + 1
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif
if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_2
return
endif
if (nucl_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif
if (cord_num < 0) then
info = QMCKL_INVALID_ARG_4
return
endif
do nw = 1, walk_num
! prepare the actual een table
een_rescaled_single_n(:, 0, nw) = 1.0d0
do a = 1, nucl_num
een_rescaled_single_n(a, 1, nw) = dexp(-rescale_factor_en(type_nucl_vector(a)+1) * single_en_distance(a, nw))
end do
do l = 2, cord_num
do a = 1, nucl_num
een_rescaled_single_n(a, l, nw) = een_rescaled_single_n(a, l - 1, nw) * een_rescaled_single_n(a, 1, nw)
end do
end do
!een_rescaled_single_n(:,:,:) = een_rescaled_single_n(:,:,:) - een_rescaled_n(num,:,:,:)
end do
end function qmckl_compute_een_rescaled_single_n
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_compute_een_rescaled_single_n (
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,
int64_t* const type_nucl_vector,
const int64_t cord_num,
const double* rescale_factor_en,
const double* single_en_distance,
const double* een_rescaled_n,
double* const een_rescaled_single_n );
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("Single een rescaled e-n distance\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double rescaled_een_en_distance[walk_num][cord_num+1][nucl_num][elec_num];
double single_rescaled_een_en_distance[walk_num][cord_num+1][nucl_num];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_een_rescaled_n(context, &rescaled_een_en_distance[0][0][0][0], walk_num*(cord_num+1)*nucl_num*elec_num);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_een_rescaled_single_n(context, &single_rescaled_een_en_distance[0][0][0], walk_num*(cord_num+1)*nucl_num);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_een_rescaled_n(context, &rescaled_een_en_distance[0][0][0][0], walk_num*(cord_num+1)*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++){
for (int l = 0; l <= cord_num; l++){
for (int a = 0; a < nucl_num; a++) {
assert(fabs((rescaled_een_en_distance[nw][l][a][elec]-single_rescaled_een_en_distance[nw][l][a])) < 1.e-12);
}
}
}
}
printf("OK\n");
#+end_src
** $\delta P$ matrix
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_jastrow_champ_delta_p(qmckl_context context,
double* const delta_p,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_jastrow_champ_delta_p(qmckl_context context,
double* const delta_p,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_jastrow_champ_delta_p(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
int64_t sze = ctx->electron.walker.num * ctx->jastrow_champ.cord_num *
(ctx->jastrow_champ.cord_num + 1) * ctx->nucleus.num * ctx->electron.num;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_jastrow_champ_delta_p",
"Array too small.");
}
memcpy(delta_p, ctx->single_point.delta_p, sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
*** provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_delta_p(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_delta_p(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
qmckl_exit_code rc = qmckl_provide_een_rescaled_single_e(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_een_rescaled_single_n(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.delta_p_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->electron.walker.num * ctx->jastrow_champ.cord_num *
(ctx->jastrow_champ.cord_num + 1) * ctx->nucleus.num * ctx->electron.num * sizeof(double);
if (mem_info.size > ctx->single_point.delta_p_maxsize) {
if (ctx->single_point.delta_p != NULL) {
rc = qmckl_free(context, ctx->single_point.delta_p);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_jastrow_champ_delta_p",
"Unable to free ctx->single_point.delta_p");
}
ctx->single_point.delta_p = NULL;
}
}
/* Allocate array */
if (ctx->single_point.delta_p == NULL) {
double* delta_p = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.delta_p_maxsize = mem_info.size;
if (delta_p == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_jastrow_champ_delta_p",
NULL);
}
ctx->single_point.delta_p = delta_p;
}
rc = qmckl_compute_jastrow_champ_delta_p_doc(context,
ctx->single_point.num,
ctx->electron.walker.num,
ctx->electron.num,
ctx->nucleus.num,
ctx->jastrow_champ.cord_num,
ctx->jastrow_champ.een_rescaled_n,
ctx->jastrow_champ.een_rescaled_e,
ctx->single_point.een_rescaled_single_n,
ctx->single_point.een_rescaled_single_e,
ctx->single_point.delta_p);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.delta_p_date = ctx->single_point.date;
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_jastrow_champ_delta_p_doc
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_factor_delta_p_args
| Variable | Type | In/Out | Description |
|-------------------------+------------------------------------------------------------------+--------+---------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~num~ | ~int64_t~ | in | Single point index |
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
| ~nucl_num~ | ~int64_t~ | in | Number of nuclei |
| ~cord_num~ | ~int64_t~ | in | order of polynomials |
| ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | in | Electron-nucleus rescaled distances |
| ~een_rescaled_e~ | ~double[walk_num][0:cord_num][elec_num][elec_num]~ | in | Electron-electron rescaled distances |
| ~een_rescaled_single_n~ | ~double[walk_num][0:cord_num][nucl_num]~ | in | Electron-nucleus single rescaled distances |
| ~een_rescaled_single_e~ | ~double[walk_num][0:cord_num][elec_num]~ | in | Electron-electron single rescaled distances |
| ~delta_p~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | out | Single point matrix P |
|-------------------------+------------------------------------------------------------------+--------+---------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer function qmckl_compute_jastrow_champ_delta_p_doc( &
context, num_in, walk_num, elec_num, nucl_num, cord_num, &
een_rescaled_n, een_rescaled_e, een_rescaled_single_n, een_rescaled_single_e, delta_p) &
result(info) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in) :: context
integer(c_int64_t), intent(in), value :: num_in, walk_num, elec_num, cord_num, nucl_num
real(c_double) , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_single_n(nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_single_e(elec_num, 0:cord_num, walk_num)
real(c_double) , intent(out) :: delta_p(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num)
double precision :: een_rescaled_delta_e(elec_num)
integer*8 :: i, a, c, j, l, k, p, m, n, nw, num
double precision :: dn, dn2
integer*8 :: LDA, LDB, LDC
num = num_in + 1
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) info = QMCKL_INVALID_CONTEXT
if (walk_num <= 0) info = QMCKL_INVALID_ARG_3
if (elec_num <= 0) info = QMCKL_INVALID_ARG_4
if (nucl_num <= 0) info = QMCKL_INVALID_ARG_5
if (cord_num < 0) info = QMCKL_INVALID_ARG_6
if (info /= QMCKL_SUCCESS) return
if (cord_num == 0) return
do nw=1, walk_num
do i=0, cord_num-1
een_rescaled_delta_e(:) = een_rescaled_single_e(:,i,nw) - een_rescaled_e(:,num,i,nw)
do c=0,cord_num
do a=1,nucl_num
dn = een_rescaled_single_n(a,c,nw) - een_rescaled_n(num,a,c,nw)
!dn2 = dn + een_rescaled_n(num,a,c,nw)
dn2 = een_rescaled_single_n(a,c,nw)
do j=1,elec_num
delta_p(j,a,c,i,nw) = een_rescaled_e(j,num,i,nw)*dn + een_rescaled_delta_e(j) * dn2
enddo
end do
end do
info = qmckl_dgemm(context, 'T', 'N', 1_8, nucl_num * (cord_num+1_8), elec_num, 1.0d0, &
een_rescaled_delta_e,elec_num, &
een_rescaled_n(1,1,0,nw),elec_num, &
1.0d0, &
delta_p(num,1,0,i,nw),elec_num)
enddo
end do
end function qmckl_compute_jastrow_champ_delta_p_doc
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code
qmckl_compute_jastrow_champ_delta_p_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 cord_num,
const double* een_rescaled_n,
const double* een_rescaled_e,
const double* een_rescaled_single_n,
const double* een_rescaled_single_e,
double* const delta_p );
qmckl_exit_code
qmckl_compute_jastrow_champ_delta_p (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 cord_num,
const double* een_rescaled_n,
const double* een_rescaled_e,
const double* een_rescaled_single_n,
const double* een_rescaled_single_e,
double* const delta_p );
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_compute_jastrow_champ_delta_p (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 cord_num,
const double* een_rescaled_n,
const double* een_rescaled_e,
const double* een_rescaled_single_n,
const double* een_rescaled_single_e,
double* const delta_p )
{
#ifdef HAVE_HPC
return qmckl_compute_jastrow_champ_delta_p_doc
#else
return qmckl_compute_jastrow_champ_delta_p_doc
#endif
(context, num, walk_num, elec_num, nucl_num, cord_num,
een_rescaled_n, een_rescaled_e, een_rescaled_single_n, een_rescaled_single_e, delta_p );
}
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("Delta p\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double p_old[walk_num][cord_num][cord_num+1][nucl_num][elec_num];
double delta_p[walk_num][cord_num][cord_num+1][nucl_num][elec_num];
double p_new[walk_num][cord_num][cord_num+1][nucl_num][elec_num];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_tmp_c(context, &p_old[0][0][0][0][0], walk_num*cord_num*(cord_num+1)*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_delta_p(context, &delta_p[0][0][0][0][0], walk_num*cord_num*(cord_num+1)*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_tmp_c(context, &p_new[0][0][0][0][0], walk_num*cord_num*(cord_num+1)*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++){
for (int l = 0; l < cord_num; l++){
for (int m = 0; m <= cord_num; m++){
for (int a = 0; a < nucl_num; a++) {
for (int i = 0; i < elec_num; i++){
assert(fabs(((p_new[nw][l][m][a][i]-p_old[nw][l][m][a][i])-delta_p[nw][l][m][a][i])) < 1.e-12);
}
}
}
}
}
}
printf("OK\n");
#+end_src
** Electron-electron-nucleus Jastrow value
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_jastrow_champ_single_een(qmckl_context context,
double* const delta_een,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_jastrow_champ_single_een(qmckl_context context,
double* const delta_een,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_jastrow_champ_single_een(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
int64_t sze = ctx->electron.walker.num;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_jastrow_champ_single_eenn",
"Array too small. Expected ctx->electron.walker.num");
}
memcpy(delta_een, ctx->single_point.delta_een, sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org
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
#+end_src
*** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_single_een(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_single_een(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
qmckl_exit_code rc;
if (ctx->jastrow_champ.cord_num > 0) {
rc = qmckl_provide_jastrow_champ_delta_p(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_jastrow_champ_factor_een(context);
if(rc != QMCKL_SUCCESS) return rc;
}
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.delta_een_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->electron.walker.num * sizeof(double);
if (mem_info.size > ctx->single_point.delta_een_maxsize) {
if (ctx->single_point.delta_een != NULL) {
rc = qmckl_free(context, ctx->single_point.delta_een);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_jastrow_champ_single_een",
"Unable to free ctx->single_point.delta_een");
}
ctx->single_point.delta_een = NULL;
}
}
/* Allocate array */
if (ctx->single_point.delta_een == NULL) {
double* delta_een = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.delta_een_maxsize = mem_info.size;
if (delta_een == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_jastrow_champ_single_een",
NULL);
}
ctx->single_point.delta_een = delta_een;
}
rc = qmckl_compute_jastrow_champ_factor_single_een_doc(context,
ctx->single_point.num,
ctx->electron.walker.num,
ctx->electron.num,
ctx->nucleus.num,
ctx->jastrow_champ.cord_num,
ctx->jastrow_champ.dim_c_vector,
ctx->jastrow_champ.c_vector_full,
ctx->jastrow_champ.lkpm_combined_index,
ctx->jastrow_champ.tmp_c,
ctx->single_point.delta_p,
ctx->jastrow_champ.een_rescaled_n,
ctx->jastrow_champ.een_rescaled_e,
ctx->single_point.een_rescaled_single_n,
ctx->single_point.een_rescaled_single_e,
ctx->single_point.delta_een);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.delta_een_date = ctx->single_point.date;
}
//printf("ctx date %u\n", ctx->date);
//printf("single point date %u\n", ctx->single_point.date);
//printf("jastrow champ tmp_c date %u\n", ctx->jastrow_champ.tmp_c_date);
//printf("delta p date %u\n", ctx->single_point.delta_p_date);
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_jastrow_champ_factor_single_een_doc
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_factor_single_een_args
| 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 | P matrix |
| ~delta_p~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | in | Single 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_single_n~ | ~double[walk_num][0:cord_num][nucl_num]~ | in | Electron-nucleus single rescaled distances |
| ~een_rescaled_single_e~ | ~double[walk_num][0:cord_num][elec_num]~ | in | Electron-electron single rescaled distances |
| ~delta_een~ | ~double[walk_num]~ | out | Electron-nucleus jastrow |
|-------------------------+------------------------------------------------------------------+--------+---------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer function qmckl_compute_jastrow_champ_factor_single_een_doc( &
context, num_in, walk_num, elec_num, nucl_num, cord_num, &
dim_c_vector, c_vector_full, lkpm_combined_index, &
tmp_c, delta_p, een_rescaled_n, een_rescaled_e, een_rescaled_single_n, &
een_rescaled_single_e, delta_een) &
result(info) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in) :: context
integer(c_int64_t) , intent(in), value :: num_in, walk_num, elec_num, cord_num, nucl_num, dim_c_vector
integer(c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,4)
real(c_double) , intent(in) :: c_vector_full(nucl_num, dim_c_vector)
real(c_double) , intent(in) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num)
real(c_double) , intent(in) :: delta_p(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num)
real(c_double) , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_single_n(nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_single_e(elec_num, 0:cord_num, walk_num)
real(c_double) , intent(out) :: delta_een(walk_num)
double precision :: delta_c(nucl_num,0:cord_num, 0:cord_num-1, walk_num)
double precision :: delta_c2(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num)
double precision :: een_rescaled_delta_n(nucl_num, 0:cord_num)
integer*8 :: i, a, j, l, k, p, m, n, nw, num
double precision :: accu, accu2, cn
integer*8 :: LDA, LDB, LDC
num = num_in + 1
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) info = QMCKL_INVALID_CONTEXT
if (walk_num <= 0) info = QMCKL_INVALID_ARG_3
if (elec_num <= 0) info = QMCKL_INVALID_ARG_4
if (nucl_num <= 0) info = QMCKL_INVALID_ARG_5
if (cord_num < 0) info = QMCKL_INVALID_ARG_6
if (info /= QMCKL_SUCCESS) return
delta_een = 0.0d0
if (cord_num == 0) return
do nw =1, walk_num
een_rescaled_delta_n(:,:) = een_rescaled_single_n(:,:,nw) - een_rescaled_n(num,:,:,nw)
do n = 1, dim_c_vector
l = lkpm_combined_index(n, 1)
k = lkpm_combined_index(n, 2)
p = lkpm_combined_index(n, 3)
m = lkpm_combined_index(n, 4)
do a = 1, nucl_num
cn = c_vector_full(a, n)
if(cn == 0.d0) cycle
accu = 0.0d0
do j = 1, elec_num
accu = accu + een_rescaled_n(j,a,m,nw) * delta_p(j,a,m+l,k,nw)
end do
accu = accu + een_rescaled_delta_n(a,m) * (tmp_c(num,a,m+l,k,nw) + delta_p(num,a,m+l,k,nw))
delta_een(nw) = delta_een(nw) + accu * cn
end do
end do
end do
end function qmckl_compute_jastrow_champ_factor_single_een_doc
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code
qmckl_compute_jastrow_champ_factor_single_een_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 cord_num,
const int64_t dim_c_vector,
const double* c_vector_full,
const int64_t* lkpm_combined_index,
const double* tmp_c,
const double* delta_p,
const double* een_rescaled_n,
const double* een_rescaled_e,
const double* een_rescaled_single_n,
const double* een_rescaled_single_e,
double* const delta_een );
qmckl_exit_code
qmckl_compute_jastrow_champ_factor_single_een (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 cord_num,
const int64_t dim_c_vector,
const double* c_vector_full,
const int64_t* lkpm_combined_index,
const double* tmp_c,
const double* delta_p,
const double* een_rescaled_n,
const double* een_rescaled_e,
const double* een_rescaled_single_n,
const double* een_rescaled_single_e,
double* const delta_een );
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_compute_jastrow_champ_factor_single_een (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 cord_num,
const int64_t dim_c_vector,
const double* c_vector_full,
const int64_t* lkpm_combined_index,
const double* tmp_c,
const double* delta_p,
const double* een_rescaled_n,
const double* een_rescaled_e,
const double* een_rescaled_single_n,
const double* een_rescaled_single_e,
double* const delta_een )
{
#ifdef HAVE_HPC
return qmckl_compute_jastrow_champ_factor_single_een_doc
#else
return qmckl_compute_jastrow_champ_factor_single_een_doc
#endif
(context, num, walk_num, elec_num, nucl_num, cord_num, dim_c_vector,
c_vector_full, lkpm_combined_index, tmp_c, delta_p, een_rescaled_n, een_rescaled_e, een_rescaled_single_n, een_rescaled_single_e, delta_een );
}
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("Delta een\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double jastrow_een_old[walk_num];
double delta_een[walk_num];
double jastrow_een_new[walk_num];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een(context, &jastrow_een_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_een(context, &delta_een[0], walk_num);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een(context, &jastrow_een_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++) {
//printf("jastrow_een_old %f\n", jastrow_een_old[nw]);
//printf("jastrow_een_new %f\n", jastrow_een_new[nw]);
//printf("delta_een %f\n", delta_een[nw]);
assert(fabs((jastrow_een_new[nw]-jastrow_een_old[nw])-delta_een[nw]) < 1.e-12);
}
}
printf("OK\n");
#+end_src
** Electron-nucleus rescaled distance derivative
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_een_rescaled_single_n_gl(qmckl_context context,
double* const distance_rescaled,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_een_rescaled_single_n_gl(qmckl_context context,
double* const distance_rescaled,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_een_rescaled_single_n_gl(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
int64_t sze = 4 * ctx->nucleus.num * ctx->electron.walker.num * (ctx->jastrow_champ.cord_num + 1);
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_jastrow_champ_single_een_gl",
"Array too small. Expected 4 * ctx->nucleus.num * ctx->electron.walker.num * (ctx->jastrow_champ.cord_num + 1)");
}
memcpy(distance_rescaled, ctx->single_point.een_rescaled_single_n_gl, sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
*** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_een_rescaled_single_n_gl(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_een_rescaled_single_n_gl(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
/* Check if en distance is provided */
qmckl_exit_code rc = qmckl_provide_single_en_distance(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Check if ee distance is provided */
rc = qmckl_provide_een_rescaled_single_n(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.een_rescaled_single_n_gl_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = 4 * ctx->nucleus.num * ctx->electron.walker.num * (ctx->jastrow_champ.cord_num + 1) * sizeof(double);
if (mem_info.size > ctx->single_point.een_rescaled_single_n_gl_maxsize) {
if (ctx->single_point.een_rescaled_single_n_gl != NULL) {
rc = qmckl_free(context, ctx->single_point.een_rescaled_single_n_gl);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_een_rescaled_single_n_gl",
"Unable to free ctx->single_pont.een_rescaled_single_n_gl");
}
ctx->single_point.een_rescaled_single_n_gl = NULL;
}
}
/* Allocate array */
if (ctx->single_point.een_rescaled_single_n_gl == NULL) {
double* een_rescaled_single_n_gl = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.een_rescaled_single_n_gl_maxsize = mem_info.size;
if (een_rescaled_single_n_gl == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_een_rescaled_single_n_gl",
NULL);
}
ctx->single_point.een_rescaled_single_n_gl = een_rescaled_single_n_gl;
}
rc = qmckl_compute_een_rescaled_single_n_gl(context,
ctx->electron.walker.num,
ctx->nucleus.num,
ctx->jastrow_champ.type_nucl_num,
ctx->jastrow_champ.type_nucl_vector,
ctx->jastrow_champ.cord_num,
ctx->jastrow_champ.rescale_factor_en,
ctx->single_point.coord.data,
ctx->nucleus.coord.data,
ctx->single_point.single_en_distance,
ctx->single_point.een_rescaled_single_n,
ctx->single_point.een_rescaled_single_n_gl);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.een_rescaled_single_n_gl_date = ctx->single_point.date;
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_een_rescaled_single_n_gl
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_compute_een_rescaled_single_n_gl_args
|----------------------------+---------------------------------------------+--------+-------------------------------------------------------|
| 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 single distances |
| ~een_rescaled_single_n~ | ~double[walk_num][0:cord_num][nucl_num]~ | in | Electron-nucleus rescaled single distances |
| ~een_rescaled_single_n_gl~ | ~double[walk_num][0:cord_num][nucl_num][4]~ | out | Electron-nucleus rescaled single distances derivative |
|----------------------------+---------------------------------------------+--------+-------------------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer function qmckl_compute_een_rescaled_single_n_gl( &
context, walk_num, nucl_num, type_nucl_num, type_nucl_vector, &
cord_num, rescale_factor_en, coord_ee, coord_n, single_en_distance, &
een_rescaled_single_n, een_rescaled_single_n_gl) &
result(info) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in), value :: context
integer(c_int64_t) , intent(in), value :: walk_num
integer(c_int64_t) , intent(in), value :: nucl_num
integer(c_int64_t) , intent(in), value :: type_nucl_num
integer(c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
integer(c_int64_t) , intent(in), value :: cord_num
real(c_double) , intent(in) :: rescale_factor_en(type_nucl_num)
real(c_double) , intent(in) :: coord_ee(3,walk_num)
real(c_double) , intent(in) :: coord_n(nucl_num,3)
real(c_double) , intent(in) :: single_en_distance(nucl_num,walk_num)
real(c_double) , intent(in) :: een_rescaled_single_n(nucl_num,0:cord_num,walk_num)
real(c_double) , intent(out) :: een_rescaled_single_n_gl(4,nucl_num,0:cord_num,walk_num)
double precision,allocatable :: elnuc_dist_gl(:,:)
double precision :: x, ria_inv, kappa_l
integer*8 :: i, a, k, l, nw, ii
allocate(elnuc_dist_gl(4, nucl_num))
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif
if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_2
return
endif
if (nucl_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif
if (cord_num < 0) then
info = QMCKL_INVALID_ARG_4
return
endif
! Prepare table of exponentiated distances raised to appropriate power
een_rescaled_single_n_gl = 0.0d0
do nw = 1, walk_num
! prepare the actual een table
do a = 1, nucl_num
ria_inv = 1.0d0 / single_en_distance(a, nw)
do ii = 1, 3
elnuc_dist_gl(ii, a) = (coord_ee(ii,nw) - coord_n(a, ii)) * ria_inv
end do
elnuc_dist_gl(4, a) = 2.0d0 * ria_inv
end do
do l = 0, cord_num
do a = 1, nucl_num
kappa_l = - dble(l) * rescale_factor_en(type_nucl_vector(a)+1)
een_rescaled_single_n_gl(1, a, l, nw) = kappa_l * elnuc_dist_gl(1, a)
een_rescaled_single_n_gl(2, a, l, nw) = kappa_l * elnuc_dist_gl(2, a)
een_rescaled_single_n_gl(3, a, l, nw) = kappa_l * elnuc_dist_gl(3, a)
een_rescaled_single_n_gl(4, a, l, nw) = kappa_l * (elnuc_dist_gl(4, a) + kappa_l)
een_rescaled_single_n_gl(1, a, l, nw) = een_rescaled_single_n_gl(1, a, l, nw) * &
een_rescaled_single_n(a, l, nw)
een_rescaled_single_n_gl(2, a, l, nw) = een_rescaled_single_n_gl(2, a, l, nw) * &
een_rescaled_single_n(a, l, nw)
een_rescaled_single_n_gl(3, a, l, nw) = een_rescaled_single_n_gl(3, a, l, nw) * &
een_rescaled_single_n(a, l, nw)
een_rescaled_single_n_gl(4, a, l, nw) = een_rescaled_single_n_gl(4, a, l, nw) * &
een_rescaled_single_n(a, l, nw)
end do
end do
end do
end function qmckl_compute_een_rescaled_single_n_gl
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_compute_een_rescaled_single_n_gl (
const qmckl_context context,
const int64_t walk_num,
const int64_t nucl_num,
const int64_t type_nucl_num,
int64_t* const type_nucl_vector,
const int64_t cord_num,
const double* rescale_factor_en,
const double* coord_ee,
const double* coord_n,
const double* single_en_distance,
const double* een_rescaled_single_n,
double* const een_rescaled_single_n_gl );
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("Een rescaled single n gl\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double een_rescaled_en_gl[walk_num][cord_num+1][nucl_num][4][elec_num];
double een_rescaled_single_n_gl[walk_num][cord_num+1][nucl_num][4];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_een_rescaled_n_gl(context, &een_rescaled_en_gl[0][0][0][0][0], walk_num*(cord_num+1)*nucl_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_een_rescaled_single_n_gl(context, &een_rescaled_single_n_gl[0][0][0][0], walk_num*(cord_num+1)*nucl_num*4);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_een_rescaled_n_gl(context, &een_rescaled_en_gl[0][0][0][0][0], walk_num*(cord_num+1)*nucl_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++) {
for (int l = 0; l < cord_num+1; l++) {
for (int a = 0; a < nucl_num; a++) {
for (int m = 0; m < 4; m++) {
//printf("nw %d l %d a %d m %d\n", nw, l, a, m);
//printf(" %f %f\n", een_rescaled_en_gl[nw][l][a][m][elec], een_rescaled_single_n_gl[nw][l][a][m]);
assert(fabs(een_rescaled_en_gl[nw][l][a][m][elec] - een_rescaled_single_n_gl[nw][l][a][m]) < 1.e-12);
}
}
}
}
}
printf("OK\n");
#+end_src
** Electron-electron rescaled distances derivative
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_een_rescaled_single_e_gl(qmckl_context context,
double* const distance_rescaled,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_een_rescaled_single_e_gl(qmckl_context context,
double* const distance_rescaled,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_een_rescaled_single_e_gl(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
int64_t sze = 4 * ctx->electron.num * ctx->electron.walker.num * (ctx->jastrow_champ.cord_num + 1);
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_jastrow_champ_factor_een_gl",
"Array too small. Expected 4 * ctx->electron.num * ctx->electron.walker.num * (ctx->jastrow_champ.cord_num + 1)");
}
memcpy(distance_rescaled, ctx->single_point.een_rescaled_single_e_gl, sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
*** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_een_rescaled_single_e_gl(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_een_rescaled_single_e_gl(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
/* Check if rescaled een-ee distance is provided */
qmckl_exit_code rc = qmckl_provide_een_rescaled_single_e(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_single_ee_distance(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_single_en_distance(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.een_rescaled_single_e_gl_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = 4 * ctx->electron.num * ctx->electron.walker.num * (ctx->jastrow_champ.cord_num + 1) * sizeof(double);
if (mem_info.size > ctx->single_point.een_rescaled_single_e_gl_maxsize) {
if (ctx->single_point.een_rescaled_single_e_gl != NULL) {
rc = qmckl_free(context, ctx->single_point.een_rescaled_single_e_gl);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_een_rescaled_e_gl",
"Unable to free ctx->single_point.een_rescaled_single_e_gl");
}
ctx->single_point.een_rescaled_single_e_gl = NULL;
}
}
/* Allocate array */
if (ctx->single_point.een_rescaled_single_e_gl == NULL) {
double* een_rescaled_single_e_gl = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.een_rescaled_single_e_gl_maxsize = mem_info.size;
if (een_rescaled_single_e_gl == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_een_rescaled_single_e_gl",
NULL);
}
ctx->single_point.een_rescaled_single_e_gl = een_rescaled_single_e_gl;
}
rc = qmckl_compute_een_rescaled_single_e_gl(context,
ctx->single_point.num,
ctx->electron.walker.num,
ctx->electron.num,
ctx->jastrow_champ.cord_num,
ctx->jastrow_champ.rescale_factor_ee,
ctx->single_point.coord.data,
ctx->electron.walker.point.coord.data,
ctx->single_point.single_ee_distance,
ctx->single_point.een_rescaled_single_e,
ctx->single_point.een_rescaled_single_e_gl);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.een_rescaled_single_e_gl_date = ctx->single_point.date;
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_een_rescaled_single_e_gl
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_een_rescaled_single_e_gl_args
|----------------------------+---------------------------------------------+--------+--------------------------------------------------------|
| Variable | Type | In/Out | Description |
|----------------------------+---------------------------------------------+--------+--------------------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~num~ | ~int64_t~ | in | Index of single 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 |
| ~coord~ | ~double[walk_num][3]~ | in | Single electron coordinates |
| ~coord_ee~ | ~double[3][walk_num][elec_num]~ | in | Electron coordinates |
| ~single_ee_distance~ | ~double[walk_num][elec_num]~ | in | Electron-electron single distances |
| ~een_rescaled_single_e~ | ~double[walk_num][0:cord_num][elec_num]~ | in | Electron-electron rescaled single distances |
| ~een_rescaled_single_e_gl~ | ~double[walk_num][0:cord_num][elec_num][4]~ | out | Electron-electron rescaled single distances derivative |
|----------------------------+---------------------------------------------+--------+--------------------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer function qmckl_compute_een_rescaled_single_e_gl_doc( &
context, num_in, walk_num, elec_num, cord_num, rescale_factor_ee, &
coord, coord_ee, single_ee_distance, een_rescaled_single_e, een_rescaled_single_e_gl) &
result(info) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in) :: context
integer(c_int64_t) , intent(in), value :: num_in
integer(c_int64_t) , intent(in), value :: walk_num
integer(c_int64_t) , intent(in), value :: elec_num
integer(c_int64_t) , intent(in), value :: cord_num
real(c_double) , intent(in), value :: rescale_factor_ee
real(c_double) , intent(in) :: coord(3,walk_num)
real(c_double) , intent(in) :: coord_ee(elec_num,walk_num,3)
real(c_double) , intent(in) :: single_ee_distance(elec_num,walk_num)
real(c_double) , intent(in) :: een_rescaled_single_e(elec_num,0:cord_num,walk_num)
real(c_double) , intent(out) :: een_rescaled_single_e_gl(4,elec_num,0:cord_num,walk_num)
double precision,allocatable :: elec_dist_gl(:,:)
double precision :: x, rij_inv, kappa_l
integer*8 :: i, j, k, l, nw, ii, num
num = num_in + 1
allocate(elec_dist_gl(4, elec_num))
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif
if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif
if (elec_num <= 0) then
info = QMCKL_INVALID_ARG_4
return
endif
if (cord_num < 0) then
info = QMCKL_INVALID_ARG_5
return
endif
! Not necessary: should be set to zero by qmckl_malloc
! een_rescaled_single_e_gl = 0.0d0
! Prepare table of exponentiated distances raised to appropriate power
do nw = 1, walk_num
do i = 1, elec_num
if (i == num) cycle
rij_inv = 1.0d0 / single_ee_distance(i, nw)
do ii = 1, 3
elec_dist_gl(ii, i) = (coord(ii, nw) - coord_ee(i, nw, ii)) * rij_inv
end do
elec_dist_gl(4, i) = 2.0d0 * rij_inv
end do
elec_dist_gl(:, num) = 0.0d0
do l = 1, cord_num
kappa_l = - dble(l) * rescale_factor_ee
do i = 1, elec_num
een_rescaled_single_e_gl(1, i, l, nw) = kappa_l * elec_dist_gl(1, i)
een_rescaled_single_e_gl(2, i, l, nw) = kappa_l * elec_dist_gl(2, i)
een_rescaled_single_e_gl(3, i, l, nw) = kappa_l * elec_dist_gl(3, i)
een_rescaled_single_e_gl(4, i, l, nw) = kappa_l * (elec_dist_gl(4, i) + kappa_l)
een_rescaled_single_e_gl(1,i,l,nw) = een_rescaled_single_e_gl(1,i,l,nw) * een_rescaled_single_e(i,l,nw)
een_rescaled_single_e_gl(2,i,l,nw) = een_rescaled_single_e_gl(2,i,l,nw) * een_rescaled_single_e(i,l,nw)
een_rescaled_single_e_gl(3,i,l,nw) = een_rescaled_single_e_gl(3,i,l,nw) * een_rescaled_single_e(i,l,nw)
een_rescaled_single_e_gl(4,i,l,nw) = een_rescaled_single_e_gl(4,i,l,nw) * een_rescaled_single_e(i,l,nw)
end do
end do
end do
end function qmckl_compute_een_rescaled_single_e_gl_doc
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_compute_een_rescaled_single_e_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 );
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_compute_een_rescaled_single_e_gl_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* coord,
const double* coord_ee,
const double* single_ee_distance,
const double* een_rescaled_single_e,
double* const een_rescaled_single_e_gl );
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes
qmckl_exit_code qmckl_compute_een_rescaled_single_e_gl (
const qmckl_context context,
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 );
}
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("Een rescaled single e gl\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double een_rescaled_ee_gl[walk_num][cord_num+1][elec_num][4][elec_num];
double een_rescaled_single_e_gl[walk_num][cord_num+1][elec_num][4];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_een_rescaled_e_gl(context, &een_rescaled_ee_gl[0][0][0][0][0], walk_num*(cord_num+1)*elec_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_een_rescaled_single_e_gl(context, &een_rescaled_single_e_gl[0][0][0][0], walk_num*(cord_num+1)*elec_num*4);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
//coords[0][0][elec] = new_coords[0];
//coords[1][0][elec] = new_coords[1];
//coords[2][0][elec] = new_coords[2];
//coords[0][1][elec] = new_coords[3];
//coords[1][1][elec] = new_coords[4];
//coords[2][1][elec] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_een_rescaled_e_gl(context, &een_rescaled_ee_gl[0][0][0][0][0], walk_num*(cord_num+1)*elec_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
double metric[4] = {-1.0, -1.0, -1.0, 1.0};
for (int l = 0; l < cord_num+1; l++) {
for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++) {
for (int m = 0; m < 4; m++) {
//printf("een_rescaled_ee_gl[nw][l][i][m][elec] %i %i %i %f \n", l, m ,i, een_rescaled_ee_gl[nw][l][i][m][elec]);
//printf("een_rescaled_ee_gl[nw][l][elec][m][i] %i %i %i %f \n", l, m ,i, een_rescaled_ee_gl[nw][l][elec][m][i]);
//printf("een_rescaled_single_e_gl[nw][l][i][m] %i %i %i %f\n", l, m, i,een_rescaled_single_e_gl[nw][l][i][m]);
assert(fabs(een_rescaled_ee_gl[nw][l][i][m][elec] - een_rescaled_single_e_gl[nw][l][i][m]) < 1.e-12);
assert(fabs(een_rescaled_ee_gl[nw][l][elec][m][i] - metric[m] * een_rescaled_single_e_gl[nw][l][i][m]) < 1.e-12);
}
}
}
}
}
printf("OK\n");
#+end_src
** $\delta P$ matrix gradients and Laplacian
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_jastrow_champ_delta_p_gl(qmckl_context context,
double* const delta_p_gl,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_jastrow_champ_delta_p_gl(qmckl_context context,
double* const delta_p_gl,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_jastrow_champ_delta_p_gl(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
int64_t sze = ctx->electron.walker.num * ctx->jastrow_champ.cord_num *
(ctx->jastrow_champ.cord_num + 1) * ctx->nucleus.num * ctx->electron.num * 4;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_jastrow_champ_delta_p_gl",
"Array too small.");
}
memcpy(delta_p_gl, ctx->single_point.delta_p_gl, sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
*** provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_delta_p_gl(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_delta_p_gl(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
qmckl_exit_code rc = qmckl_provide_een_rescaled_single_e(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_een_rescaled_n(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_een_rescaled_e(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_een_rescaled_n_gl(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_een_rescaled_e_gl(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_een_rescaled_single_n(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_een_rescaled_single_e_gl(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_een_rescaled_single_n_gl(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.delta_p_gl_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = 4 * ctx->electron.walker.num * ctx->jastrow_champ.cord_num *
(ctx->jastrow_champ.cord_num + 1) * ctx->nucleus.num * ctx->electron.num * sizeof(double);
if (mem_info.size > ctx->single_point.delta_p_gl_maxsize) {
if (ctx->single_point.delta_p_gl != NULL) {
rc = qmckl_free(context, ctx->single_point.delta_p_gl);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_jastrow_champ_delta_p_gl",
"Unable to free ctx->single_point.delta_p_gl");
}
ctx->single_point.delta_p_gl = NULL;
}
}
/* Allocate array */
if (ctx->single_point.delta_p_gl == NULL) {
double* delta_p_gl = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.delta_p_gl_maxsize = mem_info.size;
if (delta_p_gl == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_jastrow_champ_delta_p_gl",
NULL);
}
ctx->single_point.delta_p_gl = delta_p_gl;
}
rc = qmckl_compute_jastrow_champ_delta_p_gl(context,
ctx->single_point.num,
ctx->electron.walker.num,
ctx->electron.num,
ctx->nucleus.num,
ctx->jastrow_champ.cord_num,
ctx->jastrow_champ.een_rescaled_n,
ctx->jastrow_champ.een_rescaled_e,
ctx->single_point.een_rescaled_single_n,
ctx->single_point.een_rescaled_single_e,
ctx->jastrow_champ.een_rescaled_n_gl,
ctx->jastrow_champ.een_rescaled_e_gl,
ctx->single_point.een_rescaled_single_n_gl,
ctx->single_point.een_rescaled_single_e_gl,
ctx->single_point.delta_p_gl);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.delta_p_gl_date = ctx->single_point.date;
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_jastrow_champ_delta_p_gl_doc
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_factor_delta_p_gl_args
| Variable | Type | In/Out | Description |
|----------------------------+---------------------------------------------------------------------+--------+---------------------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~num~ | ~int64_t~ | in | Index of single electron |
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
| ~nucl_num~ | ~int64_t~ | in | Number of nuclei |
| ~cord_num~ | ~int64_t~ | in | order of polynomials |
| ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | in | Electron-nucleus rescaled distances |
| ~een_rescaled_e~ | ~double[walk_num][0:cord_num][elec_num][elec_num]~ | in | Electron-electron rescaled distances |
| ~een_rescaled_single_n~ | ~double[walk_num][0:cord_num][nucl_num]~ | in | Electron-nucleus single rescaled distances |
| ~een_rescaled_single_e~ | ~double[walk_num][0:cord_num][elec_num]~ | in | Electron-electron single rescaled distances |
| ~een_rescaled_n_gl~ | ~double[walk_num][0:cord_num][nucl_num][4][elec_num]~ | in | Electron-nucleus rescaled distances derivatives |
| ~een_rescaled_e_gl~ | ~double[walk_num][0:cord_num][elec_num][4][elec_num]~ | in | Electron-electron rescaled distances derivatives |
| ~een_rescaled_single_n_gl~ | ~double[walk_num][0:cord_num][nucl_num][4]~ | in | Electron-nucleus single rescaled distances derivatives |
| ~een_rescaled_single_e_gl~ | ~double[walk_num][0:cord_num][elec_num][4]~ | in | Electron-electron single rescaled distances derivatives |
| ~delta_p_gl~ | ~double[walk_num][0:cord_num-1][0:cord_num][4][nucl_num][elec_num]~ | out | Delta P matrix gradient and Laplacian |
|----------------------------+---------------------------------------------------------------------+--------+---------------------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer(qmckl_exit_code) function qmckl_compute_jastrow_champ_delta_p_gl_doc( &
context, num_in, walk_num, elec_num, nucl_num, cord_num, &
een_rescaled_n, een_rescaled_e, een_rescaled_single_n, een_rescaled_single_e, &
een_rescaled_n_gl, een_rescaled_e_gl, een_rescaled_single_n_gl, een_rescaled_single_e_gl, delta_p_gl) &
result(info) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in) :: context
integer(c_int64_t) , intent(in), value :: num_in, walk_num, elec_num, cord_num, nucl_num
real(c_double) , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_single_n(nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_single_e(elec_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_n_gl(elec_num, 4, nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_e_gl(elec_num, 4, elec_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_single_n_gl(4, nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_single_e_gl(4,elec_num, 0:cord_num, walk_num)
real(c_double) , intent(out) :: delta_p_gl(elec_num,nucl_num,4,0:cord_num, 0:cord_num-1, walk_num)
double precision :: delta_e_gl(elec_num,4)
double precision :: een_rescaled_delta_n, een_re_n, een_re_single_n
integer*8 :: i, a, j, l, k, p, m, n, nw, num
double precision :: tmp, cummu
integer*8 :: LDA, LDB, LDC
num = num_in + 1
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) info = QMCKL_INVALID_CONTEXT
if (walk_num <= 0) info = QMCKL_INVALID_ARG_3
if (elec_num <= 0) info = QMCKL_INVALID_ARG_4
if (nucl_num <= 0) info = QMCKL_INVALID_ARG_5
if (cord_num < 0) info = QMCKL_INVALID_ARG_6
if (info /= QMCKL_SUCCESS) return
if (cord_num == 0) then
delta_p_gl = 0.d0
return
endif
do nw=1, walk_num
do m=1, cord_num-1
do j = 1, elec_num
do k = 1, 4
delta_e_gl(j,k) = een_rescaled_single_e_gl(k,j,m,nw) - een_rescaled_e_gl(num, k, j, m, nw)
end do
end do
do k = 1, 4
delta_e_gl(num, k) = 0.0d0
end do
do l=0, cord_num
do k = 1, 3
do a = 1, nucl_num
een_re_n = een_rescaled_n(num, a, l, nw)
een_re_single_n = een_rescaled_single_n(a,l,nw)
cummu = 0.0d0
do i = 1, elec_num
delta_p_gl(i,a,k,l,m,nw) = -een_rescaled_e_gl(i,k,num,m,nw) * een_re_n&
- een_rescaled_single_e_gl(k,i,m,nw) * een_re_single_n
cummu = cummu + delta_e_gl(i,k) * een_rescaled_n(i,a,l,nw)
end do
delta_p_gl(num,a,k,l,m,nw) = delta_p_gl(num,a,k,l,m,nw) + cummu
end do
end do
do a = 1, nucl_num
een_rescaled_delta_n = een_rescaled_single_n(a,l,nw) - een_rescaled_n(num, a, l, nw)
cummu = 0.0d0
een_re_single_n = een_rescaled_single_n(a,l,nw)
do i = 1, elec_num
delta_p_gl(i,a,4,l,m,nw) = een_rescaled_e_gl(i,4,num,m,nw) * een_rescaled_delta_n &
+delta_e_gl(i,4) * een_re_single_n
cummu = cummu + delta_e_gl(i,4) * een_rescaled_n(i,a,l,nw)
end do
delta_p_gl(num,a,4,l,m,nw) = delta_p_gl(num,a,4,l,m,nw) + cummu
end do
end do
end do
end do
end function qmckl_compute_jastrow_champ_delta_p_gl_doc
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code
qmckl_compute_jastrow_champ_delta_p_gl_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 cord_num,
const double* een_rescaled_n,
const double* een_rescaled_e,
const double* een_rescaled_single_n,
const double* een_rescaled_single_e,
const double* een_rescaled_n_gl,
const double* een_rescaled_e_gl,
const double* een_rescaled_single_n_gl,
const double* een_rescaled_single_e_gl,
double* const delta_p_gl );
qmckl_exit_code
qmckl_compute_jastrow_champ_delta_p_gl (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 cord_num,
const double* een_rescaled_n,
const double* een_rescaled_e,
const double* een_rescaled_single_n,
const double* een_rescaled_single_e,
const double* een_rescaled_n_gl,
const double* een_rescaled_e_gl,
const double* een_rescaled_single_n_gl,
const double* een_rescaled_single_e_gl,
double* const delta_p_gl );
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_compute_jastrow_champ_delta_p_gl (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 cord_num,
const double* een_rescaled_n,
const double* een_rescaled_e,
const double* een_rescaled_single_n,
const double* een_rescaled_single_e,
const double* een_rescaled_n_gl,
const double* een_rescaled_e_gl,
const double* een_rescaled_single_n_gl,
const double* een_rescaled_single_e_gl,
double* const delta_p_gl )
{
#ifdef HAVE_HPC
return qmckl_compute_jastrow_champ_delta_p_gl_doc
#else
return qmckl_compute_jastrow_champ_delta_p_gl_doc
#endif
(context, num, walk_num, elec_num, nucl_num, cord_num,
een_rescaled_n, een_rescaled_e, een_rescaled_single_n, een_rescaled_single_e,
een_rescaled_n_gl, een_rescaled_e_gl, een_rescaled_single_n_gl, een_rescaled_single_e_gl, delta_p_gl);
}
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("Delta P gl\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double p_gl_old[walk_num][cord_num][cord_num+1][nucl_num][4][elec_num];
double delta_p_gl[walk_num][cord_num][cord_num+1][4][nucl_num][elec_num];
double p_gl_new[walk_num][cord_num][cord_num+1][nucl_num][4][elec_num];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_dtmp_c(context, &p_gl_old[0][0][0][0][0][0], walk_num*cord_num*(cord_num+1)*nucl_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_delta_p_gl(context, &delta_p_gl[0][0][0][0][0][0], 4*walk_num*cord_num*(cord_num+1)*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_dtmp_c(context, &p_gl_new[0][0][0][0][0][0], walk_num*cord_num*(cord_num+1)*nucl_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++){
for (int l = 0; l < cord_num; l++){
for (int m = 0; m <= cord_num; m++){
for (int a = 0; a < nucl_num; a++) {
for (int i = 0; i < elec_num; i++){
for (int k = 0; k < 4; k++){
if (fabs(((p_gl_new[nw][l][m][a][k][i]-p_gl_old[nw][l][m][a][k][i])-delta_p_gl[nw][l][m][k][a][i])) > 1.e-12) {
printf("p_gl[%d][%d][%d][%d][%d][%d] = %f\n", nw, l, m, a, k, i, p_gl_new[nw][l][m][a][k][i] - p_gl_old[nw][l][m][a][k][i]);
printf("delta_p_gl[%d][%d][%d][%d][%d][%d] = %f\n", nw, l, m, a, k, i, delta_p_gl[nw][l][m][k][a][i]);
}
assert(fabs(((p_gl_new[nw][l][m][a][k][i]-p_gl_old[nw][l][m][a][k][i])-delta_p_gl[nw][l][m][k][a][i])) < 1.e-12);
}
}
}
}
}
}
}
printf("OK\n");
#+end_src
** Electron-electron-nucleus Jastrow gradients and Laplacian
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_jastrow_champ_single_een_gl(qmckl_context context,
double* const delta_een_gl,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_jastrow_champ_single_een_gl(qmckl_context context,
double* const delta_een_gl,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_jastrow_champ_single_een_gl(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
if (delta_een_gl == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_get_jastrow_champ_single_een_gl",
"Array is NULL.");
}
int64_t sze = 4 * ctx->electron.num * ctx->electron.walker.num;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_jastrow_champ_single_een_gl",
"Array too small. Expected 4 * ctx->electron.num * ctx->electron.walker.num");
}
memcpy(delta_een_gl, ctx->single_point.delta_een_gl, sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org
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
#+end_src
*** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_single_een_gl(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_single_een_gl(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
qmckl_exit_code rc;
if (ctx->jastrow_champ.cord_num > 0) {
rc = qmckl_provide_jastrow_champ_delta_p(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_jastrow_champ_factor_een(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_jastrow_champ_delta_p_gl(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_jastrow_champ_factor_een_gl(context);
if(rc != QMCKL_SUCCESS) return rc;
}
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.delta_een_gl_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = 4 * ctx->electron.num * ctx->electron.walker.num * sizeof(double);
if (mem_info.size > ctx->single_point.delta_een_gl_maxsize) {
if (ctx->single_point.delta_een_gl != NULL) {
rc = qmckl_free(context, ctx->single_point.delta_een_gl);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_jastrow_champ_single_een_gl",
"Unable to free ctx->single_point.delta_een_gl");
}
ctx->single_point.delta_een_gl = NULL;
}
}
/* Allocate array */
if (ctx->single_point.delta_een_gl == NULL) {
double* delta_een_gl = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.delta_een_gl_maxsize = mem_info.size;
if (delta_een_gl == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_jastrow_champ_single_een_gl",
NULL);
}
ctx->single_point.delta_een_gl = delta_een_gl;
}
rc = qmckl_compute_jastrow_champ_factor_single_een_gl_doc(context,
ctx->single_point.num,
ctx->electron.walker.num,
ctx->electron.num,
ctx->nucleus.num,
ctx->jastrow_champ.cord_num,
ctx->jastrow_champ.dim_c_vector,
ctx->jastrow_champ.c_vector_full,
ctx->jastrow_champ.lkpm_combined_index,
ctx->jastrow_champ.tmp_c,
ctx->jastrow_champ.dtmp_c,
ctx->single_point.delta_p,
ctx->single_point.delta_p_gl,
ctx->jastrow_champ.een_rescaled_n,
ctx->single_point.een_rescaled_single_n,
ctx->jastrow_champ.een_rescaled_n_gl,
ctx->single_point.een_rescaled_single_n_gl,
ctx->single_point.delta_een_gl);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.delta_een_gl_date = ctx->single_point.date;
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_jastrow_champ_factor_single_een_gl_doc
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_factor_single_een_gl_args
| Variable | Type | In/Out | Description |
|----------------------------+---------------------------------------------------------------------+--------+----------------------------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~num~ | ~int64_t~ | in | Index of single electron |
| ~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[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | in | Delta P matrix |
| ~delta_p_gl~ | ~double[walk_num][0:cord_num-1][0:cord_num][4][nucl_num][elec_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_single_n~ | ~double[walk_num][0:cord_num][nucl_num]~ | in | Electron-nucleus single rescaled distances |
| ~een_rescaled_n_gl~ | ~double[walk_num][0:cord_num][nucl_num][4][elec_num]~ | in | Electron-nucleus rescaled distances derivatives |
| ~een_rescaled_single_n_gl~ | ~double[walk_num][0:cord_num][nucl_num][4]~ | in | Electron-nucleus single rescaled distances derivatives |
| ~delta_een_gl~ | ~double[walk_num][4][elec_num]~ | out | Delta electron-electron-nucleus jastrow gradient and Laplacian |
|----------------------------+---------------------------------------------------------------------+--------+----------------------------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer(qmckl_exit_code) function qmckl_compute_jastrow_champ_factor_single_een_gl_doc( &
context, num_in, walk_num, elec_num, nucl_num, cord_num, &
dim_c_vector, c_vector_full, lkpm_combined_index, &
tmp_c, dtmp_c, delta_p, delta_p_gl, een_rescaled_n, een_rescaled_single_n, &
een_rescaled_n_gl, een_rescaled_single_n_gl, delta_een_gl) &
result(info) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in) :: context
integer(c_int64_t) , intent(in), value :: num_in, walk_num, elec_num, cord_num, nucl_num, dim_c_vector
integer(c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,4)
real(c_double) , intent(in) :: c_vector_full(nucl_num, dim_c_vector)
real(c_double) , intent(in) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num)
real(c_double) , intent(in) :: dtmp_c(elec_num, 4, nucl_num,0:cord_num, 0:cord_num-1, walk_num)
real(c_double) , intent(in) :: delta_p(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num)
real(c_double) , intent(in) :: delta_p_gl(elec_num, nucl_num, 4, 0:cord_num, 0:cord_num-1, walk_num)
real(c_double) , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_single_n(nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_n_gl(elec_num, 4, nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_single_n_gl(4, nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(out) :: delta_een_gl(elec_num, 4, walk_num)
integer*8 :: i, a, j, l, k, p, m, n, nw, kk, num
double precision :: accu, accu2, cn
integer*8 :: LDA, LDB, LDC
double precision :: een_rescaled_delta_n_gl(4, nucl_num, 0:cord_num, walk_num)
double precision :: een_rescaled_delta_n(nucl_num, 0:cord_num, walk_num)
double precision :: dpg1_m, dpg1_ml, dp_m, dp_ml, een_r_m, een_r_ml, een_r_gl_m, een_r_gl_ml
num = num_in + 1
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) info = QMCKL_INVALID_CONTEXT
if (walk_num <= 0) info = QMCKL_INVALID_ARG_3
if (elec_num <= 0) info = QMCKL_INVALID_ARG_4
if (nucl_num <= 0) info = QMCKL_INVALID_ARG_5
if (cord_num < 0) info = QMCKL_INVALID_ARG_6
if (info /= QMCKL_SUCCESS) return
delta_een_gl = 0.0d0
if (cord_num == 0) return
een_rescaled_delta_n(:,:,:) = een_rescaled_single_n(:,:,:) - een_rescaled_n(num, :, :, :)
een_rescaled_delta_n_gl(:,:,:,:) = een_rescaled_single_n_gl(:,:,:,:) - een_rescaled_n_gl(num, :,:,:,:)
do nw =1, walk_num
do n = 1, dim_c_vector
l = lkpm_combined_index(n, 1)
k = lkpm_combined_index(n, 2)
p = lkpm_combined_index(n, 3)
m = lkpm_combined_index(n, 4)
do kk = 1, 4
do a = 1, nucl_num
cn = c_vector_full(a, n)
if(cn == 0.d0) cycle
!do i = 1, elec_num
! delta_een_gl(i,kk,nw) = delta_een_gl(i,kk,nw) + ( &
! delta_p_gl(i,a,kk,m ,k,nw) * een_rescaled_n(i,a,m+l,nw) + &
! delta_p_gl(i,a,kk,m+l,k,nw) * een_rescaled_n(i,a,m ,nw) + &
! delta_p(i,a,m ,k,nw) * een_rescaled_n_gl(i,kk,a,m+l,nw) + &
! delta_p(i,a,m+l,k,nw) * een_rescaled_n_gl(i,kk,a,m ,nw) ) * cn
!end do
do i = 1, elec_num
! Cache repeated accesses
dpg1_m = delta_p_gl(i,a,kk,m ,k,nw)
dpg1_ml = delta_p_gl(i,a,kk,m+l,k,nw)
dp_m = delta_p(i,a,m ,k,nw)
dp_ml = delta_p(i,a,m+l,k,nw)
een_r_m = een_rescaled_n(i,a,m ,nw)
een_r_ml = een_rescaled_n(i,a,m+l,nw)
een_r_gl_m = een_rescaled_n_gl(i,kk,a,m ,nw)
een_r_gl_ml = een_rescaled_n_gl(i,kk,a,m+l,nw)
delta_een_gl(i,kk,nw) = delta_een_gl(i,kk,nw) + cn * &
(dpg1_m * een_r_ml + dpg1_ml * een_r_m + dp_m * een_r_gl_ml + dp_ml * een_r_gl_m)
end do
delta_een_gl(num,kk,nw) = delta_een_gl(num,kk,nw) + ( &
(dtmp_c(num,kk,a,m ,k,nw) + delta_p_gl(num,a,kk,m ,k,nw)) * een_rescaled_delta_n(a,m+l,nw) + &
(dtmp_c(num,kk,a,m+l,k,nw) + delta_p_gl(num,a,kk,m+l,k,nw)) * een_rescaled_delta_n(a,m ,nw) + &
(tmp_c(num,a,m ,k,nw) + delta_p(num,a,m ,k,nw)) * een_rescaled_delta_n_gl(kk,a,m+l,nw) + &
(tmp_c(num,a,m+l,k,nw) + delta_p(num,a,m+l,k,nw)) * een_rescaled_delta_n_gl(kk,a,m ,nw) )* cn
end do
end do
do a = 1, nucl_num
cn = c_vector_full(a, n)
if(cn == 0.d0) cycle
cn = cn + cn
do i = 1, elec_num
delta_een_gl(i,4,nw) = delta_een_gl(i,4,nw) + ( &
delta_p_gl(i,a,1,m ,k,nw) * een_rescaled_n_gl(i,1,a,m+l,nw) + &
delta_p_gl(i,a,1,m+l,k,nw) * een_rescaled_n_gl(i,1,a,m ,nw) + &
delta_p_gl(i,a,2,m ,k,nw) * een_rescaled_n_gl(i,2,a,m+l,nw) + &
delta_p_gl(i,a,2,m+l,k,nw) * een_rescaled_n_gl(i,2,a,m ,nw) + &
delta_p_gl(i,a,3,m ,k,nw) * een_rescaled_n_gl(i,3,a,m+l,nw) + &
delta_p_gl(i,a,3,m+l,k,nw) * een_rescaled_n_gl(i,3,a,m ,nw) ) * cn
end do
delta_een_gl(num,4,nw) = delta_een_gl(num,4,nw) + ( &
(delta_p_gl(num,a,1,m ,k,nw) + dtmp_c(num,1,a,m ,k,nw)) * een_rescaled_delta_n_gl(1,a,m+l,nw) + &
(delta_p_gl(num,a,1,m+l,k,nw) + dtmp_c(num,1,a,m+l,k,nw)) * een_rescaled_delta_n_gl(1,a,m ,nw) + &
(delta_p_gl(num,a,2,m ,k,nw) + dtmp_c(num,2,a,m ,k,nw)) * een_rescaled_delta_n_gl(2,a,m+l,nw) + &
(delta_p_gl(num,a,2,m+l,k,nw) + dtmp_c(num,2,a,m+l,k,nw)) * een_rescaled_delta_n_gl(2,a,m ,nw) + &
(delta_p_gl(num,a,3,m ,k,nw) + dtmp_c(num,3,a,m ,k,nw)) * een_rescaled_delta_n_gl(3,a,m+l,nw) + &
(delta_p_gl(num,a,3,m+l,k,nw) + dtmp_c(num,3,a,m+l,k,nw)) * een_rescaled_delta_n_gl(3,a,m ,nw) ) * cn
end do
end do
end do
end function qmckl_compute_jastrow_champ_factor_single_een_gl_doc
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code
qmckl_compute_jastrow_champ_factor_single_een_gl_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 cord_num,
const int64_t dim_c_vector,
const double* c_vector_full,
const int64_t* lkpm_combined_index,
const double* tmp_c,
const double* dtmp_c,
const double* delta_p,
const double* delta_p_gl,
const double* een_rescaled_n,
const double* een_rescaled_single_n,
const double* een_rescaled_n_gl,
const double* een_rescaled_single_n_gl,
double* const delta_een_gl );
qmckl_exit_code
qmckl_compute_jastrow_champ_factor_single_een_gl (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 cord_num,
const int64_t dim_c_vector,
const double* c_vector_full,
const int64_t* lkpm_combined_index,
const double* tmp_c,
const double* dtmp_c,
const double* delta_p,
const double* delta_p_gl,
const double* een_rescaled_n,
const double* een_rescaled_single_n,
const double* een_rescaled_n_gl,
const double* een_rescaled_single_n_gl,
double* const delta_een_gl );
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_compute_jastrow_champ_factor_single_een_gl (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 cord_num,
const int64_t dim_c_vector,
const double* c_vector_full,
const int64_t* lkpm_combined_index,
const double* tmp_c,
const double* dtmp_c,
const double* delta_p,
const double* delta_p_gl,
const double* een_rescaled_n,
const double* een_rescaled_single_n,
const double* een_rescaled_n_gl,
const double* een_rescaled_single_n_gl,
double* const delta_een_gl )
{
#ifdef HAVE_HPC
return qmckl_compute_jastrow_champ_factor_single_een_gl_doc
#else
return qmckl_compute_jastrow_champ_factor_single_een_gl_doc
#endif
(context, num, walk_num, elec_num, nucl_num, cord_num, dim_c_vector,
c_vector_full, lkpm_combined_index, tmp_c, dtmp_c, delta_p, delta_p_gl, een_rescaled_n, een_rescaled_single_n, een_rescaled_n_gl, een_rescaled_single_n_gl, delta_een_gl );
}
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("Delta een gl\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double een_gl_old[walk_num][4][elec_num];
double delta_een_gl[walk_num][4][elec_num];
double een_gl_new[walk_num][4][elec_num];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een_gl(context, &een_gl_old[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_een_gl(context, &delta_een_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een_gl(context, &een_gl_new[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++) {
for (int m = 0; m < 4; m++) {
for (int i = 0; i < elec_num; i++) {
//printf("delta_een_gl[%d][%d][%d] = %f\n", nw, i, m, delta_een_gl[nw][i][m]);
//printf("een_gl_[%d][%d][%d] = %f\n", nw, m,i, een_gl_new[nw][m][i]-een_gl_old[nw][m][i]);
assert(fabs((een_gl_new[nw][m][i]- een_gl_old[nw][m][i]) - delta_een_gl[nw][m][i]) < 1.e-12);
}
}
}
}
printf("OK\n");
#+end_src
** $\delta P$ matrix gradients and Laplacian
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_jastrow_champ_delta_p_g(qmckl_context context,
double* const delta_p_g,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_jastrow_champ_delta_p_g(qmckl_context context,
double* const delta_p_g,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_jastrow_champ_delta_p_g(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
int64_t sze = ctx->electron.walker.num * ctx->jastrow_champ.cord_num *
(ctx->jastrow_champ.cord_num + 1) * ctx->nucleus.num * ctx->electron.num * 4;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_jastrow_champ_delta_p_g",
"Array too small.");
}
memcpy(delta_p_g, ctx->single_point.delta_p_g, sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
*** provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_delta_p_g(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_delta_p_g(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
qmckl_exit_code rc = qmckl_provide_een_rescaled_single_e(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_een_rescaled_n(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_een_rescaled_e(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_een_rescaled_n_gl(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_een_rescaled_e_gl(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_een_rescaled_single_n(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_een_rescaled_single_e_gl(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_een_rescaled_single_n_gl(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.delta_p_g_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = 4 * ctx->electron.walker.num * ctx->jastrow_champ.cord_num *
(ctx->jastrow_champ.cord_num + 1) * ctx->nucleus.num * ctx->electron.num * sizeof(double);
if (mem_info.size > ctx->single_point.delta_p_g_maxsize) {
if (ctx->single_point.delta_p_g != NULL) {
rc = qmckl_free(context, ctx->single_point.delta_p_g);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_jastrow_champ_delta_p_g",
"Unable to free ctx->single_point.delta_p_g");
}
ctx->single_point.delta_p_g = NULL;
}
}
/* Allocate array */
if (ctx->single_point.delta_p_g == NULL) {
double* delta_p_g = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.delta_p_g_maxsize = mem_info.size;
if (delta_p_g == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_jastrow_champ_delta_p_g",
NULL);
}
ctx->single_point.delta_p_g = delta_p_g;
}
rc = qmckl_compute_jastrow_champ_delta_p_g(context,
ctx->single_point.num,
ctx->electron.walker.num,
ctx->electron.num,
ctx->nucleus.num,
ctx->jastrow_champ.cord_num,
ctx->jastrow_champ.een_rescaled_n,
ctx->jastrow_champ.een_rescaled_e,
ctx->single_point.een_rescaled_single_n,
ctx->single_point.een_rescaled_single_e,
ctx->jastrow_champ.een_rescaled_n_gl,
ctx->jastrow_champ.een_rescaled_e_gl,
ctx->single_point.een_rescaled_single_n_gl,
ctx->single_point.een_rescaled_single_e_gl,
ctx->single_point.delta_p_g);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.delta_p_g_date = ctx->single_point.date;
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_jastrow_champ_delta_p_g_doc
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_factor_delta_p_g_args
| Variable | Type | In/Out | Description |
|----------------------------+---------------------------------------------------------------------+--------+---------------------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~num~ | ~int64_t~ | in | Index of single electron |
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
| ~nucl_num~ | ~int64_t~ | in | Number of nuclei |
| ~cord_num~ | ~int64_t~ | in | order of polynomials |
| ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | in | Electron-nucleus rescaled distances |
| ~een_rescaled_e~ | ~double[walk_num][0:cord_num][elec_num][elec_num]~ | in | Electron-electron rescaled distances |
| ~een_rescaled_single_n~ | ~double[walk_num][0:cord_num][nucl_num]~ | in | Electron-nucleus single rescaled distances |
| ~een_rescaled_single_e~ | ~double[walk_num][0:cord_num][elec_num]~ | in | Electron-electron single rescaled distances |
| ~een_rescaled_n_gl~ | ~double[walk_num][0:cord_num][nucl_num][4][elec_num]~ | in | Electron-nucleus rescaled distances derivatives |
| ~een_rescaled_e_gl~ | ~double[walk_num][0:cord_num][elec_num][4][elec_num]~ | in | Electron-electron rescaled distances derivatives |
| ~een_rescaled_single_n_gl~ | ~double[walk_num][0:cord_num][nucl_num][4]~ | in | Electron-nucleus single rescaled distances derivatives |
| ~een_rescaled_single_e_gl~ | ~double[walk_num][0:cord_num][elec_num][4]~ | in | Electron-electron single rescaled distances derivatives |
| ~delta_p_g~ | ~double[walk_num][0:cord_num-1][0:cord_num][4][nucl_num][elec_num]~ | out | Delta P matrix gradient and Laplacian |
|----------------------------+---------------------------------------------------------------------+--------+---------------------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer(qmckl_exit_code) function qmckl_compute_jastrow_champ_delta_p_g_doc( &
context, num_in, walk_num, elec_num, nucl_num, cord_num, &
een_rescaled_n, een_rescaled_e, een_rescaled_single_n, een_rescaled_single_e, &
een_rescaled_n_gl, een_rescaled_e_gl, een_rescaled_single_n_gl, een_rescaled_single_e_gl, delta_p_g) &
result(info) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in) :: context
integer(c_int64_t) , intent(in), value :: num_in, walk_num, elec_num, cord_num, nucl_num
real(c_double) , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_single_n(nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_single_e(elec_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_n_gl(elec_num, 4, nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_e_gl(elec_num, 4, elec_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_single_n_gl(4, nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_single_e_gl(4,elec_num, 0:cord_num, walk_num)
real(c_double) , intent(out) :: delta_p_g(elec_num,nucl_num,4,0:cord_num, 0:cord_num-1, walk_num)
double precision :: delta_e_gl(elec_num,4)
double precision :: een_rescaled_delta_n, een_re_n, een_re_single_n
integer*8 :: i, a, j, l, k, p, m, n, nw, num
double precision :: tmp, cummu
integer*8 :: LDA, LDB, LDC
num = num_in + 1
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) info = QMCKL_INVALID_CONTEXT
if (walk_num <= 0) info = QMCKL_INVALID_ARG_3
if (elec_num <= 0) info = QMCKL_INVALID_ARG_4
if (nucl_num <= 0) info = QMCKL_INVALID_ARG_5
if (cord_num < 0) info = QMCKL_INVALID_ARG_6
if (info /= QMCKL_SUCCESS) return
if (cord_num == 0) then
delta_p_g = 0.d0
return
endif
do nw=1, walk_num
do m=1, cord_num-1
do j = 1, elec_num
do k = 1, 4
delta_e_gl(j,k) = een_rescaled_single_e_gl(k,j,m,nw) - een_rescaled_e_gl(num, k, j, m, nw)
end do
end do
do k = 1, 4
delta_e_gl(num, k) = 0.0d0
end do
do l=0, cord_num
do k = 1, 3
do a = 1, nucl_num
cummu = 0.0d0
do i = 1, elec_num
cummu = cummu + delta_e_gl(i,k) * een_rescaled_n(i,a,l,nw)
end do
delta_p_g(num,a,k,l,m,nw) = cummu
end do
end do
end do
end do
end do
end function qmckl_compute_jastrow_champ_delta_p_g_doc
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code
qmckl_compute_jastrow_champ_delta_p_g_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 cord_num,
const double* een_rescaled_n,
const double* een_rescaled_e,
const double* een_rescaled_single_n,
const double* een_rescaled_single_e,
const double* een_rescaled_n_gl,
const double* een_rescaled_e_gl,
const double* een_rescaled_single_n_gl,
const double* een_rescaled_single_e_gl,
double* const delta_p_g );
qmckl_exit_code
qmckl_compute_jastrow_champ_delta_p_g (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 cord_num,
const double* een_rescaled_n,
const double* een_rescaled_e,
const double* een_rescaled_single_n,
const double* een_rescaled_single_e,
const double* een_rescaled_n_gl,
const double* een_rescaled_e_gl,
const double* een_rescaled_single_n_gl,
const double* een_rescaled_single_e_gl,
double* const delta_p_g );
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_compute_jastrow_champ_delta_p_g (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 cord_num,
const double* een_rescaled_n,
const double* een_rescaled_e,
const double* een_rescaled_single_n,
const double* een_rescaled_single_e,
const double* een_rescaled_n_gl,
const double* een_rescaled_e_gl,
const double* een_rescaled_single_n_gl,
const double* een_rescaled_single_e_gl,
double* const delta_p_g )
{
#ifdef HAVE_HPC
return qmckl_compute_jastrow_champ_delta_p_g_doc
#else
return qmckl_compute_jastrow_champ_delta_p_g_doc
#endif
(context, num, walk_num, elec_num, nucl_num, cord_num,
een_rescaled_n, een_rescaled_e, een_rescaled_single_n, een_rescaled_single_e,
een_rescaled_n_gl, een_rescaled_e_gl, een_rescaled_single_n_gl, een_rescaled_single_e_gl, delta_p_g);
}
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("Delta P g\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
p_gl_old[walk_num][cord_num][cord_num+1][nucl_num][4][elec_num];
double delta_p_g[walk_num][cord_num][cord_num+1][4][nucl_num][elec_num];
p_gl_new[walk_num][cord_num][cord_num+1][nucl_num][4][elec_num];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_dtmp_c(context, &p_gl_old[0][0][0][0][0][0], walk_num*cord_num*(cord_num+1)*nucl_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_delta_p_g(context, &delta_p_g[0][0][0][0][0][0], 4*walk_num*cord_num*(cord_num+1)*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_dtmp_c(context, &p_gl_new[0][0][0][0][0][0], walk_num*cord_num*(cord_num+1)*nucl_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++){
for (int l = 0; l < cord_num; l++){
for (int m = 0; m <= cord_num; m++){
for (int a = 0; a < nucl_num; a++) {
for (int k = 0; k < 3; k++){
if (fabs(((p_gl_new[nw][l][m][a][k][elec]-p_gl_old[nw][l][m][a][k][elec])-delta_p_g[nw][l][m][k][a][elec])) > 1.e-12) {
printf("p_gl[%d][%d][%d][%d][%d][%d] = %f\n", nw, l, m, a, k, elec, p_gl_new[nw][l][m][a][k][elec] - p_gl_old[nw][l][m][a][k][elec]);
printf("delta_p_g[%d][%d][%d][%d][%d][%d] = %f\n", nw, l, m, a, k, elec, delta_p_g[nw][l][m][k][a][elec]);
}
assert(fabs(((p_gl_new[nw][l][m][a][k][elec]-p_gl_old[nw][l][m][a][k][elec])-delta_p_g[nw][l][m][k][a][elec])) < 1.e-12);
}
}
}
}
}
}
printf("OK\n");
#+end_src
** Electron-electron-nucleus Jastrow gradients
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_jastrow_champ_single_een_g(qmckl_context context,
double* const delta_een_g,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_jastrow_champ_single_een_g(qmckl_context context,
double* const delta_een_g,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_jastrow_champ_single_een_g(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
if (delta_een_g == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_get_jastrow_champ_single_een_g",
"Array is NULL.");
}
int64_t sze = 4 * ctx->electron.num * ctx->electron.walker.num;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_jastrow_champ_single_een_g",
"Array too small. Expected 4 * ctx->electron.num * ctx->electron.walker.num");
}
memcpy(delta_een_g, ctx->single_point.delta_een_g, sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org
interface
integer(qmckl_exit_code) function qmckl_get_jastrow_champ_single_een_g (context, &
delta_een_g, 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_g(size_max)
end function
end interface
#+end_src
*** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_single_een_g(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_single_een_g(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
qmckl_exit_code rc;
if (ctx->jastrow_champ.cord_num > 0) {
rc = qmckl_provide_jastrow_champ_delta_p(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_jastrow_champ_factor_een(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_jastrow_champ_delta_p_g(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_jastrow_champ_factor_een_gl(context);
if(rc != QMCKL_SUCCESS) return rc;
}
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.delta_een_g_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = 4 * ctx->electron.num * ctx->electron.walker.num * sizeof(double);
if (mem_info.size > ctx->single_point.delta_een_g_maxsize) {
if (ctx->single_point.delta_een_g != NULL) {
rc = qmckl_free(context, ctx->single_point.delta_een_g);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_jastrow_champ_single_een_g",
"Unable to free ctx->single_point.delta_een_g");
}
ctx->single_point.delta_een_g = NULL;
}
}
/* Allocate array */
if (ctx->single_point.delta_een_g == NULL) {
double* delta_een_g = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.delta_een_g_maxsize = mem_info.size;
if (delta_een_g == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_jastrow_champ_single_een_g",
NULL);
}
ctx->single_point.delta_een_g = delta_een_g;
}
rc = qmckl_compute_jastrow_champ_factor_single_een_g_doc(context,
ctx->single_point.num,
ctx->electron.walker.num,
ctx->electron.num,
ctx->nucleus.num,
ctx->jastrow_champ.cord_num,
ctx->jastrow_champ.dim_c_vector,
ctx->jastrow_champ.c_vector_full,
ctx->jastrow_champ.lkpm_combined_index,
ctx->jastrow_champ.tmp_c,
ctx->jastrow_champ.dtmp_c,
ctx->single_point.delta_p,
ctx->single_point.delta_p_g,
ctx->jastrow_champ.een_rescaled_n,
ctx->single_point.een_rescaled_single_n,
ctx->jastrow_champ.een_rescaled_n_gl,
ctx->single_point.een_rescaled_single_n_gl,
ctx->single_point.delta_een_g);
if (rc != QMCKL_SUCCESS) {
return rc;
}
//ctx->single_point.delta_een_g_date = ctx->single_point.date;
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_jastrow_champ_factor_single_een_g_doc
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_factor_single_een_g_args
| Variable | Type | In/Out | Description |
|----------------------------+---------------------------------------------------------------------+--------+----------------------------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~num~ | ~int64_t~ | in | Index of single electron |
| ~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[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | in | Delta P matrix |
| ~delta_p_gl~ | ~double[walk_num][0:cord_num-1][0:cord_num][4][nucl_num][elec_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_single_n~ | ~double[walk_num][0:cord_num][nucl_num]~ | in | Electron-nucleus single rescaled distances |
| ~een_rescaled_n_gl~ | ~double[walk_num][0:cord_num][nucl_num][4][elec_num]~ | in | Electron-nucleus rescaled distances derivatives |
| ~een_rescaled_single_n_gl~ | ~double[walk_num][0:cord_num][nucl_num][4]~ | in | Electron-nucleus single rescaled distances derivatives |
| ~delta_een_g~ | ~double[walk_num][4][elec_num]~ | out | Delta electron-electron-nucleus jastrow gradient |
|----------------------------+---------------------------------------------------------------------+--------+----------------------------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer(qmckl_exit_code) function qmckl_compute_jastrow_champ_factor_single_een_g_doc( &
context, num_in, walk_num, elec_num, nucl_num, cord_num, &
dim_c_vector, c_vector_full, lkpm_combined_index, &
tmp_c, dtmp_c, delta_p, delta_p_gl, een_rescaled_n, een_rescaled_single_n, &
een_rescaled_n_gl, een_rescaled_single_n_gl, delta_een_g) &
result(info) bind(C)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in) :: context
integer(c_int64_t) , intent(in), value :: num_in, walk_num, elec_num, cord_num, nucl_num, dim_c_vector
integer(c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,4)
real(c_double) , intent(in) :: c_vector_full(nucl_num, dim_c_vector)
real(c_double) , intent(in) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num)
real(c_double) , intent(in) :: dtmp_c(elec_num, 4, nucl_num,0:cord_num, 0:cord_num-1, walk_num)
real(c_double) , intent(in) :: delta_p(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num)
real(c_double) , intent(in) :: delta_p_gl(elec_num, nucl_num, 4, 0:cord_num, 0:cord_num-1, walk_num)
real(c_double) , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_single_n(nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_n_gl(elec_num, 4, nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(in) :: een_rescaled_single_n_gl(4, nucl_num, 0:cord_num, walk_num)
real(c_double) , intent(out) :: delta_een_g(elec_num, 4, walk_num)
integer*8 :: i, a, j, l, k, p, m, n, nw, kk, num
double precision :: accu, accu2, cn
integer*8 :: LDA, LDB, LDC
double precision :: een_rescaled_delta_n_gl(4, nucl_num, 0:cord_num, walk_num)
double precision :: een_rescaled_delta_n(nucl_num, 0:cord_num, walk_num)
num = num_in + 1
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) info = QMCKL_INVALID_CONTEXT
if (walk_num <= 0) info = QMCKL_INVALID_ARG_3
if (elec_num <= 0) info = QMCKL_INVALID_ARG_4
if (nucl_num <= 0) info = QMCKL_INVALID_ARG_5
if (cord_num < 0) info = QMCKL_INVALID_ARG_6
if (info /= QMCKL_SUCCESS) return
delta_een_g = 0.0d0
if (cord_num == 0) return
een_rescaled_delta_n(:,:,:) = een_rescaled_single_n(:,:,:) - een_rescaled_n(num, :, :, :)
een_rescaled_delta_n_gl(:,:,:,:) = een_rescaled_single_n_gl(:,:,:,:) - een_rescaled_n_gl(num, :,:,:,:)
do nw =1, walk_num
do n = 1, dim_c_vector
l = lkpm_combined_index(n, 1)
k = lkpm_combined_index(n, 2)
p = lkpm_combined_index(n, 3)
m = lkpm_combined_index(n, 4)
do kk = 1, 3
do a = 1, nucl_num
cn = c_vector_full(a, n)
if(cn == 0.d0) cycle
! delta_een_g(num,kk,nw) = delta_een_g(num,kk,nw) + ( &
! delta_p_gl(num,a,kk,m ,k,nw) * een_rescaled_n(num,a,m+l,nw) + &
! delta_p_gl(num,a,kk,m+l,k,nw) * een_rescaled_n(num,a,m ,nw) + &
! delta_p(num,a,m ,k,nw) * een_rescaled_n_gl(num,kk,a,m+l,nw) + &
! delta_p(num,a,m+l,k,nw) * een_rescaled_n_gl(num,kk,a,m ,nw) ) * cn
!delta_een_g(num,kk,nw) = delta_een_g(num,kk,nw) + ( &
! (dtmp_c(num,kk,a,m ,k,nw) + delta_p_gl(num,a,kk,m ,k,nw)) * een_rescaled_delta_n(a,m+l,nw) + &
! (dtmp_c(num,kk,a,m+l,k,nw) + delta_p_gl(num,a,kk,m+l,k,nw)) * een_rescaled_delta_n(a,m ,nw) + &
! (tmp_c(num,a,m ,k,nw) + delta_p(num,a,m ,k,nw)) * een_rescaled_delta_n_gl(kk,a,m+l,nw) + &
! (tmp_c(num,a,m+l,k,nw) + delta_p(num,a,m+l,k,nw)) * een_rescaled_delta_n_gl(kk,a,m ,nw) )* cn
delta_een_g(num,kk,nw) = delta_een_g(num,kk,nw) + ( &
dtmp_c(num,kk,a,m ,k,nw) * een_rescaled_delta_n(a,m+l,nw) + &
dtmp_c(num,kk,a,m+l,k,nw) * een_rescaled_delta_n(a,m ,nw) + &
tmp_c(num,a,m ,k,nw) * een_rescaled_delta_n_gl(kk,a,m+l,nw) + &
tmp_c(num,a,m+l,k,nw) * een_rescaled_delta_n_gl(kk,a,m ,nw) + &
delta_p_gl(num,a,kk,m ,k,nw) * een_rescaled_single_n(a,m+l,nw) + &
delta_p_gl(num,a,kk,m+l,k,nw) * een_rescaled_single_n(a,m ,nw) + &
delta_p(num,a,m ,k,nw) * een_rescaled_single_n_gl(kk,a,m+l,nw) + &
delta_p(num,a,m+l,k,nw) * een_rescaled_single_n_gl(kk,a,m ,nw) )* cn
end do
end do
end do
end do
end function qmckl_compute_jastrow_champ_factor_single_een_g_doc
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code
qmckl_compute_jastrow_champ_factor_single_een_g_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 cord_num,
const int64_t dim_c_vector,
const double* c_vector_full,
const int64_t* lkpm_combined_index,
const double* tmp_c,
const double* dtmp_c,
const double* delta_p,
const double* delta_p_gl,
const double* een_rescaled_n,
const double* een_rescaled_single_n,
const double* een_rescaled_n_gl,
const double* een_rescaled_single_n_gl,
double* const delta_een_g );
qmckl_exit_code
qmckl_compute_jastrow_champ_factor_single_een_g (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 cord_num,
const int64_t dim_c_vector,
const double* c_vector_full,
const int64_t* lkpm_combined_index,
const double* tmp_c,
const double* dtmp_c,
const double* delta_p,
const double* delta_p_gl,
const double* een_rescaled_n,
const double* een_rescaled_single_n,
const double* een_rescaled_n_gl,
const double* een_rescaled_single_n_gl,
double* const delta_een_g );
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_compute_jastrow_champ_factor_single_een_g (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 cord_num,
const int64_t dim_c_vector,
const double* c_vector_full,
const int64_t* lkpm_combined_index,
const double* tmp_c,
const double* dtmp_c,
const double* delta_p,
const double* delta_p_gl,
const double* een_rescaled_n,
const double* een_rescaled_single_n,
const double* een_rescaled_n_gl,
const double* een_rescaled_single_n_gl,
double* const delta_een_g )
{
#ifdef HAVE_HPC
return qmckl_compute_jastrow_champ_factor_single_een_g_doc
#else
return qmckl_compute_jastrow_champ_factor_single_een_g_doc
#endif
(context, num, walk_num, elec_num, nucl_num, cord_num, dim_c_vector,
c_vector_full, lkpm_combined_index, tmp_c, dtmp_c, delta_p, delta_p_gl, een_rescaled_n, een_rescaled_single_n, een_rescaled_n_gl, een_rescaled_single_n_gl, delta_een_g );
}
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("Delta een g\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double een_g_old[walk_num][4][elec_num];
double delta_een_g[walk_num][4][elec_num];
double een_g_new[walk_num][4][elec_num];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een_gl(context, &een_g_old[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_een_g(context, &delta_een_g[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een_gl(context, &een_g_new[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++) {
for (int m = 0; m < 3; m++) {
//for (int i = 0; i < elec_num; i++) {
//printf("delta_een_g[%d][%d][%d] = %f\n", nw, i, m, delta_een_g[nw][i][m]);
//printf("een_g_[%d][%d][%d] = %f\n", nw, m,i, een_g_new[nw][m][i]-een_g_old[nw][m][i]);
assert(fabs((een_g_new[nw][m][elec]- een_g_old[nw][m][elec]) - delta_een_g[nw][m][elec]) < 1.e-12);
//}
}
}
}
printf("OK\n");
#+end_src
* Electron-electron Jastrow
** Electron-electron rescaled distance
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_ee_rescaled_single(qmckl_context context,
double* const distance_rescaled,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_ee_rescaled_single(qmckl_context context,
double* const distance_rescaled,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_ee_rescaled_single(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
int64_t sze = ctx->electron.num * ctx->electron.walker.num;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"todo",
"Array too small. Expected ctx->electron.num * ctx->electron.walker.num ");
}
memcpy(distance_rescaled, ctx->single_point.ee_rescaled_single, sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
*** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_ee_rescaled_single(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_ee_rescaled_single(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
/* Check if ee distance is provided */
qmckl_exit_code rc = qmckl_provide_single_ee_distance(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_ee_distance(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.ee_rescaled_single_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->electron.num * ctx->electron.walker.num * sizeof(double);
if (mem_info.size > ctx->single_point.ee_rescaled_single_maxsize) {
if (ctx->single_point.ee_rescaled_single!= NULL) {
rc = qmckl_free(context, ctx->single_point.ee_rescaled_single);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_ee_rescaled_single",
"Unable to free ctx->single_point.ee_rescaled_single");
}
ctx->single_point.ee_rescaled_single = NULL;
}
}
/* Allocate array */
if (ctx->single_point.ee_rescaled_single == NULL) {
double* ee_rescaled_single = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.ee_rescaled_single_maxsize = mem_info.size;
if (ee_rescaled_single == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_ee_rescaled_single",
NULL);
}
ctx->single_point.ee_rescaled_single = ee_rescaled_single;
}
rc = qmckl_compute_ee_rescaled_single(context,
ctx->electron.num,
ctx->jastrow_champ.rescale_factor_ee,
ctx->electron.walker.num,
ctx->single_point.single_ee_distance,
ctx->single_point.ee_rescaled_single);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.ee_rescaled_single_date = ctx->single_point.date;
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_ee_rescaled_single
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_ee_rescaled_single_args
| 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 | Single electron-electron distances |
| ~ee_rescaled_single~ | ~double[walk_num][elec_num]~ | out | Electron-electron rescaled distances |
|----------------------+------------------------------+--------+--------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
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
#+end_src
#+begin_src c :tangle (eval h_private_func) :comments org :exports none
qmckl_exit_code qmckl_compute_ee_rescaled_single_doc (
const qmckl_context context,
const int64_t elec_num,
const double rescale_factor_ee,
const int64_t walk_num,
const double* single_ee_distance,
double* const ee_rescaled_single );
qmckl_exit_code qmckl_compute_ee_rescaled_single(
const qmckl_context context,
const int64_t elec_num,
const double rescale_factor_ee,
const int64_t walk_num,
const double* single_ee_distance,
double* const ee_rescaled_single );
#+end_src
#+begin_src c :tangle (eval c) :comments org :exports none
qmckl_exit_code qmckl_compute_ee_rescaled_single (
const qmckl_context context,
const int64_t elec_num,
const double rescale_factor_ee,
const int64_t walk_num,
const double* single_ee_distance,
double* const ee_rescaled_single )
{
#ifdef HAVE_HPC
return qmckl_compute_ee_rescaled_single_doc
#else
return qmckl_compute_ee_rescaled_single_doc
#endif
(context, elec_num, rescale_factor_ee, walk_num, single_ee_distance, ee_rescaled_single);
}
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("ee rescaled single\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double ee_rescaled[walk_num][elec_num][elec_num];
double single_ee_rescaled[walk_num][elec_num];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_ee_distance_rescaled(context, &ee_rescaled[0][0][0], walk_num*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_ee_rescaled_single(context, &single_ee_rescaled[0][0], walk_num*elec_num);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_ee_distance_rescaled(context, &ee_rescaled[0][0][0], walk_num*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++){
//printf("nw %d i %d %f %f\n", nw, i, ee_rescaled[nw][2][i], single_ee_rescaled[nw][i]);
assert(fabs(ee_rescaled[nw][elec][i]-single_ee_rescaled[nw][i]) < 1.e-12);
assert(fabs(ee_rescaled[nw][i][elec]-single_ee_rescaled[nw][i]) < 1.e-12);
}
}
}
printf("OK\n");
#+end_src
** Electron-electron Jastrow value
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_jastrow_champ_single_ee(qmckl_context context,
double* const delta_ee,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_jastrow_champ_single_ee(qmckl_context context,
double* const delta_ee,
const int64_t size_max)
{
qmckl_exit_code rc;
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_get_jastrow_champ_single_ee",
NULL);
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
rc = qmckl_provide_jastrow_champ_single_ee(context);
if (rc != QMCKL_SUCCESS) return rc;
int64_t sze=ctx->electron.walker.num;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_jastrow_champ_single_ee",
"Array too small. Expected walker.num");
}
memcpy(delta_ee, ctx->single_point.delta_ee, sze*sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org
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
#+end_src
*** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_single_ee(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_single_ee(qmckl_context context)
{
qmckl_exit_code rc;
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_provide_jastrow_champ_single_ee",
NULL);
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
if (!ctx->jastrow_champ.provided) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_provide_jastrow_champ_single_ee",
NULL);
}
rc = qmckl_provide_ee_distance_rescaled(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_ee_rescaled_single(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.delta_ee_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->electron.walker.num * sizeof(double);
if (mem_info.size > ctx->single_point.delta_ee_maxsize) {
if (ctx->single_point.delta_ee != NULL) {
rc = qmckl_free(context, ctx->single_point.delta_ee);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_jastrow_champ_single_ee",
"Unable to free ctx->single_point.delta_ee");
}
ctx->single_point.delta_ee = NULL;
}
}
/* Allocate array */
if (ctx->single_point.delta_ee == NULL) {
double* delta_ee = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.delta_ee_maxsize = mem_info.size;
if (delta_ee == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_jastrow_champ_single_ee",
NULL);
}
ctx->single_point.delta_ee = delta_ee;
}
rc = qmckl_compute_jastrow_champ_single_ee(context,
ctx->single_point.num,
ctx->electron.walker.num,
ctx->electron.num,
ctx->electron.up_num,
ctx->jastrow_champ.bord_num,
ctx->jastrow_champ.b_vector,
ctx->jastrow_champ.ee_distance_rescaled,
ctx->single_point.ee_rescaled_single,
ctx->jastrow_champ.spin_independent,
ctx->single_point.delta_ee);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.delta_ee_date = ctx->single_point.date;
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_jastrow_champ_single_ee
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_single_ee_args
| Variable | Type | In/Out | Description |
|------------------------+----------------------------------------+--------+---------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~num~ | ~int64_t~ | in | Index of single 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_single~ | ~double[walk_num][elec_num]~ | in | Electron-electron rescaled single distances |
| ~delta_ee~ | ~double[walk_num]~ | out | Single electron-electron Jastrow |
|------------------------+----------------------------------------+--------+---------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
function qmckl_compute_jastrow_champ_single_ee_doc(context, &
num_in, walk_num, elec_num, up_num, bord_num, b_vector, &
ee_distance_rescaled, ee_rescaled_single, spin_independent, delta_ee) &
bind(C) result(info)
use qmckl
implicit none
integer (qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in), value :: num_in
integer (c_int64_t) , intent(in), value :: walk_num
integer (c_int64_t) , intent(in), value :: elec_num
integer (c_int64_t) , intent(in), value :: up_num
integer (c_int64_t) , intent(in), value :: bord_num
real (c_double ) , intent(in) :: b_vector(bord_num+1)
real (c_double ) , intent(in) :: ee_distance_rescaled(elec_num,elec_num,walk_num)
real (c_double ) , intent(in) :: ee_rescaled_single(elec_num,walk_num)
integer (c_int32_t) , intent(in), value :: spin_independent
real (c_double ) , intent(out) :: delta_ee(walk_num)
integer(qmckl_exit_code) :: info
integer*8 :: i, j, k, nw, num
double precision :: x, xk, y, yk
num = num_in + 1
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif
if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif
if (elec_num <= 0) then
info = QMCKL_INVALID_ARG_4
return
endif
if (bord_num < 0) then
info = QMCKL_INVALID_ARG_5
return
endif
do nw =1, walk_num
delta_ee(nw) = 0.0d0
do i=1,elec_num
!print *,i, ee_rescaled_single(i,nw)
!print *, i, ee_distance_rescaled(i,num,nw)
!print *, ' '
if (i.ne.num) then
x = ee_distance_rescaled(i,num,nw)
y = ee_rescaled_single(i,nw)
if (spin_independent == 1) then
delta_ee(nw) = delta_ee(nw) - (b_vector(1) * x / (1.d0 + b_vector(2) * x)) &
+ (b_vector(1) * y / (1.d0 + b_vector(2) * y))
else
if ((i <= up_num .and. num <= up_num ) .or. (i > up_num .and. num > up_num)) then
delta_ee(nw) = delta_ee(nw) - (0.5d0 * b_vector(1) * x / (1.d0 + b_vector(2) * x)) &
+ (0.5d0 * b_vector(1) * y / (1.d0 + b_vector(2) * y))
else
delta_ee(nw) = delta_ee(nw) - (b_vector(1) * x / (1.d0 + b_vector(2) * x)) &
+ (b_vector(1) * y / (1.d0 + b_vector(2) * y))
endif
endif
xk = x
yk = y
do k=2,bord_num
xk = xk * x
yk = yk * y
delta_ee(nw) = delta_ee(nw) - (b_vector(k+1) * xk) + (b_vector(k+1) * yk)
end do
endif
end do
end do
end function qmckl_compute_jastrow_champ_single_ee_doc
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code
qmckl_compute_jastrow_champ_single_ee_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_rescaled_singe,
const int32_t spin_independent,
double* const delta_ee );
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
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 );
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes
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);
}
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("Delta ee\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double jastrow_ee_old[walk_num];
double delta_ee[walk_num];
double jastrow_ee_new[walk_num];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee(context, &jastrow_ee_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_ee(context, &delta_ee[0], walk_num);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee(context, &jastrow_ee_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++) {
//printf("%f %f %f %3.14f\n", jastrow_ee_new[nw], jastrow_ee_old[nw], delta_ee[nw], fabs((jastrow_ee_new[nw] - jastrow_ee_old[nw]) - delta_ee[nw]));
assert(fabs((jastrow_ee_new[nw] - jastrow_ee_old[nw]) - delta_ee[nw]) < 1.e-12);
}
}
printf("OK\n");
#+end_src
** Electron-electron rescaled distances derivatives
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code qmckl_get_ee_rescaled_single_gl(qmckl_context context,
double* const distance_rescaled_gl,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_get_ee_rescaled_single_gl(qmckl_context context,
double* const distance_rescaled_gl,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_ee_rescaled_single_gl(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
if (distance_rescaled_gl == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_get_ee_rescaled_single_gl",
"Array is NULL");
}
int64_t sze = 4 * ctx->electron.num * ctx->electron.walker.num;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_ee_rescaled_single_gl",
"Array too small. Expected 4 * ctx->electron.num * ctx->electron.walker.num");
}
memcpy(distance_rescaled_gl, ctx->single_point.ee_rescaled_single_gl, sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
*** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_ee_rescaled_single_gl(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_ee_rescaled_single_gl(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
qmckl_exit_code rc = qmckl_provide_single_ee_distance(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.ee_rescaled_single_gl_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = 4 * ctx->electron.num * ctx->electron.walker.num * sizeof(double);
if (mem_info.size > ctx->single_point.ee_rescaled_single_gl_maxsize) {
if (ctx->single_point.ee_rescaled_single_gl != NULL) {
rc = qmckl_free(context, ctx->single_point.ee_rescaled_single_gl);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_ee_rescaled_single_gl",
"Unable to free ctx->single_point.ee_rescaled_single_gl");
}
ctx->single_point.ee_rescaled_single_gl = NULL;
}
}
/* Allocate array */
if (ctx->single_point.ee_rescaled_single_gl == NULL) {
double* ee_rescaled_single_gl = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.ee_rescaled_single_gl_maxsize = mem_info.size;
if (ee_rescaled_single_gl == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_ee_rescaled_single_gl",
NULL);
}
ctx->single_point.ee_rescaled_single_gl = ee_rescaled_single_gl;
}
qmckl_exit_code rc =
qmckl_compute_ee_rescaled_single_gl(context,
ctx->single_point.num,
ctx->electron.num,
ctx->jastrow_champ.rescale_factor_ee,
ctx->electron.walker.num,
ctx->single_point.single_ee_distance,
ctx->electron.walker.point.coord.data,
ctx->single_point.coord.data,
ctx->single_point.ee_rescaled_single_gl);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.ee_rescaled_single_gl_date = ctx->single_point.date;
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_ee_rescaled_single_gl
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_ee_rescaled_single_gl_args
| Variable | Type | In/Out | Description |
|-------------------------+---------------------------------+--------+--------------------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~num~ | ~int64_t~ | in | Index of single 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 |
| ~single_ee_distance~ | ~double[elec_num][walk_num]~ | in | Single electron-electron distances |
| ~elec_coord~ | ~double[3][walk_num][elec_num]~ | in | Electron coordinates |
| ~coord~ | ~double[walk_num][3]~ | in | Single electron coordinates |
| ~ee_rescaled_single_gl~ | ~double[walk_num][elec_num][4]~ | out | Electron-electron rescaled single distance derivatives |
|-------------------------+---------------------------------+--------+--------------------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
function qmckl_compute_ee_rescaled_single_gl_doc(context, num_in, &
elec_num, rescale_factor_ee, walk_num, single_ee_distance, elec_coord, coord, ee_rescaled_single_gl) &
bind(C) result(info)
use qmckl
implicit none
integer(qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in) , value :: num_in
integer (c_int64_t) , intent(in) , value :: elec_num
real (c_double ) , intent(in) , value :: rescale_factor_ee
integer (c_int64_t) , intent(in) , value :: walk_num
real (c_double ) , intent(in) :: single_ee_distance(elec_num,walk_num)
real (c_double ) , intent(in) :: elec_coord(elec_num,walk_num,3)
real (c_double ) , intent(in) :: coord(3,walk_num)
real (c_double ) , intent(out) :: ee_rescaled_single_gl(4,elec_num,walk_num)
integer(qmckl_exit_code) :: info
integer*8 :: nw, i, ii, num
double precision :: rij_inv, elel_dist_gl(4, elec_num), kappa_l
num = num_in + 1
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif
if (elec_num <= 0) then
info = QMCKL_INVALID_ARG_2
return
endif
if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif
ee_rescaled_single_gl = 0.0d0
do nw = 1, walk_num
! prepare the actual een table
do i = 1, elec_num
rij_inv = 1.0d0 / single_ee_distance(i, nw)
do ii = 1, 3
elel_dist_gl(ii, i) = (elec_coord(i,nw, ii) - coord(ii,nw)) * rij_inv
end do
elel_dist_gl(4, i) = 2.0d0 * rij_inv
end do
do i = 1, elec_num
kappa_l = -1 * rescale_factor_ee
ee_rescaled_single_gl(1, i, nw) = elel_dist_gl(1, i)
ee_rescaled_single_gl(2, i, nw) = elel_dist_gl(2, i)
ee_rescaled_single_gl(3, i, nw) = elel_dist_gl(3, i)
ee_rescaled_single_gl(4, i, nw) = elel_dist_gl(4, i)
ee_rescaled_single_gl(4, i, nw) = ee_rescaled_single_gl(4, i, nw) + kappa_l
ee_rescaled_single_gl(1, i, nw) = ee_rescaled_single_gl(1, i, nw) * dexp(kappa_l * single_ee_distance(i,nw))
ee_rescaled_single_gl(2, i, nw) = ee_rescaled_single_gl(2, i, nw) * dexp(kappa_l * single_ee_distance(i,nw))
ee_rescaled_single_gl(3, i, nw) = ee_rescaled_single_gl(3, i, nw) * dexp(kappa_l * single_ee_distance(i,nw))
ee_rescaled_single_gl(4, i, nw) = ee_rescaled_single_gl(4, i, nw) * dexp(kappa_l * single_ee_distance(i,nw))
end do
ee_rescaled_single_gl(1, num, nw) = 0.0d0
ee_rescaled_single_gl(2, num, nw) = 0.0d0
ee_rescaled_single_gl(3, num, nw) = 0.0d0
ee_rescaled_single_gl(4, num, nw) = 0.0d0
end do
end function qmckl_compute_ee_rescaled_single_gl_doc
#+end_src
#+begin_src c :tangle (eval h_private_func) :comments org :exports none
qmckl_exit_code qmckl_compute_ee_rescaled_single_gl_doc (
const qmckl_context context,
const int64_t num,
const int64_t elec_num,
const double rescale_factor_ee,
const int64_t walk_num,
const double* single_ee_distance,
const double* elec_coord,
const double* coord,
double* const ee_rescaled_single_gl );
qmckl_exit_code qmckl_compute_ee_rescaled_single_gl (
const qmckl_context context,
const int64_t num,
const int64_t elec_num,
const double rescale_factor_ee,
const int64_t walk_num,
const double* single_ee_distance,
const double* elec_coord,
const double* coord,
double* const ee_rescaled_single_gl );
#+end_src
#+begin_src c :tangle (eval c) :comments org :exports none
qmckl_exit_code qmckl_compute_ee_rescaled_single_gl (
const qmckl_context context,
const int64_t num,
const int64_t elec_num,
const double rescale_factor_ee,
const int64_t walk_num,
const double* single_ee_distance,
const double* elec_coord,
const double* coord,
double* const ee_rescaled_single_gl )
{
#ifdef HAVE_HPC
return qmckl_compute_ee_rescaled_single_gl_doc
#else
return qmckl_compute_ee_rescaled_single_gl_doc
#endif
(context, num, elec_num, rescale_factor_ee, walk_num, single_ee_distance, elec_coord, coord,
ee_rescaled_single_gl);
}
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("ee rescaled single gl\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double ee_rescaled_gl[walk_num][elec_num][elec_num][4];
double single_ee_rescaled_gl[walk_num][elec_num][4];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_ee_distance_rescaled_gl(context, &ee_rescaled_gl[0][0][0][0], walk_num*elec_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_ee_rescaled_single_gl(context, &single_ee_rescaled_gl[0][0][0], walk_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_ee_distance_rescaled_gl(context, &ee_rescaled_gl[0][0][0][0], walk_num*elec_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
double metric[4] = {-1.0, -1.0, -1.0, 1.0};
for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++) {
for (int m = 0; m < 4; m++) {
if (i == elec) continue;
//printf("%f\n", ee_rescaled_gl[nw][elec][i][m]);
//printf("%f\n", single_ee_rescaled_gl[nw][i][m]);
assert(fabs(ee_rescaled_gl[nw][elec][i][m] - single_ee_rescaled_gl[nw][i][m]) < 1.e-12);
assert(fabs(ee_rescaled_gl[nw][i][elec][m] - metric[m] * single_ee_rescaled_gl[nw][i][m]) < 1.e-12);
}
}
}
}
printf("OK\n");
#+end_src
** Electron-electron Jastrow gradients and Laplacian
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_jastrow_champ_single_ee_gl(qmckl_context context,
double* const delta_ee_gl,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_jastrow_champ_single_ee_gl(qmckl_context context,
double* const delta_ee_gl,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_jastrow_champ_single_ee_gl(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
int64_t sze = ctx->electron.walker.num * 4 * ctx->electron.num;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_jastrow_champ_single_ee_gl",
"Array too small. Expected 4*walk_num*elec_num");
}
memcpy(delta_ee_gl, ctx->single_point.delta_ee_gl, sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org
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
#+end_src
*** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_single_ee_gl(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_single_ee_gl(qmckl_context context)
{
qmckl_exit_code rc;
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_provide_jastrow_champ_single_ee_gl",
NULL);
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
if (!ctx->jastrow_champ.provided) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_provide_jastrow_champ_single_ee_gl",
NULL);
}
/* Check if ee rescaled distance is provided */
rc = qmckl_provide_ee_distance_rescaled(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Check if ee rescaled distance deriv e is provided */
rc = qmckl_provide_ee_distance_rescaled_gl(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_ee_rescaled_single(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_ee_rescaled_single_gl(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.delta_ee_gl_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->electron.walker.num * 4 * ctx->electron.num * sizeof(double);
if (mem_info.size > ctx->single_point.delta_ee_gl_maxsize) {
if (ctx->single_point.delta_ee_gl != NULL) {
rc = qmckl_free(context, ctx->single_point.delta_ee_gl);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_jastrow_champ_single_ee_gl",
"Unable to free ctx->single_point.delta_ee_gl");
}
ctx->single_point.delta_ee_gl = NULL;
}
}
/* Allocate array */
if (ctx->single_point.delta_ee_gl == NULL) {
double* delta_ee_gl = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.delta_ee_gl_maxsize = mem_info.size;
if (delta_ee_gl == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_jastrow_champ_single_ee_gl",
NULL);
}
ctx->single_point.delta_ee_gl = delta_ee_gl;
}
rc = qmckl_compute_jastrow_champ_single_ee_gl(context,
ctx->single_point.num,
ctx->electron.walker.num,
ctx->electron.num,
ctx->electron.up_num,
ctx->jastrow_champ.bord_num,
ctx->jastrow_champ.b_vector,
ctx->jastrow_champ.ee_distance_rescaled,
ctx->jastrow_champ.ee_distance_rescaled_gl,
ctx->single_point.ee_rescaled_single,
ctx->single_point.ee_rescaled_single_gl,
ctx->jastrow_champ.spin_independent,
ctx->single_point.delta_ee_gl);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.delta_ee_gl_date = ctx->single_point.date;
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_jastrow_champ_single_ee_gl
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_single_ee_gl_args
| Variable | Type | In/Out | Description |
|---------------------------+-------------------------------------------+--------+-----------------------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~num~ | ~int64_t~ | in | Index of single 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_single~ | ~double[walk_num][elec_num]~ | in | Electron-electron rescaled single distances |
| ~ee_rescaled_single_gl~ | ~double[walk_num][4][elec_num]~ | in | Electron-electron rescaled single distances derivatives |
| ~spin_independent~ | ~int32_t~ | in | If 1, same parameters for parallel and antiparallel spins |
| ~delta_ee_gl~ | ~double[walk_num][elec_num][4]~ | out | Single electron-electron jastrow gradients and Laplacian |
|---------------------------+-------------------------------------------+--------+-----------------------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
function qmckl_compute_jastrow_champ_single_ee_gl_doc( &
context, num_in, walk_num, elec_num, up_num, bord_num, &
b_vector, ee_distance_rescaled, ee_distance_rescaled_gl, &
ee_rescaled_single, ee_rescaled_single_gl, &
spin_independent, delta_ee_gl) &
bind(C) result(info)
use qmckl
implicit none
integer (qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in) , value :: num_in
integer (c_int64_t) , intent(in) , value :: walk_num
integer (c_int64_t) , intent(in) , value :: elec_num
integer (c_int64_t) , intent(in) , value :: up_num
integer (c_int64_t) , intent(in) , value :: bord_num
real (c_double ) , intent(in) :: b_vector(bord_num+1)
real (c_double ) , intent(in) :: ee_distance_rescaled(elec_num,elec_num,walk_num)
real (c_double ) , intent(in) :: ee_distance_rescaled_gl(4,elec_num,elec_num,walk_num)
real (c_double ) , intent(in) :: ee_rescaled_single(elec_num,walk_num)
real (c_double ) , intent(in) :: ee_rescaled_single_gl(4,elec_num,walk_num)
integer (c_int32_t) , intent(in) , value :: spin_independent
real (c_double ) , intent(out) :: delta_ee_gl(4,elec_num,walk_num)
integer(qmckl_exit_code) :: info
integer*8 :: i, j, k, nw, ii, num
double precision :: x, x1, kf, x_old, x1_old
double precision :: denom, invdenom, invdenom2, f
double precision :: denom_old, invdenom_old, invdenom2_old, f_old
double precision :: grad_c2, grad_c2_old
double precision :: dx(4), dx_old(4)
num = num_in + 1
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif
if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif
if (elec_num <= 0) then
info = QMCKL_INVALID_ARG_4
return
endif
if (bord_num < 0) then
info = QMCKL_INVALID_ARG_5
return
endif
if ((spin_independent < 0).or.(spin_independent > 1)) then
info = QMCKL_INVALID_ARG_8
return
endif
do nw =1, walk_num
delta_ee_gl(:,:,nw) = 0.0d0
do i = 1, elec_num
if (i == num) cycle
x = ee_rescaled_single(i,nw)
x_old = ee_distance_rescaled(i,num,nw)
denom = 1.0d0 + b_vector(2) * x
invdenom = 1.0d0 / denom
invdenom2 = invdenom * invdenom
denom_old = 1.0d0 + b_vector(2) * x_old
invdenom_old = 1.0d0 / denom_old
invdenom2_old = invdenom_old * invdenom_old
dx(1) = ee_rescaled_single_gl(1, i, nw)
dx(2) = ee_rescaled_single_gl(2, i, nw)
dx(3) = ee_rescaled_single_gl(3, i, nw)
dx(4) = ee_rescaled_single_gl(4, i, nw)
dx_old(1) = ee_distance_rescaled_gl(1, i, num, nw)
dx_old(2) = ee_distance_rescaled_gl(2, i, num, nw)
dx_old(3) = ee_distance_rescaled_gl(3, i, num, nw)
dx_old(4) = ee_distance_rescaled_gl(4, i, num, nw)
grad_c2 = dx(1)*dx(1) + dx(2)*dx(2) + dx(3)*dx(3)
grad_c2_old = dx_old(1)*dx_old(1) + dx_old(2)*dx_old(2) + dx_old(3)*dx_old(3)
if (spin_independent == 1) then
f = b_vector(1) * invdenom2
f_old = b_vector(1) * invdenom2_old
else
if((i <= up_num .and. num <= up_num ) .or. (i > up_num .and. num > up_num)) then
f = 0.5d0 * b_vector(1) * invdenom2
f_old = 0.5d0 * b_vector(1) * invdenom2_old
else
f = b_vector(1) * invdenom2
f_old = b_vector(1) * invdenom2_old
end if
end if
delta_ee_gl(1,i,nw) = delta_ee_gl(1,i,nw) + f * dx(1) - f_old * dx_old(1)
delta_ee_gl(2,i,nw) = delta_ee_gl(2,i,nw) + f * dx(2) - f_old * dx_old(2)
delta_ee_gl(3,i,nw) = delta_ee_gl(3,i,nw) + f * dx(3) - f_old * dx_old(3)
delta_ee_gl(4,i,nw) = delta_ee_gl(4,i,nw) &
+ f * (dx(4) - 2.d0 * b_vector(2) * grad_c2 * invdenom) &
- f_old * (dx_old(4) - 2.d0 * b_vector(2) * grad_c2_old * invdenom_old)
delta_ee_gl(1,num,nw) = delta_ee_gl(1,num,nw) - f * dx(1) + f_old * dx_old(1)
delta_ee_gl(2,num,nw) = delta_ee_gl(2,num,nw) - f * dx(2) + f_old * dx_old(2)
delta_ee_gl(3,num,nw) = delta_ee_gl(3,num,nw) - f * dx(3) + f_old * dx_old(3)
delta_ee_gl(4,num,nw) = delta_ee_gl(4,num,nw) &
+ f * (dx(4) - 2.d0 * b_vector(2) * grad_c2 * invdenom) &
- f_old * (dx_old(4) - 2.d0 * b_vector(2) * grad_c2_old * invdenom_old)
kf = 2.d0
x1 = x
x1_old = x_old
x = 1.d0
x_old = 1.d0
do k=2, bord_num
f = b_vector(k+1) * kf * x
f_old = b_vector(k+1) * kf * x_old
delta_ee_gl(1,i,nw) = delta_ee_gl(1,i,nw) + f * x1 * dx(1) - f_old * x1_old * dx_old(1)
delta_ee_gl(2,i,nw) = delta_ee_gl(2,i,nw) + f * x1 * dx(2) - f_old * x1_old * dx_old(2)
delta_ee_gl(3,i,nw) = delta_ee_gl(3,i,nw) + f * x1 * dx(3) - f_old * x1_old * dx_old(3)
delta_ee_gl(4,i,nw) = delta_ee_gl(4,i,nw) &
+ f * (x1 * dx(4) + (kf-1.d0) * grad_c2) &
- f_old * (x1_old * dx_old(4) + (kf-1.d0) * grad_c2_old)
delta_ee_gl(1,num,nw) = delta_ee_gl(1,num,nw) - f * x1 * dx(1) + f_old * x1_old * dx_old(1)
delta_ee_gl(2,num,nw) = delta_ee_gl(2,num,nw) - f * x1 * dx(2) + f_old * x1_old * dx_old(2)
delta_ee_gl(3,num,nw) = delta_ee_gl(3,num,nw) - f * x1 * dx(3) + f_old * x1_old * dx_old(3)
delta_ee_gl(4,num,nw) = delta_ee_gl(4,num,nw) &
+ f * (x1 * dx(4) + (kf-1.d0) * grad_c2) &
- f_old * (x1_old * dx_old(4) + (kf-1.d0) * grad_c2_old)
x = x*x1
x_old = x_old*x1_old
kf = kf + 1.d0
end do
end do
end do
end function qmckl_compute_jastrow_champ_single_ee_gl_doc
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
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 );
#+end_src
#+begin_src c :tangle (eval h_private_func) :comments org
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 );
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes
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 );
}
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("Delta ee gl\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double ee_gl_old[walk_num][4][elec_num];
double delta_ee_gl[walk_num][elec_num][4];
double ee_gl_new[walk_num][4][elec_num];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee_gl(context, &ee_gl_old[0][0][0], walk_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_ee_gl(context, &delta_ee_gl[0][0][0], walk_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee_gl(context, &ee_gl_new[0][0][0], walk_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++) {
for (int m = 0; m < 4; m++) {
//printf("%f\n",(ee_gl_new[nw][m][i] - ee_gl_old[nw][m][i]));
//printf("%f\n",delta_ee_gl[nw][i][m]);
assert(fabs((ee_gl_new[nw][m][i] - ee_gl_old[nw][m][i]) - delta_ee_gl[nw][i][m]) < 1.e-12);
}
}
}
}
printf("OK\n");
#+end_src
* Electron-nucleus Jastrow
** Electron-nucleus rescaled distance
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_en_rescaled_single(qmckl_context context,
double* const distance_rescaled,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_en_rescaled_single(qmckl_context context,
double* const distance_rescaled,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_en_rescaled_single(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
int64_t sze = ctx->nucleus.num * ctx->electron.walker.num;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"todo",
"Array too small. Expected ctx->nucleus.num * ctx->electron.walker.num ");
}
memcpy(distance_rescaled, ctx->single_point.en_rescaled_single, sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
*** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_en_rescaled_single(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_en_rescaled_single(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
/* Check if ee distance is provided */
qmckl_exit_code rc = qmckl_provide_single_en_distance(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_en_distance(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.en_rescaled_single_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->nucleus.num * ctx->electron.walker.num * sizeof(double);
if (mem_info.size > ctx->single_point.en_rescaled_single_maxsize) {
if (ctx->single_point.en_rescaled_single!= NULL) {
rc = qmckl_free(context, ctx->single_point.en_rescaled_single);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_en_rescaled_single",
"Unable to free ctx->single_point.en_rescaled_single");
}
ctx->single_point.en_rescaled_single = NULL;
}
}
/* Allocate array */
if (ctx->single_point.en_rescaled_single == NULL) {
double* en_rescaled_single = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.en_rescaled_single_maxsize = mem_info.size;
if (en_rescaled_single == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_en_rescaled_single",
NULL);
}
ctx->single_point.en_rescaled_single = en_rescaled_single;
}
rc = qmckl_compute_en_rescaled_single(context,
ctx->nucleus.num,
ctx->jastrow_champ.type_nucl_num,
ctx->jastrow_champ.type_nucl_vector,
ctx->jastrow_champ.rescale_factor_en,
ctx->electron.walker.num,
ctx->single_point.single_en_distance,
ctx->single_point.en_rescaled_single);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.en_rescaled_single_date = ctx->single_point.date;
//printf("en rescaled single date %u\n", ctx->single_point.en_rescaled_single_date);
//printf("date %u\n", ctx->date);
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_en_rescaled_single
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_en_rescaled_single_args
| 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 | Single electron-nucleus distances |
| ~en_rescaled_single~ | ~double[walk_num][nucl_num]~ | out | Electron-nucleus rescaled distances |
|----------------------+------------------------------+--------+-------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
function qmckl_compute_en_rescaled_single_doc(context, &
nucl_num, type_nucl_num, type_nucl_vector, rescale_factor_en, &
walk_num, single_en_distance, en_rescaled_single) &
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
#+end_src
#+begin_src c :tangle (eval h_private_func) :comments org :exports none
qmckl_exit_code qmckl_compute_en_rescaled_single_doc (
const qmckl_context context,
const int64_t nucl_num,
const int64_t type_nucl_num,
const int64_t* type_nucl_vector,
const double* rescale_factor_en,
const int64_t walk_num,
const double* single_en_distance,
double* const en_rescaled_single );
qmckl_exit_code qmckl_compute_en_rescaled_single (
const qmckl_context context,
const int64_t nucl_num,
const int64_t type_nucl_num,
const int64_t* type_nucl_vector,
const double* rescale_factor_en,
const int64_t walk_num,
const double* single_en_distance,
double* const en_rescaled_single );
#+end_src
#+begin_src c :tangle (eval c) :comments org :exports none
qmckl_exit_code qmckl_compute_en_rescaled_single(
const qmckl_context context,
const int64_t nucl_num,
const int64_t type_nucl_num,
const int64_t* type_nucl_vector,
const double* rescale_factor_en,
const int64_t walk_num,
const double* single_en_distance,
double* const en_rescaled_single )
{
#ifdef HAVE_HPC
return qmckl_compute_en_rescaled_single_doc
#else
return qmckl_compute_en_rescaled_single_doc
#endif
(context, nucl_num, type_nucl_num, type_nucl_vector,
rescale_factor_en, walk_num, single_en_distance, en_rescaled_single );
}
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("En rescaled single\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double en_rescaled[walk_num][nucl_num][elec_num];
double single_en_rescaled[walk_num][nucl_num];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_en_distance_rescaled(context, &en_rescaled[0][0][0], walk_num*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_en_rescaled_single(context, &single_en_rescaled[0][0], walk_num*nucl_num);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_en_distance_rescaled(context, &en_rescaled[0][0][0], walk_num*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++) {
for (int a = 0; a < nucl_num; a++){
assert(fabs(en_rescaled[nw][a][elec]-single_en_rescaled[nw][a]) < 1.e-12);
}
}
}
printf("OK\n");
#+end_src
** Single electron-nucleus Jastrow value
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_jastrow_champ_single_en(qmckl_context context,
double* const delta_en,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_jastrow_champ_single_en(qmckl_context context,
double* const delta_en,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_get_jastrow_champ_single_en",
NULL);
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
qmckl_exit_code rc;
rc = qmckl_provide_jastrow_champ_single_en(context);
if (rc != QMCKL_SUCCESS) return rc;
int64_t sze=ctx->electron.walker.num;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_jastrow_champ_single_en",
"Array too small. Expected walker.num");
}
memcpy(delta_en, ctx->single_point.delta_en, sze*sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org
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
#+end_src
*** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_single_en(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_single_en(qmckl_context context)
{
qmckl_exit_code rc;
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_provide_jastrow_champ_single_en",
NULL);
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
if (!ctx->jastrow_champ.provided) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_provide_jastrow_champ_single_en",
NULL);
}
/* Check if en rescaled distance is provided */
rc = qmckl_provide_en_distance_rescaled(context);
if(rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_en_rescaled_single(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.delta_en_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->electron.walker.num * sizeof(double);
if (mem_info.size > ctx->single_point.delta_en_maxsize) {
if (ctx->single_point.delta_en != NULL) {
rc = qmckl_free(context, ctx->single_point.delta_en);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_jastrow_champ_single_en",
"Unable to free ctx->single_point.delta_en");
}
ctx->single_point.delta_en = NULL;
}
}
/* Allocate array */
if (ctx->single_point.delta_en == NULL) {
double* delta_en = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.delta_en_maxsize = mem_info.size;
if (delta_en == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_jastrow_champ_single_en",
NULL);
}
ctx->single_point.delta_en = delta_en;
}
rc = qmckl_compute_jastrow_champ_single_en(context,
ctx->single_point.num,
ctx->electron.walker.num,
ctx->electron.num,
ctx->nucleus.num,
ctx->jastrow_champ.type_nucl_num,
ctx->jastrow_champ.type_nucl_vector,
ctx->jastrow_champ.aord_num,
ctx->jastrow_champ.a_vector,
ctx->jastrow_champ.en_distance_rescaled,
ctx->single_point.en_rescaled_single,
ctx->single_point.delta_en);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.delta_en_date = ctx->single_point.date;
//printf("D//elta en date %d\n", ctx->single_point.delta_en_date);
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_jastrow_champ_single_en_doc
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_single_en_args
|------------------------+----------------------------------------+--------+--------------------------------------------|
| Variable | Type | In/Out | Description |
|------------------------+----------------------------------------+--------+--------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~num~ | ~int64_t~ | in | Index of single point |
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
| ~nucl_num~ | ~int64_t~ | in | Number of nuclei |
| ~type_nucl_num~ | ~int64_t~ | in | Number of unique nuclei |
| ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | IDs of unique nuclei |
| ~aord_num~ | ~int64_t~ | in | Number of coefficients |
| ~a_vector~ | ~double[type_nucl_num][aord_num+1]~ | in | List of coefficients |
| ~en_distance_rescaled~ | ~double[walk_num][nucl_num][elec_num]~ | in | Electron-nucleus rescaled distances |
| ~en_rescaled_single ~ | ~double[walk_num][nucl_num]~ | in | Electron-nucleus rescaled single distances |
| ~delta_en~ | ~double[walk_num]~ | out | Single electron-nucleus jastrow |
|------------------------+----------------------------------------+--------+--------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
function qmckl_compute_jastrow_champ_single_en_doc( &
context, num_in, walk_num, elec_num, nucl_num, type_nucl_num, &
type_nucl_vector, aord_num, a_vector, &
en_distance_rescaled, en_rescaled_single, delta_en) &
bind(C) result(info)
use qmckl
implicit none
integer (qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in) , value :: num_in
integer (c_int64_t) , intent(in) , value :: walk_num
integer (c_int64_t) , intent(in) , value :: elec_num
integer (c_int64_t) , intent(in) , value :: nucl_num
integer (c_int64_t) , intent(in) , value :: type_nucl_num
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
integer (c_int64_t) , intent(in) , value :: aord_num
real (c_double ) , intent(in) :: a_vector(aord_num+1,type_nucl_num)
real (c_double ) , intent(in) :: en_distance_rescaled(elec_num,nucl_num,walk_num)
real (c_double ) , intent(in) :: en_rescaled_single(nucl_num,walk_num)
real (c_double ) , intent(out) :: delta_en(walk_num)
integer(qmckl_exit_code) :: info
integer*8 :: i, a, p, nw, num
double precision :: x, power_ser, y
num = num_in + 1
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif
if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_2
return
endif
if (elec_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif
if (nucl_num <= 0) then
info = QMCKL_INVALID_ARG_4
return
endif
if (type_nucl_num <= 0) then
info = QMCKL_INVALID_ARG_4
return
endif
if (aord_num < 0) then
info = QMCKL_INVALID_ARG_7
return
endif
do nw =1, walk_num
delta_en(nw) = 0.0d0
do a = 1, nucl_num
x = en_distance_rescaled(num, a, nw)
y = en_rescaled_single(a, nw)
delta_en(nw) = delta_en(nw) - a_vector(1, type_nucl_vector(a)+1) * x / (1.0d0 + a_vector(2, type_nucl_vector(a)+1) * x)
delta_en(nw) = delta_en(nw) + a_vector(1, type_nucl_vector(a)+1) * y / (1.0d0 + a_vector(2, type_nucl_vector(a)+1) * y)
do p = 2, aord_num
x = x * en_distance_rescaled(num, a, nw)
y = y * en_rescaled_single(a, nw)
delta_en(nw) = delta_en(nw) - a_vector(p + 1, type_nucl_vector(a)+1) * x + a_vector(p + 1, type_nucl_vector(a)+1) * y
end do
end do
end do
end function qmckl_compute_jastrow_champ_single_en_doc
#+end_src
#+CALL: generate_c_header(table=qmckl_single_en_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
#+RESULTS:
#+begin_src c :tangle (eval h_func) :comments org
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 );
#+end_src
#+begin_src c :tangle (eval c) :comments org
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 );
}
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("Delta en\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double jastrow_en_old[walk_num];
double delta_en[walk_num];
double jastrow_en_new[walk_num];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_en(context, &jastrow_en_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_en(context, &delta_en[0], walk_num);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_en(context, &jastrow_en_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++) {
//printf("electron %d walk %d \n", elec, nw);
//printf("jastrow_en_new %f\n", jastrow_en_new[nw]);
//printf("jastrow_en_old %f\n", jastrow_en_old[nw]);
//printf("delta_en %f\n", delta_en[nw]);
//printf("diff %f\n", jastrow_en_new[nw] - jastrow_en_old[nw] - delta_en[nw]);
assert(fabs((jastrow_en_new[nw] - jastrow_en_old[nw]) - delta_en[nw]) < 1.e-12);
}
}
printf("OK\n");
#+end_src
** Electron-nucleus rescaled distances derivatives
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code qmckl_get_en_rescaled_single_gl(qmckl_context context,
double* distance_rescaled_gl,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_get_en_rescaled_single_gl(qmckl_context context,
double* distance_rescaled_gl,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_en_rescaled_single_gl(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
size_t sze = 4 * ctx->nucleus.num * ctx->electron.walker.num;
memcpy(distance_rescaled_gl, ctx->single_point.en_rescaled_single_gl, sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
*** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_en_rescaled_single_gl(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_en_rescaled_single_gl(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
if (!(ctx->nucleus.provided)) {
return QMCKL_NOT_PROVIDED;
}
qmckl_exit_code rc = qmckl_provide_single_en_distance(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.en_rescaled_single_gl_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = 4 * ctx->nucleus.num * ctx->electron.walker.num * sizeof(double);
if (mem_info.size > ctx->single_point.en_rescaled_single_gl_maxsize) {
if (ctx->single_point.en_rescaled_single_gl != NULL) {
rc = qmckl_free(context, ctx->single_point.en_rescaled_single_gl);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_en_rescaled_single_gl",
"Unable to free ctx->single_point.en_rescaled_single_gl");
}
ctx->single_point.en_rescaled_single_gl = NULL;
}
}
/* Allocate array */
if (ctx->single_point.en_rescaled_single_gl == NULL) {
double* en_rescaled_single_gl = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.en_rescaled_single_gl_maxsize = mem_info.size;
if (en_rescaled_single_gl == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_en_rescaled_single_gl",
NULL);
}
ctx->single_point.en_rescaled_single_gl = en_rescaled_single_gl;
}
qmckl_exit_code rc =
qmckl_compute_en_rescaled_single_gl(context,
ctx->nucleus.num,
ctx->jastrow_champ.type_nucl_num,
ctx->jastrow_champ.type_nucl_vector,
ctx->jastrow_champ.rescale_factor_en,
ctx->electron.walker.num,
ctx->single_point.single_en_distance,
ctx->single_point.coord.data,
ctx->nucleus.coord.data,
ctx->single_point.en_rescaled_single_gl);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.en_rescaled_single_gl_date = ctx->single_point.date;
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_en_rescaled_single_gl
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_en_rescaled_single_gl_args
| 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 | Single electorn distances |
| ~coord~ | ~double[walk_num][3]~ | in | Single electron coordinates |
| ~nucl_coord~ | ~double[3][nucl_num]~ | in | Nucleus coordinates |
| ~en_rescaled_single_gl~ | ~double[walk_num][nucl_num][4]~ | out | Electron-nucleus rescaled single distance derivatives |
|-------------------------+---------------------------------+--------+-------------------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
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,walk_num)
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,nw) - nucl_coord(a, ii)) * ria_inv
end do
elnuc_dist_gl(4, a) = 2.0d0 * ria_inv
end do
do a = 1, nucl_num
kappa_l = -1 * rescale_factor_en(type_nucl_vector(a)+1)
en_rescaled_single_gl(1, a, nw) = elnuc_dist_gl(1, a)
en_rescaled_single_gl(2, a, nw) = elnuc_dist_gl(2, a)
en_rescaled_single_gl(3, a, nw) = elnuc_dist_gl(3, a)
en_rescaled_single_gl(4, a, nw) = elnuc_dist_gl(4, a)
en_rescaled_single_gl(4, a, nw) = en_rescaled_single_gl(4, a, nw) + kappa_l
en_rescaled_single_gl(1, a, nw) = en_rescaled_single_gl(1, a, nw) * dexp(kappa_l * single_en_distance(a,nw))
en_rescaled_single_gl(2, a, nw) = en_rescaled_single_gl(2, a, nw) * dexp(kappa_l * single_en_distance(a,nw))
en_rescaled_single_gl(3, a, nw) = en_rescaled_single_gl(3, a, nw) * dexp(kappa_l * single_en_distance(a,nw))
en_rescaled_single_gl(4, a, nw) = en_rescaled_single_gl(4, a, nw) * dexp(kappa_l * single_en_distance(a,nw))
end do
end do
end function qmckl_compute_en_rescaled_single_gl_doc_f
#+end_src
#+begin_src c :tangle (eval h_private_func) :comments org :exports none
qmckl_exit_code qmckl_compute_en_rescaled_single_gl_doc (
const qmckl_context context,
const int64_t nucl_num,
const int64_t type_nucl_num,
int64_t* const type_nucl_vector,
const double* rescale_factor_en,
const int64_t walk_num,
const double* single_en_distance,
const double* coord,
const double* nucl_coord,
double* const en_rescaled_single_gl );
qmckl_exit_code qmckl_compute_en_rescaled_single_gl (
const qmckl_context context,
const int64_t nucl_num,
const int64_t type_nucl_num,
int64_t* const type_nucl_vector,
const double* rescale_factor_en,
const int64_t walk_num,
const double* single_en_distance,
const double* coord,
const double* nucl_coord,
double* const en_rescaled_single_gl );
#+end_src
#+begin_src c :tangle (eval c) :comments org :exports none
qmckl_exit_code qmckl_compute_en_rescaled_single_gl (
const qmckl_context context,
const int64_t nucl_num,
const int64_t type_nucl_num,
int64_t* const type_nucl_vector,
const double* rescale_factor_en,
const int64_t walk_num,
const double* single_en_distance,
const double* coord,
const double* nucl_coord,
double* const en_rescaled_single_gl )
{
#ifdef HAVE_HPC
return qmckl_compute_en_rescaled_single_gl_doc
#else
return qmckl_compute_en_rescaled_single_gl_doc
#endif
(context, nucl_num, type_nucl_num, type_nucl_vector, rescale_factor_en,
walk_num, single_en_distance, coord, nucl_coord, en_rescaled_single_gl );
}
#+end_src
#+CALL: generate_c_interface(table=qmckl_en_rescaled_single_gl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_en_rescaled_single_gl_doc")
#+RESULTS:
#+begin_src f90 :tangle (eval f) :comments org :exports none
integer(c_int32_t) function qmckl_compute_en_rescaled_single_gl_doc &
(context, &
nucl_num, &
type_nucl_num, &
type_nucl_vector, &
rescale_factor_en, &
walk_num, &
single_en_distance, &
coord, &
nucl_coord, &
en_rescaled_single_gl) &
bind(C) result(info)
use, intrinsic :: iso_c_binding
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: nucl_num
integer (c_int64_t) , intent(in) , value :: type_nucl_num
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
real (c_double ) , intent(in) :: rescale_factor_en(nucl_num)
integer (c_int64_t) , intent(in) , value :: walk_num
real (c_double ) , intent(in) :: single_en_distance(nucl_num,walk_num)
real (c_double ) , intent(in) :: coord(3,walk_num)
real (c_double ) , intent(in) :: nucl_coord(nucl_num,3)
real (c_double ) , intent(out) :: en_rescaled_single_gl(4,nucl_num,walk_num)
integer(c_int32_t), external :: qmckl_compute_en_rescaled_single_gl_doc_f
info = 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)
end function qmckl_compute_en_rescaled_single_gl_doc
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("En rescaled single gl\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double en_rescaled_gl[walk_num][nucl_num][elec_num][4];
double single_en_rescaled_gl[walk_num][nucl_num][4];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_en_distance_rescaled_gl(context, &en_rescaled_gl[0][0][0][0], walk_num*nucl_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_en_rescaled_single_gl(context, &single_en_rescaled_gl[0][0][0], walk_num*nucl_num*4);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_en_distance_rescaled_gl(context, &en_rescaled_gl[0][0][0][0], walk_num*nucl_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++) {
for (int a = 0; a < nucl_num; a++) {
for (int m = 0; m < 4; m++) {
assert(fabs(en_rescaled_gl[nw][a][elec][m] - single_en_rescaled_gl[nw][a][m]) < 1.e-12);
}
}
}
}
printf("OK\n");
#+end_src
** Electron-nucleus Jastrow gradients and Laplacian
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_jastrow_champ_single_en_gl(qmckl_context context,
double* const delta_en_gl,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_jastrow_champ_single_en_gl(qmckl_context context,
double* const delta_en_gl,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
rc = qmckl_provide_jastrow_champ_single_en_gl(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
int64_t sze = ctx->electron.walker.num * 4 * ctx->electron.num;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_jastrow_champ_single_en_gl",
"Array too small. Expected 4*walker.num*elec_num");
}
memcpy(delta_en_gl, ctx->single_point.delta_en_gl, sze*sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org
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
#+end_src
*** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_single_en_gl(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_jastrow_champ_single_en_gl(qmckl_context context)
{
qmckl_exit_code rc;
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_provide_jastrow_champ_single_en_gl",
NULL);
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
if (!ctx->jastrow_champ.provided) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_provide_jastrow_champ_single_en_gl",
NULL);
}
/* Check if en rescaled distance is provided */
rc = qmckl_provide_en_distance_rescaled(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Check if en rescaled distance derivatives is provided */
rc = qmckl_provide_en_distance_rescaled_gl(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Check if en rescaled distance is provided */
rc = qmckl_provide_en_rescaled_single(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Check if en rescaled distance derivatives is provided */
rc = qmckl_provide_en_rescaled_single_gl(context);
if(rc != QMCKL_SUCCESS) return rc;
/* Compute if necessary */
if (ctx->single_point.date > ctx->single_point.delta_en_gl_date) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->electron.walker.num * 4 * ctx->electron.num * sizeof(double);
if (mem_info.size > ctx->single_point.delta_en_gl_maxsize) {
if (ctx->single_point.delta_en_gl != NULL) {
rc = qmckl_free(context, ctx->single_point.delta_en_gl);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_provide_jastrow_champ_single_en_gl",
"Unable to free ctx->single_point.delta_en_gl");
}
ctx->single_point.delta_en_gl = NULL;
}
}
/* Allocate array */
if (ctx->single_point.delta_en_gl == NULL) {
double* delta_en_gl = (double*) qmckl_malloc(context, mem_info);
ctx->single_point.delta_en_gl_maxsize = mem_info.size;
if (delta_en_gl == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_provide_jastrow_champ_single_en_gl",
NULL);
}
ctx->single_point.delta_en_gl = delta_en_gl;
}
rc = qmckl_compute_jastrow_champ_single_en_gl(context,
ctx->single_point.num,
ctx->electron.walker.num,
ctx->electron.num,
ctx->nucleus.num,
ctx->jastrow_champ.type_nucl_num,
ctx->jastrow_champ.type_nucl_vector,
ctx->jastrow_champ.aord_num,
ctx->jastrow_champ.a_vector,
ctx->jastrow_champ.en_distance_rescaled,
ctx->jastrow_champ.en_distance_rescaled_gl,
ctx->single_point.en_rescaled_single,
ctx->single_point.en_rescaled_single_gl,
ctx->single_point.delta_en_gl);
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->single_point.delta_en_gl_date = ctx->single_point.date;
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute
:PROPERTIES:
:Name: qmckl_compute_jastrow_champ_single_en_gl
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_single_en_gl_args
| Variable | Type | In/Out | Description |
|---------------------------+-------------------------------------------+--------+---------------------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~num~ | ~int64_t~ | in | Index of single electron |
| ~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_single~ | ~double[walk_num][nucl_num]~ | in | Electron-nucleus rescaled single distances |
| ~en_rescaled_single_gl~ | ~double[walk_num][nucl_num][4]~ | in | Electron-nucleus rescaled single distance derivatives |
| ~delta_en_gl~ | ~double[walk_num][elec_num][4]~ | out | Single electron-nucleus Jastrow gradients and Laplacian |
|---------------------------+-------------------------------------------+--------+---------------------------------------------------------|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
function qmckl_compute_jastrow_champ_single_en_gl_doc( &
context, num_in, walk_num, elec_num, nucl_num, type_nucl_num, &
type_nucl_vector, aord_num, a_vector, &
en_distance_rescaled, en_distance_rescaled_gl, en_rescaled_single, en_rescaled_single_gl, delta_en_gl) &
bind(C) result(info)
use qmckl
implicit none
integer (qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in) , value :: num_in
integer (c_int64_t) , intent(in) , value :: walk_num
integer (c_int64_t) , intent(in) , value :: elec_num
integer (c_int64_t) , intent(in) , value :: nucl_num
integer (c_int64_t) , intent(in) , value :: type_nucl_num
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
integer (c_int64_t) , intent(in) , value :: aord_num
real (c_double ) , intent(in) :: a_vector(aord_num+1,type_nucl_num)
real (c_double ) , intent(in) :: en_distance_rescaled(elec_num,nucl_num,walk_num)
real (c_double ) , intent(in) :: en_distance_rescaled_gl(4, elec_num,nucl_num,walk_num)
real (c_double ) , intent(in) :: en_rescaled_single(nucl_num,walk_num)
real (c_double ) , intent(in) :: en_rescaled_single_gl(4, nucl_num,walk_num)
real (c_double ) , intent(out) :: delta_en_gl(4,elec_num,walk_num)
integer(qmckl_exit_code) :: info
integer*8 :: i, a, k, nw, ii, num
double precision :: x, x1, kf, x_old, x1_old
double precision :: denom, invdenom, invdenom2, f
double precision :: denom_old, invdenom_old, invdenom2_old, f_old
double precision :: grad_c2, grad_c2_old
double precision :: dx(4), dx_old(4)
num = num_in + 1
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif
if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_3
return
endif
if (elec_num <= 0) then
info = QMCKL_INVALID_ARG_4
return
endif
if (nucl_num <= 0) then
info = QMCKL_INVALID_ARG_5
return
endif
if (aord_num < 0) then
info = QMCKL_INVALID_ARG_8
return
endif
do nw =1, walk_num
delta_en_gl(:,:,nw) = 0.0d0
do a = 1, nucl_num
x_old = en_distance_rescaled(num,a,nw)
x = en_rescaled_single(a,nw)
denom = 1.0d0 + a_vector(2, type_nucl_vector(a)+1) * x
invdenom = 1.0d0 / denom
invdenom2 = invdenom*invdenom
denom_old = 1.0d0 + a_vector(2, type_nucl_vector(a)+1) * x_old
invdenom_old = 1.0d0 / denom_old
invdenom2_old = invdenom_old*invdenom_old
dx(1) = en_rescaled_single_gl(1,a,nw)
dx(2) = en_rescaled_single_gl(2,a,nw)
dx(3) = en_rescaled_single_gl(3,a,nw)
dx(4) = en_rescaled_single_gl(4,a,nw)
dx_old(1) = en_distance_rescaled_gl(1,num,a,nw)
dx_old(2) = en_distance_rescaled_gl(2,num,a,nw)
dx_old(3) = en_distance_rescaled_gl(3,num,a,nw)
dx_old(4) = en_distance_rescaled_gl(4,num,a,nw)
f = a_vector(1, type_nucl_vector(a)+1) * invdenom2
grad_c2 = dx(1)*dx(1) + dx(2)*dx(2) + dx(3)*dx(3)
f_old = a_vector(1, type_nucl_vector(a)+1) * invdenom2_old
grad_c2_old = dx_old(1)*dx_old(1) + dx_old(2)*dx_old(2) + dx_old(3)*dx_old(3)
delta_en_gl(1,num,nw) = delta_en_gl(1,num,nw) + f * dx(1) - f_old * dx_old(1)
delta_en_gl(2,num,nw) = delta_en_gl(2,num,nw) + f * dx(2) - f_old * dx_old(2)
delta_en_gl(3,num,nw) = delta_en_gl(3,num,nw) + f * dx(3) - f_old * dx_old(3)
delta_en_gl(4,num,nw) = delta_en_gl(4,num,nw) &
+ f * (dx(4) - 2.d0 * a_vector(2, type_nucl_vector(a)+1) * grad_c2 * invdenom) &
- f_old * (dx_old(4) - 2.d0 * a_vector(2, type_nucl_vector(a)+1) * grad_c2_old * invdenom_old)
kf = 2.d0
x1 = x
x = 1.d0
x1_old = x_old
x_old = 1.d0
do k=2, aord_num
f = a_vector(k+1,type_nucl_vector(a)+1) * kf * x
f_old = a_vector(k+1,type_nucl_vector(a)+1) * kf * x_old
delta_en_gl(1,num,nw) = delta_en_gl(1,num,nw) + f * x1 * dx(1) - f_old * x1_old * dx_old(1)
delta_en_gl(2,num,nw) = delta_en_gl(2,num,nw) + f * x1 * dx(2) - f_old * x1_old * dx_old(2)
delta_en_gl(3,num,nw) = delta_en_gl(3,num,nw) + f * x1 * dx(3) - f_old * x1_old * dx_old(3)
delta_en_gl(4,num,nw) = delta_en_gl(4,num,nw) &
+ f * (x1 * dx(4) + (kf-1.d0) * grad_c2) &
- f_old * (x1_old * dx_old(4) + (kf-1.d0) * grad_c2_old)
x = x*x1
x_old = x_old*x1_old
kf = kf + 1.d0
end do
end do
end do
end function qmckl_compute_jastrow_champ_single_en_gl_doc
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_compute_jastrow_champ_single_en_gl_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_distance_rescaled_gl,
const double* en_rescaled_single,
const double* en_rescaled_single_gl,
double* const delta_en_gl );
qmckl_exit_code qmckl_compute_jastrow_champ_single_en_gl (
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_distance_rescaled_gl,
const double* en_rescaled_single,
const double* en_rescaled_single_gl,
double* const delta_en_gl );
#+end_src
#+begin_src c :tangle (eval c) :comments org :exports none
qmckl_exit_code
qmckl_compute_jastrow_champ_single_en_gl (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_distance_rescaled_gl,
const double* en_rescaled_single,
const double* en_rescaled_single_gl,
double* const delta_en_gl )
{
#ifdef HAVE_HPC
return qmckl_compute_jastrow_champ_single_en_gl_doc
#else
return qmckl_compute_jastrow_champ_single_en_gl_doc
#endif
(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 );
}
#+end_src
*** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("Delta en gl\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
double en_gl_old[walk_num][4][elec_num];
double delta_en_gl[walk_num][elec_num][4];
double en_gl_new[walk_num][4][elec_num];
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_en_gl(context, &en_gl_old[0][0][0], walk_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_en_gl(context, &delta_en_gl[0][0][0], walk_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_en_gl(context, &en_gl_new[0][0][0], walk_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++) {
for (int m = 0; m < 4; m++) {
assert(fabs((en_gl_new[nw][m][i] - en_gl_old[nw][m][i]) - delta_en_gl[nw][i][m]) < 1.e-12);
}
}
}
}
printf("OK\n");
#+end_src
* Accept single electron move
** Code
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_jastrow_champ_single_accept(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes
qmckl_exit_code
qmckl_get_jastrow_champ_single_accept_alt(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
qmckl_exit_code rc;
double metric[4] = {-1.0, -1.0, -1.0, 1.0};
uint64_t old_date;
int do_update;
int shift1, shift2, shift3, shift4, shift5, shift6, shift7;
int shift8, shift9, shift10, shift11, shift12, shift13, shift14;
old_date = ctx->single_point.date;
do_update = 0;
rc = qmckl_context_touch(context);
if (rc != QMCKL_SUCCESS) return rc;
ctx->single_point.date = ctx->date;
if (ctx->jastrow_champ.cord_num > 0) {
if(old_date == ctx->single_point.delta_een_date) {
shift1 = (ctx->jastrow_champ.cord_num+1)*ctx->electron.num*ctx->electron.num;
shift2 = ctx->electron.num*ctx->electron.num;
shift3 = (ctx->jastrow_champ.cord_num+1)*ctx->nucleus.num*ctx->electron.num;
shift4 = ctx->nucleus.num*ctx->electron.num;
shift5 = (ctx->jastrow_champ.cord_num+1)*ctx->nucleus.num;
for (int nw = 0; nw < ctx->electron.walker.num; nw++) {
ctx->jastrow_champ.factor_een[nw] = ctx->jastrow_champ.factor_een[nw] + ctx->single_point.delta_een[nw];
for (int l = 0; l <= ctx->jastrow_champ.cord_num; l++){
for (int i = 0; i < ctx->electron.num; i++) {
ctx->jastrow_champ.een_rescaled_e[nw*shift1
+ l*shift2
+ i*ctx->electron.num
+ ctx->single_point.num] =
ctx->single_point.een_rescaled_single_e[nw*shift3
+ l*ctx->electron.num
+ i];
ctx->jastrow_champ.een_rescaled_e[nw*shift1
+ l*shift2
+ ctx->single_point.num*ctx->electron.num
+ i] =
ctx->single_point.een_rescaled_single_e[nw*shift3
+ l*ctx->electron.num
+ i];
}
for (int a = 0; a < ctx->nucleus.num; a++){
ctx->jastrow_champ.een_rescaled_n[nw*shift3
+ l*shift4
+ a*ctx->electron.num
+ ctx->single_point.num] =
ctx->single_point.een_rescaled_single_n[nw*shift5
+ l*ctx->nucleus.num
+ a];
}
}
}
for (int i = 0; i < (ctx->electron.walker.num*(ctx->jastrow_champ.cord_num+1)*ctx->nucleus.num*ctx->electron.num*ctx->jastrow_champ.cord_num); i++) {
ctx->jastrow_champ.tmp_c[i] = ctx->jastrow_champ.tmp_c[i] + ctx->single_point.delta_p[i];
}
ctx->jastrow_champ.een_rescaled_e_date = ctx->date;
ctx->jastrow_champ.een_rescaled_n_date = ctx->date;
ctx->jastrow_champ.factor_een_date = ctx->date;
ctx->jastrow_champ.tmp_c_date = ctx->date;
ctx->single_point.een_rescaled_single_e_date = ctx->single_point.date;
ctx->single_point.een_rescaled_single_n_date = ctx->single_point.date;
ctx->single_point.delta_een_date = ctx->single_point.date;
ctx->single_point.delta_p_date = ctx->single_point.date;
}
if(old_date == ctx->single_point.delta_een_gl_date) {
for (int i = 0; i < ctx->electron.walker.num * 4 * ctx->electron.num; i++) {
ctx->jastrow_champ.factor_een_gl[i] = ctx->jastrow_champ.factor_een_gl[i] + ctx->single_point.delta_een_gl[i];
}
ctx->jastrow_champ.factor_een_gl_date = ctx->date;
ctx->single_point.delta_een_gl_date = ctx->single_point.date;
do_update = 1;
} else if (old_date == ctx->single_point.delta_een_g_date) {
for (int nw = 0; nw < ctx->electron.walker.num; nw++) {
for (int k = 0; k < 3; k++){
for (int i = 0; i < ctx->electron.num; i++){
ctx->jastrow_champ.factor_een_gl[nw*ctx->electron.num*4 + k*ctx->electron.num + i] =
ctx->jastrow_champ.factor_een_gl[nw*ctx->electron.num*4 + k*ctx->electron.num + i] +
ctx->single_point.delta_een_g[nw*ctx->electron.num*3 + k*ctx->electron.num + i];
}
}
}
ctx->jastrow_champ.factor_een_gl_date = ctx->date;
ctx->single_point.delta_een_g_date = ctx->single_point.date;
do_update = 1;
}
if (do_update == 1) {
shift1 = (ctx->jastrow_champ.cord_num+1)*ctx->electron.num*4*ctx->electron.num;
shift2 = ctx->electron.num*4*ctx->electron.num;
shift3 = ctx->electron.num*4;
shift4 = (ctx->jastrow_champ.cord_num+1)*ctx->electron.num*4;
shift5 = (ctx->jastrow_champ.cord_num+1)*ctx->nucleus.num*4*ctx->electron.num;
shift6 = ctx->nucleus.num*4*ctx->electron.num;
shift7 = (ctx->jastrow_champ.cord_num+1)*ctx->nucleus.num*4;
shift8 = ctx->nucleus.num*4;
shift9 = ctx->nucleus.num*ctx->electron.num;
for (int nw = 0; nw < ctx->electron.walker.num; nw++) {
for (int l = 0; l <= ctx->jastrow_champ.cord_num; l++){
for (int i = 0; i < ctx->electron.num; i++) {
for (int k = 0; k < 4; k++){
ctx->jastrow_champ.een_rescaled_e_gl[nw*shift1
+ l*shift2
+ i*shift3
+ k*ctx->electron.num
+ ctx->single_point.num] =
ctx->single_point.een_rescaled_single_e_gl[nw*shift4
+ l*shift3
+ i*4
+ k];
ctx->jastrow_champ.een_rescaled_e_gl[nw*shift1
+ l*shift2
+ ctx->single_point.num*shift3
+ k*ctx->electron.num
+ i] =
metric[k] * ctx->single_point.een_rescaled_single_e_gl[nw*shift4
+ l*shift3
+ i*4
+ k];
}
}
for (int a = 0; a < ctx->nucleus.num; a++){
for (int k = 0; k < 4; k++){
ctx->jastrow_champ.een_rescaled_n_gl[nw*shift5
+ l*shift6
+ a*shift3
+ k*ctx->electron.num
+ ctx->single_point.num] =
ctx->single_point.een_rescaled_single_n_gl[nw*shift7
+ l*shift8
+ a*4
+ k];
}
}
}
}
for (int nw = 0; nw < ctx->electron.walker.num*(ctx->jastrow_champ.cord_num+1)*ctx->jastrow_champ.cord_num; nw++) {
for (int a = 0; a < ctx->nucleus.num; a++) {
for (int k = 0; k < 4; k++){
for (int i = 0; i < ctx->electron.num; i++) {
ctx->jastrow_champ.dtmp_c[nw*shift6
+ a*shift3
+ k*ctx->electron.num
+ i] =
ctx->jastrow_champ.dtmp_c[nw*shift6
+ a*shift3
+ k*ctx->electron.num
+ i] +
ctx->single_point.delta_p_gl[nw*shift6
+ k*shift9
+ a*ctx->electron.num
+ i];
}
}
}
}
ctx->jastrow_champ.dtmp_c_date = ctx->date;
ctx->jastrow_champ.een_rescaled_e_gl_date = ctx->date;
ctx->jastrow_champ.een_rescaled_n_gl_date = ctx->date;
ctx->single_point.een_rescaled_single_e_gl_date = ctx->single_point.date;
ctx->single_point.een_rescaled_single_n_gl_date = ctx->single_point.date;
ctx->single_point.delta_p_gl_date = ctx->single_point.date;
}
}
shift1 = (ctx->jastrow_champ.cord_num+1)*ctx->electron.num*ctx->electron.num;
shift2 = ctx->electron.num*ctx->electron.num;
shift3 = (ctx->jastrow_champ.cord_num+1)*ctx->electron.num;
shift4 = (ctx->jastrow_champ.cord_num+1)*ctx->electron.num*4*ctx->electron.num;
shift5 = ctx->electron.num*4*ctx->electron.num;
shift6 = ctx->electron.num*4;
shift7 = (ctx->jastrow_champ.cord_num+1)*ctx->electron.num*4;
shift8 = (ctx->jastrow_champ.cord_num+1)*ctx->nucleus.num*ctx->electron.num;
shift9 = (ctx->jastrow_champ.cord_num+1)*ctx->nucleus.num;
shift10 = (ctx->jastrow_champ.cord_num+1)*ctx->nucleus.num*4*ctx->electron.num;
shift11 = ctx->nucleus.num*4*ctx->electron.num;
shift12 = (ctx->jastrow_champ.cord_num+1)*ctx->nucleus.num*4;
shift13 = ctx->nucleus.num*4;
shift14 = ctx->nucleus.num*ctx->electron.num;
for (int nw = 0; nw < ctx->electron.walker.num; nw++) {
ctx->jastrow_champ.factor_en[nw] = ctx->jastrow_champ.factor_en[nw] + ctx->single_point.delta_en[nw];
ctx->jastrow_champ.factor_ee[nw] = ctx->jastrow_champ.factor_ee[nw] + ctx->single_point.delta_ee[nw];
for (int a = 0; a < ctx->nucleus.num; a++) {
ctx->electron.en_distance[nw*shift14
+ ctx->single_point.num*ctx->nucleus.num
+ a] =
ctx->single_point.single_en_distance[nw*ctx->nucleus.num
+ a];
ctx->jastrow_champ.en_distance_rescaled[nw*shift14
+ a*ctx->electron.num
+ ctx->single_point.num] =
ctx->single_point.en_rescaled_single[nw*ctx->nucleus.num
+ a];
for (int k = 0; k < 4; k++){
ctx->jastrow_champ.en_distance_rescaled_gl[nw*shift11
+ a*shift6
+ ctx->single_point.num*4
+ k] =
ctx->single_point.en_rescaled_single_gl[nw*shift13
+ a*4
+ k];
}
}
for (int i = 0; i < ctx->electron.num; i++) {
ctx->jastrow_champ.ee_distance_rescaled[nw*shift2
+ i*ctx->electron.num
+ ctx->single_point.num] =
ctx->single_point.ee_rescaled_single[nw*ctx->electron.num
+ i];
ctx->jastrow_champ.ee_distance_rescaled[nw*shift2
+ ctx->single_point.num*ctx->electron.num
+ i] =
ctx->single_point.ee_rescaled_single[nw*ctx->electron.num
+ i];
ctx->electron.ee_distance[nw*shift2
+ i*ctx->electron.num
+ ctx->single_point.num] =
ctx->single_point.single_ee_distance[nw*ctx->electron.num
+ i];
ctx->electron.ee_distance[nw*shift2
+ ctx->single_point.num*ctx->electron.num
+ i] =
ctx->single_point.single_ee_distance[nw*ctx->electron.num
+ i];
for (int k = 0; k < 4; k++){
ctx->jastrow_champ.ee_distance_rescaled_gl[nw*shift5
+ i*shift6
+ ctx->single_point.num*4
+ k] =
metric[k] * ctx->single_point.ee_rescaled_single_gl[nw*shift6
+ i*4
+ k];
ctx->jastrow_champ.ee_distance_rescaled_gl[nw*shift5
+ ctx->single_point.num*shift6
+ i*4
+ k] =
ctx->single_point.ee_rescaled_single_gl[nw*shift6
+ i*4
+ k];
}
}
for (int k = 0; k < 4; k++){
for (int i = 0; i < ctx->electron.num; i++) {
ctx->jastrow_champ.factor_ee_gl[nw*shift6
+ k*ctx->electron.num
+ i] =
ctx->jastrow_champ.factor_ee_gl[nw*shift6
+ k*ctx->electron.num
+ i] +
ctx->single_point.delta_ee_gl[nw*shift6
+ i*4
+ k];
ctx->jastrow_champ.factor_en_gl[nw*shift6
+ k*ctx->electron.num
+ i] =
ctx->jastrow_champ.factor_en_gl[nw*shift6
+ k*ctx->electron.num
+ i] +
ctx->single_point.delta_en_gl[nw*shift6
+ i*4
+ k];
}
}
}
for (int nw = 0; nw < ctx->electron.walker.num; nw++) {
for (int k = 0; k < 3; k++) {
ctx->point.coord.data[nw*3*ctx->electron.num + k*ctx->electron.num + ctx->single_point.num] = ctx->single_point.coord.data[nw*3 + k];
}
}
ctx->jastrow_champ.ee_distance_rescaled_date = ctx->date;
ctx->jastrow_champ.ee_distance_rescaled_gl_date = ctx->date;
ctx->jastrow_champ.en_distance_rescaled_date = ctx->date;
ctx->jastrow_champ.en_distance_rescaled_gl_date = ctx->date;
ctx->jastrow_champ.factor_ee_date = ctx->date;
ctx->jastrow_champ.factor_ee_gl_date = ctx->date;
ctx->jastrow_champ.factor_en_date = ctx->date;
ctx->jastrow_champ.factor_en_gl_date = ctx->date;
ctx->electron.ee_distance_date = ctx->date;
ctx->electron.en_distance_date = ctx->date;
ctx->single_point.date = ctx->date;
ctx->single_point.single_ee_distance_date = ctx->single_point.date;
ctx->single_point.single_en_distance_date = ctx->single_point.date;
ctx->single_point.ee_rescaled_single_date = ctx->single_point.date;
ctx->single_point.en_rescaled_single_date = ctx->single_point.date;
ctx->single_point.delta_en_date = ctx->single_point.date;
ctx->single_point.delta_ee_date = ctx->single_point.date;
ctx->single_point.ee_rescaled_single_gl_date = ctx->single_point.date;
ctx->single_point.en_rescaled_single_gl_date = ctx->single_point.date;
ctx->single_point.delta_en_gl_date = ctx->single_point.date;
ctx->single_point.delta_ee_gl_date = ctx->single_point.date;
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes
qmckl_exit_code
qmckl_get_jastrow_champ_single_accept(qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
qmckl_exit_code rc;
rc = qmckl_provide_jastrow_champ_single_en_gl(context);
if (rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_jastrow_champ_single_ee_gl(context);
if (rc != QMCKL_SUCCESS) return rc;
if (ctx->jastrow_champ.cord_num > 0) {
rc = qmckl_provide_jastrow_champ_single_een_gl(context);
if (rc != QMCKL_SUCCESS) return rc;
}
double metric[4] = {-1.0, -1.0, -1.0, 1.0};
int shift1, shift2, shift3, shift4, shift5, shift6, shift7;
int shift8, shift9, shift10, shift11, shift12, shift13, shift14;
if (ctx->jastrow_champ.cord_num > 0) {
shift1 = (ctx->jastrow_champ.cord_num+1)*ctx->electron.num*ctx->electron.num;
shift2 = ctx->electron.num*ctx->electron.num;
shift3 = (ctx->jastrow_champ.cord_num+1)*ctx->electron.num;
shift4 = (ctx->jastrow_champ.cord_num+1)*ctx->electron.num*4*ctx->electron.num;
shift5 = ctx->electron.num*4*ctx->electron.num;
shift6 = ctx->electron.num*4;
shift7 = (ctx->jastrow_champ.cord_num+1)*ctx->electron.num*4;
shift8 = (ctx->jastrow_champ.cord_num+1)*ctx->nucleus.num*ctx->electron.num;
shift9 = (ctx->jastrow_champ.cord_num+1)*ctx->nucleus.num;
shift10 = (ctx->jastrow_champ.cord_num+1)*ctx->nucleus.num*4*ctx->electron.num;
shift11 = ctx->nucleus.num*4*ctx->electron.num;
shift12 = (ctx->jastrow_champ.cord_num+1)*ctx->nucleus.num*4;
shift13 = ctx->nucleus.num*4;
shift14 = ctx->nucleus.num*ctx->electron.num;
for (int nw = 0; nw < ctx->electron.walker.num; nw++) {
ctx->jastrow_champ.factor_een[nw] = ctx->jastrow_champ.factor_een[nw] + ctx->single_point.delta_een[nw];
for (int l = 0; l <= ctx->jastrow_champ.cord_num; l++){
for (int i = 0; i < ctx->electron.num; i++) {
ctx->jastrow_champ.een_rescaled_e[nw*shift1
+ l*shift2
+ i*ctx->electron.num
+ ctx->single_point.num] =
ctx->single_point.een_rescaled_single_e[nw*shift3
+ l*ctx->electron.num
+ i];
ctx->jastrow_champ.een_rescaled_e[nw*shift1
+ l*shift2
+ ctx->single_point.num*ctx->electron.num
+ i] =
ctx->single_point.een_rescaled_single_e[nw*shift3
+ l*ctx->electron.num
+ i];
for (int k = 0; k < 4; k++){
ctx->jastrow_champ.een_rescaled_e_gl[nw*shift4
+ l*shift5
+ i*shift6
+ k*ctx->electron.num
+ ctx->single_point.num] =
ctx->single_point.een_rescaled_single_e_gl[nw*shift7
+ l*shift6
+ i*4
+ k];
ctx->jastrow_champ.een_rescaled_e_gl[nw*shift4
+ l*shift5
+ ctx->single_point.num*shift6
+ k*ctx->electron.num
+ i] =
metric[k] * ctx->single_point.een_rescaled_single_e_gl[nw*shift7
+ l*shift6
+ i*4
+ k];
}
}
for (int a = 0; a < ctx->nucleus.num; a++){
ctx->jastrow_champ.een_rescaled_n[nw*shift8
+ l*shift14
+ a*ctx->electron.num
+ ctx->single_point.num] =
ctx->single_point.een_rescaled_single_n[nw*shift9
+ l*ctx->nucleus.num
+ a];
for (int k = 0; k < 4; k++){
ctx->jastrow_champ.een_rescaled_n_gl[nw*shift10
+ l*shift11
+ a*shift6
+ k*ctx->electron.num
+ ctx->single_point.num] =
ctx->single_point.een_rescaled_single_n_gl[nw*shift12
+ l*shift13
+ a*4
+ k];
}
}
}
}
for (int i = 0; i < ctx->electron.walker.num * 4 * ctx->electron.num; i++) {
ctx->jastrow_champ.factor_een_gl[i] = ctx->jastrow_champ.factor_een_gl[i] + ctx->single_point.delta_een_gl[i];
}
for (int i = 0; i < (ctx->electron.walker.num*(ctx->jastrow_champ.cord_num+1)*ctx->nucleus.num*ctx->electron.num*ctx->jastrow_champ.cord_num); i++) {
ctx->jastrow_champ.tmp_c[i] = ctx->jastrow_champ.tmp_c[i] + ctx->single_point.delta_p[i];
}
/*
for (int nw = 0; nw < ctx->electron.walker.num; nw++) {
for (int m = 0; m < ctx->jastrow_champ.cord_num; m++){
for (int l = 0; l <= ctx->jastrow_champ.cord_num; l++) {
for (int a = 0; a < ctx->nucleus.num; a++) {
for (int k = 0; k < 4; k++){
for (int i = 0; i < ctx->electron.num; i++) {
ctx->jastrow_champ.dtmp_c[nw*ctx->electron.num*4*ctx->nucleus.num*ctx->jastrow_champ.cord_num*(ctx->jastrow_champ.cord_num+1)
+ m*ctx->electron.num*4*ctx->nucleus.num*(ctx->jastrow_champ.cord_num+1)
+ l*ctx->electron.num*4*ctx->nucleus.num
+ a*4*ctx->electron.num
+ k*ctx->electron.num
+ i] =
ctx->jastrow_champ.dtmp_c[nw*ctx->electron.num*4*ctx->nucleus.num*ctx->jastrow_champ.cord_num*(ctx->jastrow_champ.cord_num+1)
+ m*ctx->electron.num*4*ctx->nucleus.num*(ctx->jastrow_champ.cord_num+1)
+ l*ctx->electron.num*4*ctx->nucleus.num
+ a*4*ctx->electron.num
+ k*ctx->electron.num
+ i] +
ctx->single_point.delta_p_gl[nw*ctx->electron.num*4*ctx->nucleus.num*ctx->jastrow_champ.cord_num*(ctx->jastrow_champ.cord_num+1)
+ m*ctx->electron.num*4*ctx->nucleus.num*(ctx->jastrow_champ.cord_num+1)
+ l*ctx->electron.num*4*ctx->nucleus.num
+ k*ctx->electron.num*ctx->nucleus.num
+ a*ctx->electron.num
+ i];
}
}
}
}
}
}
*/
for (int nw = 0; nw < ctx->electron.walker.num*(ctx->jastrow_champ.cord_num+1)*ctx->jastrow_champ.cord_num; nw++) {
for (int a = 0; a < ctx->nucleus.num; a++) {
for (int k = 0; k < 4; k++){
for (int i = 0; i < ctx->electron.num; i++) {
ctx->jastrow_champ.dtmp_c[nw*shift11
+ a*shift6
+ k*ctx->electron.num
+ i] =
ctx->jastrow_champ.dtmp_c[nw*shift11
+ a*shift6
+ k*ctx->electron.num
+ i] +
ctx->single_point.delta_p_gl[nw*shift11
+ k*shift14
+ a*ctx->electron.num
+ i];
}
}
}
}
}
for (int nw = 0; nw < ctx->electron.walker.num; nw++) {
ctx->jastrow_champ.factor_en[nw] = ctx->jastrow_champ.factor_en[nw] + ctx->single_point.delta_en[nw];
ctx->jastrow_champ.factor_ee[nw] = ctx->jastrow_champ.factor_ee[nw] + ctx->single_point.delta_ee[nw];
for (int a = 0; a < ctx->nucleus.num; a++) {
ctx->electron.en_distance[nw*shift14
+ ctx->single_point.num*ctx->nucleus.num
+ a] =
ctx->single_point.single_en_distance[nw*ctx->nucleus.num
+ a];
ctx->jastrow_champ.en_distance_rescaled[nw*shift14
+ a*ctx->electron.num
+ ctx->single_point.num] =
ctx->single_point.en_rescaled_single[nw*ctx->nucleus.num
+ a];
for (int k = 0; k < 4; k++){
ctx->jastrow_champ.en_distance_rescaled_gl[nw*shift11
+ a*shift6
+ ctx->single_point.num*4
+ k] =
ctx->single_point.en_rescaled_single_gl[nw*shift13
+ a*4
+ k];
}
}
for (int i = 0; i < ctx->electron.num; i++) {
ctx->jastrow_champ.ee_distance_rescaled[nw*shift2
+ i*ctx->electron.num
+ ctx->single_point.num] =
ctx->single_point.ee_rescaled_single[nw*ctx->electron.num
+ i];
ctx->jastrow_champ.ee_distance_rescaled[nw*shift2
+ ctx->single_point.num*ctx->electron.num
+ i] =
ctx->single_point.ee_rescaled_single[nw*ctx->electron.num
+ i];
ctx->electron.ee_distance[nw*shift2
+ i*ctx->electron.num
+ ctx->single_point.num] =
ctx->single_point.single_ee_distance[nw*ctx->electron.num
+ i];
ctx->electron.ee_distance[nw*shift2
+ ctx->single_point.num*ctx->electron.num
+ i] =
ctx->single_point.single_ee_distance[nw*ctx->electron.num
+ i];
for (int k = 0; k < 4; k++){
ctx->jastrow_champ.ee_distance_rescaled_gl[nw*shift5
+ i*shift6
+ ctx->single_point.num*4
+ k] =
metric[k] * ctx->single_point.ee_rescaled_single_gl[nw*shift6
+ i*4
+ k];
ctx->jastrow_champ.ee_distance_rescaled_gl[nw*shift5
+ ctx->single_point.num*shift6
+ i*4
+ k] =
ctx->single_point.ee_rescaled_single_gl[nw*shift6
+ i*4
+ k];
}
}
for (int k = 0; k < 4; k++){
for (int i = 0; i < ctx->electron.num; i++) {
ctx->jastrow_champ.factor_ee_gl[nw*shift6
+ k*ctx->electron.num
+ i] =
ctx->jastrow_champ.factor_ee_gl[nw*shift6
+ k*ctx->electron.num
+ i] +
ctx->single_point.delta_ee_gl[nw*shift6
+ i*4
+ k];
ctx->jastrow_champ.factor_en_gl[nw*shift6
+ k*ctx->electron.num
+ i] =
ctx->jastrow_champ.factor_en_gl[nw*shift6
+ k*ctx->electron.num
+ i] +
ctx->single_point.delta_en_gl[nw*shift6
+ i*4
+ k];
}
}
}
for (int nw = 0; nw < ctx->electron.walker.num; nw++) {
for (int k = 0; k < 3; k++) {
ctx->point.coord.data[k*ctx->electron.walker.num*ctx->electron.num + nw*ctx->electron.num + ctx->single_point.num] = ctx->single_point.coord.data[nw*3 + k];
}
}
rc = qmckl_context_touch(context);
if (rc != QMCKL_SUCCESS) return rc;
if (ctx->jastrow_champ.cord_num > 0){
ctx->jastrow_champ.dtmp_c_date = ctx->date;
ctx->jastrow_champ.een_rescaled_e_date = ctx->date;
ctx->jastrow_champ.een_rescaled_e_gl_date = ctx->date;
ctx->jastrow_champ.een_rescaled_n_date = ctx->date;
ctx->jastrow_champ.een_rescaled_n_gl_date = ctx->date;
ctx->jastrow_champ.factor_een_date = ctx->date;
ctx->jastrow_champ.factor_een_gl_date = ctx->date;
ctx->jastrow_champ.tmp_c_date = ctx->date;
}
ctx->jastrow_champ.ee_distance_rescaled_date = ctx->date;
ctx->jastrow_champ.ee_distance_rescaled_gl_date = ctx->date;
ctx->jastrow_champ.en_distance_rescaled_date = ctx->date;
ctx->jastrow_champ.en_distance_rescaled_gl_date = ctx->date;
ctx->jastrow_champ.factor_ee_date = ctx->date;
ctx->jastrow_champ.factor_ee_gl_date = ctx->date;
ctx->jastrow_champ.factor_en_date = ctx->date;
ctx->jastrow_champ.factor_en_gl_date = ctx->date;
ctx->electron.ee_distance_date = ctx->date;
ctx->electron.en_distance_date = ctx->date;
ctx->single_point.date = ctx->date;
if (ctx->jastrow_champ.cord_num > 0){
ctx->single_point.een_rescaled_single_e_date = ctx->single_point.date;
ctx->single_point.een_rescaled_single_n_date = ctx->single_point.date;
ctx->single_point.delta_een_date = ctx->single_point.date;
ctx->single_point.delta_p_date = ctx->single_point.date;
ctx->single_point.een_rescaled_single_e_gl_date = ctx->single_point.date;
ctx->single_point.een_rescaled_single_n_gl_date = ctx->single_point.date;
ctx->single_point.delta_p_gl_date = ctx->single_point.date;
ctx->single_point.delta_een_gl_date = ctx->single_point.date;
}
ctx->single_point.single_ee_distance_date = ctx->single_point.date;
ctx->single_point.single_en_distance_date = ctx->single_point.date;
ctx->single_point.ee_rescaled_single_date = ctx->single_point.date;
ctx->single_point.en_rescaled_single_date = ctx->single_point.date;
ctx->single_point.delta_en_date = ctx->single_point.date;
ctx->single_point.delta_ee_date = ctx->single_point.date;
ctx->single_point.ee_rescaled_single_gl_date = ctx->single_point.date;
ctx->single_point.en_rescaled_single_gl_date = ctx->single_point.date;
ctx->single_point.delta_en_gl_date = ctx->single_point.date;
ctx->single_point.delta_ee_gl_date = ctx->single_point.date;
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org
interface
integer(qmckl_exit_code) function qmckl_get_jastrow_champ_single_accept (context) bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (qmckl_context) , intent(in), value :: context
end function qmckl_get_jastrow_champ_single_accept
end interface
#+end_src
** Test :noexport:
#+begin_src c :tangle (eval c_test)
printf("Accept test 1\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_en(context, &jastrow_en_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee(context, &jastrow_ee_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een(context, &jastrow_een_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_en_gl(context, &en_gl_old[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee_gl(context, &ee_gl_old[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een_gl(context, &een_gl_old[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_tmp_c(context, &p_old[0][0][0][0][0], walk_num*cord_num*(cord_num+1)*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_dtmp_c(context, &p_gl_old[0][0][0][0][0][0], 4*walk_num*cord_num*(cord_num+1)*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
// ----------------------------
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', elec, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_en(context, &delta_en[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_ee(context, &delta_ee[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_een(context, &delta_een[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_en_gl(context, &delta_en_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_ee_gl(context, &delta_ee_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_een_gl(context, &delta_een_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_een_rescaled_single_e(context, &single_rescaled_een_ee_distance[0][0][0], walk_num*(cord_num+1)*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_een_rescaled_single_n(context, &single_rescaled_een_en_distance[0][0][0], walk_num*(cord_num+1)*nucl_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_delta_p(context, &delta_p[0][0][0][0][0], walk_num*cord_num*(cord_num+1)*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_ee_rescaled_single(context, &single_ee_rescaled[0][0], walk_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_en_rescaled_single(context, &single_en_rescaled[0][0], walk_num*nucl_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_een_rescaled_single_n_gl(context, &een_rescaled_single_n_gl[0][0][0][0], walk_num*(cord_num+1)*nucl_num*4);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_een_rescaled_single_e_gl(context, &een_rescaled_single_e_gl[0][0][0][0], walk_num*(cord_num+1)*elec_num*4);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_delta_p_gl(context, &delta_p_gl[0][0][0][0][0][0], 4*walk_num*cord_num*(cord_num+1)*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_ee_rescaled_single_gl(context, &single_ee_rescaled_gl[0][0][0], walk_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_en_rescaled_single_gl(context, &single_en_rescaled_gl[0][0][0], walk_num*nucl_num*4);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_single_electron_ee_distance(context, &single_ee_distance[0][0], walk_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_single_electron_en_distance(context, &single_en_distance[0][0], walk_num*nucl_num);
assert (rc == QMCKL_SUCCESS);
// ----------------------------
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_get_jastrow_champ_single_accept(context);
assert (rc == QMCKL_SUCCESS);
//rc = qmckl_context_touch(context);
rc = qmckl_get_jastrow_champ_factor_en(context, &jastrow_en_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee(context, &jastrow_ee_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een(context, &jastrow_een_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_en_gl(context, &en_gl_new[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee_gl(context, &ee_gl_new[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een_gl(context, &een_gl_new[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_een_rescaled_e(context, &rescaled_een_ee_distance[0][0][0][0], walk_num*(cord_num+1)*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_een_rescaled_n(context, &rescaled_een_en_distance[0][0][0][0], walk_num*(cord_num+1)*elec_num*nucl_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_tmp_c(context, &p_new[0][0][0][0][0], walk_num*cord_num*(cord_num+1)*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_ee_distance_rescaled(context, &ee_rescaled[0][0][0], walk_num*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_en_distance_rescaled(context, &en_rescaled[0][0][0], walk_num*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_een_rescaled_n_gl(context, &een_rescaled_en_gl[0][0][0][0][0], walk_num*(cord_num+1)*nucl_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_een_rescaled_e_gl(context, &een_rescaled_ee_gl[0][0][0][0][0], walk_num*(cord_num+1)*elec_num*elec_num*4);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_dtmp_c(context, &p_gl_new[0][0][0][0][0][0], 4*walk_num*cord_num*(cord_num+1)*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_ee_distance_rescaled_gl(context, &ee_rescaled_gl[0][0][0][0], walk_num*4*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_en_distance_rescaled_gl(context, &en_rescaled_gl[0][0][0][0], walk_num*4*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_ee_distance(context, &ee_distance[0][0][0], walk_num*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_en_distance(context, &en_distance[0][0][0], walk_num*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
double metric[4] = {-1.0, -1.0, -1.0, 1.0};
for (int nw = 0; nw < walk_num; nw++) {
//printf("jastrow_en_new[%d] = %f\n", nw, jastrow_en_new[nw]);
//printf("jastrow_en_old[%d] = %f\n", nw, jastrow_en_old[nw]);
//printf("delta_en[%d] = %f\n", nw, delta_en[nw]);
assert(fabs((jastrow_en_new[nw] - jastrow_en_old[nw]) - delta_en[nw]) < 1.e-12);
assert(fabs((jastrow_ee_new[nw] - jastrow_ee_old[nw]) - delta_ee[nw]) < 1.e-12);
assert(fabs((jastrow_een_new[nw] - jastrow_een_old[nw]) - delta_een[nw]) < 1.e-12);
for (int i = 0; i < elec_num; i++){
for (int k = 0; k < 4; k++){
//printf("en_gl_new[%d][%d][%d] = %f\n", nw, k, i, en_gl_new[nw][k][i]);
//printf("en_gl_old[%d][%d][%d] = %f\n", nw, k, i, en_gl_old[nw][k][i]);
//printf("delta_en_gl[%d][%d][%d] = %f\n", nw, i, k, delta_en_gl[nw][i][k]);
assert(fabs((en_gl_new[nw][k][i] - en_gl_old[nw][k][i]) - delta_en_gl[nw][i][k]) < 1.e-12);
assert(fabs((ee_gl_new[nw][k][i] - ee_gl_old[nw][k][i]) - delta_ee_gl[nw][i][k]) < 1.e-12);
assert(fabs((een_gl_new[nw][k][i] - een_gl_old[nw][k][i]) - delta_een_gl[nw][k][i]) < 1.e-12);
}
}
}
for (int nw = 0; nw < walk_num; nw++){
for (int l = 0; l <= cord_num; l++){
for (int i = 0; i < elec_num; i++) {
//printf("rescaled_een_ee_distance[%d][%d][elec][%d] = %f\n", nw, l, i, rescaled_een_ee_distance[nw][l][elec][i]);
//printf("single_rescaled_een_ee_distance[%d][%d][%d] = %f\n", nw, l, i, single_rescaled_een_ee_distance[nw][l][i]);
assert(fabs((rescaled_een_ee_distance[nw][l][elec][i]-single_rescaled_een_ee_distance[nw][l][i])) < 1.e-12);
assert(fabs((rescaled_een_ee_distance[nw][l][i][elec]-single_rescaled_een_ee_distance[nw][l][i])) < 1.e-12);
}
}
}
for (int nw = 0; nw < walk_num; nw++){
for (int l = 0; l <= cord_num; l++){
for (int a = 0; a < nucl_num; a++) {
//printf("rescaled_een_en_distance[%d][%d][%d][elec] = %f\n", nw, l, a, rescaled_een_en_distance[nw][l][a][elec]);
//printf("single_rescaled_een_en_distance[%d][%d][%d] = %f\n", nw, l, a, single_rescaled_een_en_distance[nw][l][a]);
assert(fabs((rescaled_een_en_distance[nw][l][a][elec]-single_rescaled_een_en_distance[nw][l][a])) < 1.e-12);
}
}
}
for (int nw = 0; nw < walk_num; nw++){
for (int l = 0; l < cord_num; l++){
for (int m = 0; m <= cord_num; m++){
for (int a = 0; a < nucl_num; a++) {
for (int i = 0; i < elec_num; i++){
assert(fabs(((p_new[nw][l][m][a][i]-p_old[nw][l][m][a][i])-delta_p[nw][l][m][a][i])) < 1.e-12);
}
}
}
}
}
for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++){
assert(fabs(ee_rescaled[nw][elec][i]-single_ee_rescaled[nw][i]) < 1.e-12);
}
}
for (int nw = 0; nw < walk_num; nw++) {
for (int a = 0; a < nucl_num; a++){
assert(fabs(en_rescaled[nw][a][elec]-single_en_rescaled[nw][a]) < 1.e-12);
}
}
for (int l = 0; l < cord_num+1; l++) {
for (int nw = 0; nw < walk_num; nw++) {
for (int a = 0; a < nucl_num; a++) {
for (int m = 0; m < 4; m++) {
assert(fabs(een_rescaled_en_gl[nw][l][a][m][elec] - een_rescaled_single_n_gl[nw][l][a][m]) < 1.e-12);
}
}
}
}
for (int l = 0; l < cord_num+1; l++) {
for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++) {
for (int m = 0; m < 4; m++) {
//printf("een_rescaled_ee_gl[nw][l][i][m][elec] %i %i %i %f \n", l, m ,i, een_rescaled_ee_gl[nw][l][i][m][elec]);
//printf("een_rescaled_single_e_gl[nw][l][i][m] %i %i %i %f\n", l, m, i,een_rescaled_single_e_gl[nw][l][i][m]);
assert(fabs(een_rescaled_ee_gl[nw][l][i][m][elec] - een_rescaled_single_e_gl[nw][l][i][m]) < 1.e-12);
assert(fabs(een_rescaled_ee_gl[nw][l][elec][m][i] - metric[m] * een_rescaled_single_e_gl[nw][l][i][m]) < 1.e-12);
}
}
}
}
for (int nw = 0; nw < walk_num; nw++){
for (int l = 0; l < cord_num; l++){
for (int m = 0; m <= cord_num; m++){
for (int a = 0; a < nucl_num; a++) {
for (int i = 0; i < elec_num; i++){
for (int k = 0; k < 4; k++){
//printf("p_gl[%d][%d][%d][%d][%d][%d] = %f\n", nw, l, m, a, k, i, p_gl_new[nw][l][m][a][k][i] - p_gl_old[nw][l][m][a][k][i]);
//printf("delta_p_gl[%d][%d][%d][%d][%d][%d] = %f\n", nw, l, m, a, k, i, delta_p_gl[nw][l][m][k][a][i]);
assert(fabs(((p_gl_new[nw][l][m][a][k][i]-p_gl_old[nw][l][m][a][k][i])-delta_p_gl[nw][l][m][k][a][i])) < 1.e-12);
}
}
}
}
}
}
for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++) {
for (int m = 0; m < 4; m++) {
if (i == 2) continue;
//printf("%f\n", ee_rescaled_gl[nw][elec][i][m]);
//printf("%f\n", single_ee_rescaled_gl[nw][i][m]);
assert(fabs(ee_rescaled_gl[nw][elec][i][m] - single_ee_rescaled_gl[nw][i][m]) < 1.e-12);
assert(fabs(ee_rescaled_gl[nw][i][elec][m] - metric[m] * single_ee_rescaled_gl[nw][i][m]) < 1.e-12);
}
}
}
for (int nw = 0; nw < walk_num; nw++) {
for (int a = 0; a < nucl_num; a++) {
for (int m = 0; m < 4; m++) {
assert(fabs(en_rescaled_gl[nw][a][elec][m] - single_en_rescaled_gl[nw][a][m]) < 1.e-12);
}
}
}
for (int nw = 0; nw < walk_num; nw++){
for (int i = 0; i < elec_num; i++) {
if (i == 2) continue;
assert(fabs((ee_distance[nw][elec][i]-single_ee_distance[nw][i])) < 1.e-12);
}
}
for (int nw = 0; nw < walk_num; nw++){
for (int a = 0; a < nucl_num; a++){
assert(fabs((en_distance[nw][elec][a]-single_en_distance[nw][a])) < 1.e-12);
}
}
}
printf("OK\n");
#+end_src
#+begin_src c :tangle (eval c_test)
printf("Accept test 2\n");
/* Check if Jastrow is properly initialized */
assert(qmckl_jastrow_champ_provided(context));
for (int elec = 0; elec < elec_num; elec++){
rc = qmckl_set_electron_coord(context, 'N', walk_num, elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_en(context, &jastrow_en_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee(context, &jastrow_ee_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een(context, &jastrow_een_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_en_gl(context, &en_gl_old[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee_gl(context, &ee_gl_old[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een_gl(context, &een_gl_old[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_ee_distance(context, &ee_distance[0][0][0], walk_num*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_en_distance(context, &en_distance[0][0][0], walk_num*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_ee_distance_rescaled(context, &ee_rescaled[0][0][0], walk_num*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_ee_distance_rescaled_gl(context, &ee_rescaled_gl[0][0][0][0], walk_num*4*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_single_point(context, 'N', 2, new_coords, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_en(context, &delta_en[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_ee(context, &delta_ee[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_een(context, &delta_een[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_en_gl(context, &delta_en_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_ee_gl(context, &delta_ee_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_een_gl(context, &delta_een_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_single_electron_ee_distance(context, &single_ee_distance[0][0], walk_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_single_electron_en_distance(context, &single_en_distance[0][0], walk_num*nucl_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_ee_rescaled_single(context, &single_ee_rescaled[0][0], walk_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_ee_rescaled_single_gl(context, &single_ee_rescaled_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords[0];
coords[0][elec][1] = new_coords[1];
coords[0][elec][2] = new_coords[2];
coords[1][elec][0] = new_coords[3];
coords[1][elec][1] = new_coords[4];
coords[1][elec][2] = new_coords[5];
rc = qmckl_get_jastrow_champ_single_accept(context);
assert (rc == QMCKL_SUCCESS);
//rc = qmckl_context_touch(context);
rc = qmckl_get_jastrow_champ_factor_en(context, &jastrow_en_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee(context, &jastrow_ee_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een(context, &jastrow_een_old[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_en_gl(context, &en_gl_old[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee_gl(context, &ee_gl_old[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een_gl(context, &een_gl_old[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_ee_distance(context, &ee_distance[0][0][0], walk_num*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_en_distance(context, &en_distance[0][0][0], walk_num*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_ee_distance_rescaled(context, &ee_rescaled[0][0][0], walk_num*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_ee_distance_rescaled_gl(context, &ee_rescaled_gl[0][0][0][0], walk_num*4*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
double new_coords2[6] = {3.0,2.0,1.0,3.0,2.0,1.0};
rc = qmckl_set_single_point(context, 'N', elec, new_coords2, 3*walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_en(context, &delta_en[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_ee(context, &delta_ee[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_een(context, &delta_een[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_en_gl(context, &delta_en_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_ee_gl(context, &delta_ee_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_single_een_gl(context, &delta_een_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_single_electron_ee_distance(context, &single_ee_distance[0][0], walk_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_single_electron_en_distance(context, &single_en_distance[0][0], walk_num*nucl_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_ee_rescaled_single(context, &single_ee_rescaled[0][0], walk_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_ee_rescaled_single_gl(context, &single_ee_rescaled_gl[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_coord(context, 'N', &coords[0][0][0], walk_num*elec_num*3);
assert (rc == QMCKL_SUCCESS);
coords[0][elec][0] = new_coords2[0];
coords[0][elec][1] = new_coords2[1];
coords[0][elec][2] = new_coords2[2];
coords[1][elec][0] = new_coords2[3];
coords[1][elec][1] = new_coords2[4];
coords[1][elec][2] = new_coords2[5];
rc = qmckl_set_electron_coord(context, 'N', walk_num, &coords[0][0][0], walk_num*elec_num*3);
rc = qmckl_context_touch(context);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_en(context, &jastrow_en_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee(context, &jastrow_ee_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een(context, &jastrow_een_new[0], walk_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_en_gl(context, &en_gl_new[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_ee_gl(context, &ee_gl_new[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_factor_een_gl(context, &een_gl_new[0][0][0], walk_num*4*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_ee_distance(context, &ee_distance[0][0][0], walk_num*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_electron_en_distance(context, &en_distance[0][0][0], walk_num*nucl_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_ee_distance_rescaled(context, &ee_rescaled[0][0][0], walk_num*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_jastrow_champ_ee_distance_rescaled_gl(context, &ee_rescaled_gl[0][0][0][0], walk_num*4*elec_num*elec_num);
assert (rc == QMCKL_SUCCESS);
for (int nw = 0; nw < walk_num; nw++) {
//printf("jastrow_en_new[%d] = %f\t", nw, jastrow_en_new[nw]);
//printf("jastrow_en_old[%d] = %f\t", nw, jastrow_en_old[nw]);
//printf("delta_en[%d] = %f\n", nw, delta_en[nw]);
//printf("jastrow_ee_new[%d] = %f\t", nw, jastrow_ee_new[nw]);
//printf("jastrow_ee_old[%d] = %f\t", nw, jastrow_ee_old[nw]);
//printf("delta_ee[%d] = %f\n", nw, delta_ee[nw]);
assert(fabs((jastrow_en_new[nw] - jastrow_en_old[nw]) - delta_en[nw]) < 1.e-12);
assert(fabs((jastrow_ee_new[nw] - jastrow_ee_old[nw]) - delta_ee[nw]) < 1.e-12);
assert(fabs((jastrow_een_new[nw] - jastrow_een_old[nw]) - delta_een[nw]) < 1.e-12);
for (int i = 0; i < elec_num; i++){
for (int k = 0; k < 4; k++){
//printf("ee_gl_new[%d][%d][%d] = %f\n", nw, k, i, ee_gl_new[nw][k][i]);
//printf("ee_gl_old[%d][%d][%d] = %f\n", nw, k, i, ee_gl_old[nw][k][i]);
//printf("delta_ee_gl[%d][%d][%d] = %f\n", nw, i, k, delta_ee_gl[nw][i][k]);
assert(fabs((en_gl_new[nw][k][i] - en_gl_old[nw][k][i]) - delta_en_gl[nw][i][k]) < 1.e-12);
assert(fabs((ee_gl_new[nw][k][i] - ee_gl_old[nw][k][i]) - delta_ee_gl[nw][i][k]) < 1.e-12);
assert(fabs((een_gl_new[nw][k][i] - een_gl_old[nw][k][i]) - delta_een_gl[nw][k][i]) < 1.e-12);
}
}
}
for (int nw = 0; nw < walk_num; nw++){
for (int i = 0; i < elec_num; i++) {
if (i == 1) continue;
//printf("ee_distance[%d][elec][%d] = %f\n", nw, i, ee_distance[nw][elec][i]);
//printf("single_ee_distance[%d][%d] = %f\n", nw, i, single_ee_distance[nw][i]);
assert(fabs((ee_distance[nw][elec][i]-single_ee_distance[nw][i])) < 1.e-12);
}
}
for (int nw = 0; nw < walk_num; nw++) {
for (int a = 0; a < nucl_num; a++){
assert(fabs((en_distance[nw][elec][a]-single_en_distance[nw][a])) < 1.e-12);
}
}
for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++){
assert(fabs(ee_rescaled[nw][elec][i]-single_ee_rescaled[nw][i]) < 1.e-12);
}
}
for (int nw = 0; nw < walk_num; nw++) {
for (int i = 0; i < elec_num; i++) {
for (int m = 0; m < 4; m++) {
if (i == elec) continue;
//printf("%f\n", ee_rescaled_gl[nw][elec][i][m]);
//printf("%f\n", single_ee_rescaled_gl[nw][i][m]);
assert(fabs(ee_rescaled_gl[nw][elec][i][m] - single_ee_rescaled_gl[nw][i][m]) < 1.e-12);
}
}
}
}
printf("OK\n");
#+end_src
* End of files :noexport:
#+begin_src c :tangle (eval h_private_type)
#endif
#+end_src
#+begin_src c :tangle (eval h_private_func)
#endif
#+end_src
** Test :noexport:
#+begin_src c :tangle (eval c_test)
rc = qmckl_context_destroy(context);
assert (rc == QMCKL_SUCCESS);
return 0;
}
#+end_src
Reference in New Issue View Git Blame Copy Permalink