TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2025-04-30 04:15:00 +02:00
Code Issues Projects Releases Wiki Activity

Merge branch 'TREX-CoE:master' into master

Browse Source
This commit is contained in:
vijay 2022-01-26 18:34:48 +01:00 committed by GitHub
commit 402fe7c9c8
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
12 changed files with 1337 additions and 1178 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

326
org/qmckl_ao.org
View File

@ -279,11 +279,11 @@ typedef struct qmckl_ao_basis_struct {
int32_t * nucleus_max_ang_mom; int32_t * nucleus_max_ang_mom;
double * nucleus_range; double * nucleus_range;
double * primitive_vgl; double * primitive_vgl;
int64_t primitive_vgl_date; uint64_t primitive_vgl_date;
double * shell_vgl; double * shell_vgl;
int64_t shell_vgl_date; uint64_t shell_vgl_date;
double * ao_vgl; double * ao_vgl;
int64_t ao_vgl_date; uint64_t ao_vgl_date;
int32_t uninitialized; int32_t uninitialized;
bool provided; bool provided;
@ -2258,10 +2258,10 @@ qmckl_exit_code rc;
rc = qmckl_set_nucleus_num (context, nucl_num); rc = qmckl_set_nucleus_num (context, nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0])); rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0]), 3*nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_charge(context, nucl_charge); rc = qmckl_set_nucleus_charge(context, nucl_charge, nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
assert(qmckl_nucleus_provided(context)); assert(qmckl_nucleus_provided(context));
@ -2457,15 +2457,15 @@ for (int64_t i=0 ; i < ao_num ; ++i) {
The following data is computed as described in the next sections: The following data is computed as described in the next sections:
|----------------------+----------------------------------+-----------------------------------------------------------------------------------------------| |----------------------+-----------------------------------+----------------------------------------------------------------------------------------------|
| Variable | Type | Description | | Variable | Type | Description |
|----------------------+----------------------------------+-----------------------------------------------------------------------------------------------| |----------------------+-----------------------------------+----------------------------------------------------------------------------------------------|
| ~primitive_vgl~ | ~double[5][elec_num][prim_num]~ | Value, gradients, Laplacian of the primitives at electron positions | | ~primitive_vgl~ | ~double[5][point_num][prim_num]~ | Value, gradients, Laplacian of the primitives at current positions |
| ~primitive_vgl_date~ | ~uint64_t~ | Last modification date of Value, gradients, Laplacian of the primitives at electron positions | | ~primitive_vgl_date~ | ~uint64_t~ | Last modification date of Value, gradients, Laplacian of the primitives at current positions |
| ~shell_vgl~ | ~double[5][elec_num][shell_num]~ | Value, gradients, Laplacian of the primitives at electron positions | | ~shell_vgl~ | ~double[5][point_num][shell_num]~ | Value, gradients, Laplacian of the primitives at current positions |
| ~shell_vgl_date~ | ~uint64_t~ | Last modification date of Value, gradients, Laplacian of the AOs at electron positions | | ~shell_vgl_date~ | ~uint64_t~ | Last modification date of Value, gradients, Laplacian of the AOs at current positions |
| ~ao_vgl~ | ~double[5][elec_num][ao_num]~ | Value, gradients, Laplacian of the primitives at electron positions | | ~ao_vgl~ | ~double[5][point_num][ao_num]~ | Value, gradients, Laplacian of the primitives at current positions |
| ~ao_vgl_date~ | ~uint64_t~ | Last modification date of Value, gradients, Laplacian of the AOs at electron positions | | ~ao_vgl_date~ | ~uint64_t~ | Last modification date of Value, gradients, Laplacian of the AOs at current positions |
*** After initialization *** After initialization
@ -2653,7 +2653,7 @@ qmckl_get_ao_basis_primitive_vgl (qmckl_context context,
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
assert (ctx != NULL); assert (ctx != NULL);
int64_t sze = ctx->ao_basis.prim_num * 5 * ctx->electron.num; int64_t sze = ctx->ao_basis.prim_num * 5 * ctx->point.num;
if (size_max < sze) { if (size_max < sze) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_INVALID_ARG_3, QMCKL_INVALID_ARG_3,
@ -2714,7 +2714,7 @@ qmckl_get_ao_basis_shell_vgl (qmckl_context context,
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
assert (ctx != NULL); assert (ctx != NULL);
int64_t sze = ctx->ao_basis.shell_num * 5 * ctx->electron.num; int64_t sze = ctx->ao_basis.shell_num * 5 * ctx->point.num;
if (size_max < sze) { if (size_max < sze) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_INVALID_ARG_3, QMCKL_INVALID_ARG_3,
@ -2777,7 +2777,7 @@ qmckl_get_ao_basis_ao_vgl (qmckl_context context,
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
assert (ctx != NULL); assert (ctx != NULL);
int64_t sze = ctx->ao_basis.ao_num * 5 * ctx->electron.num; int64_t sze = ctx->ao_basis.ao_num * 5 * ctx->point.num;
if (size_max < sze) { if (size_max < sze) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_INVALID_ARG_3, QMCKL_INVALID_ARG_3,
@ -3046,16 +3046,16 @@ assert(0 == test_qmckl_ao_gaussian_vgl(context));
#+NAME: qmckl_ao_basis_primitive_gaussian_vgl_args #+NAME: qmckl_ao_basis_primitive_gaussian_vgl_args
| Variable | Type | In/Out | Description | | Variable | Type | In/Out | Description |
|----------------------+---------------------------------+--------+--------------------------------------------------| |----------------------+----------------------------------+--------+--------------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state | | ~context~ | ~qmckl_context~ | in | Global state |
| ~prim_num~ | ~int64_t~ | in | Number of primitives | | ~prim_num~ | ~int64_t~ | in | Number of primitives |
| ~elec_num~ | ~int64_t~ | in | Number of electrons | | ~point_num~ | ~int64_t~ | in | Number of points considered |
| ~nucl_num~ | ~int64_t~ | in | Number of nuclei | | ~nucl_num~ | ~int64_t~ | in | Number of nuclei |
| ~nucleus_prim_index~ | ~int64_t[nucl_num]~ | in | Index of the 1st primitive of each nucleus | | ~nucleus_prim_index~ | ~int64_t[nucl_num]~ | in | Index of the 1st primitive of each nucleus |
| ~elec_coord~ | ~double[3][elec_num]~ | in | Electron coordinates | | ~coord~ | ~double[3][point_num]~ | in | Coordinates |
| ~nucl_coord~ | ~double[3][elec_num]~ | in | Nuclear coordinates | | ~nucl_coord~ | ~double[3][nucl_num]~ | in | Nuclear coordinates |
| ~expo~ | ~double[prim_num]~ | in | Exponents of the primitives | | ~expo~ | ~double[prim_num]~ | in | Exponents of the primitives |
| ~primitive_vgl~ | ~double[5][elec_num][prim_num]~ | out | Value, gradients and Laplacian of the primitives | | ~primitive_vgl~ | ~double[5][point_num][prim_num]~ | out | Value, gradients and Laplacian of the primitives |
#+CALL: generate_c_header(table=qmckl_ao_basis_primitive_gaussian_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_basis_primitive_gaussian_vgl")) #+CALL: generate_c_header(table=qmckl_ao_basis_primitive_gaussian_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_basis_primitive_gaussian_vgl"))
@ -3064,10 +3064,10 @@ assert(0 == test_qmckl_ao_gaussian_vgl(context));
qmckl_exit_code qmckl_compute_ao_basis_primitive_gaussian_vgl ( qmckl_exit_code qmckl_compute_ao_basis_primitive_gaussian_vgl (
const qmckl_context context, const qmckl_context context,
const int64_t prim_num, const int64_t prim_num,
const int64_t elec_num, const int64_t point_num,
const int64_t nucl_num, const int64_t nucl_num,
const int64_t* nucleus_prim_index, const int64_t* nucleus_prim_index,
const double* elec_coord, const double* coord,
const double* nucl_coord, const double* nucl_coord,
const double* expo, const double* expo,
double* const primitive_vgl ); double* const primitive_vgl );
@ -3076,8 +3076,8 @@ assert(0 == test_qmckl_ao_gaussian_vgl(context));
#+begin_src f90 :comments org :tangle (eval f) :noweb yes #+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer function qmckl_compute_ao_basis_primitive_gaussian_vgl_f( & integer function qmckl_compute_ao_basis_primitive_gaussian_vgl_f( &
context, prim_num, elec_num, nucl_num, & context, prim_num, point_num, nucl_num, &
nucleus_prim_index, elec_coord, nucl_coord, & nucleus_prim_index, coord, nucl_coord, &
expo, primitive_vgl) & expo, primitive_vgl) &
result(info) result(info)
@ -3086,14 +3086,14 @@ integer function qmckl_compute_ao_basis_primitive_gaussian_vgl_f( &
integer(qmckl_context), intent(in) :: context integer(qmckl_context), intent(in) :: context
integer*8 , intent(in) :: prim_num integer*8 , intent(in) :: prim_num
integer*8 , intent(in) :: nucl_num integer*8 , intent(in) :: nucl_num
integer*8 , intent(in) :: elec_num integer*8 , intent(in) :: point_num
integer*8 , intent(in) :: nucleus_prim_index(nucl_num+1) integer*8 , intent(in) :: nucleus_prim_index(nucl_num+1)
double precision , intent(in) :: elec_coord(elec_num,3) double precision , intent(in) :: coord(point_num,3)
double precision , intent(in) :: nucl_coord(nucl_num,3) double precision , intent(in) :: nucl_coord(nucl_num,3)
double precision , intent(in) :: expo(prim_num) double precision , intent(in) :: expo(prim_num)
double precision , intent(out) :: primitive_vgl(prim_num,elec_num,5) double precision , intent(out) :: primitive_vgl(prim_num,point_num,5)
integer*8 :: inucl, iprim, ielec integer*8 :: inucl, iprim, ipoint
double precision :: x, y, z, two_a, ar2, r2, v, cutoff double precision :: x, y, z, two_a, ar2, r2, v, cutoff
info = QMCKL_SUCCESS info = QMCKL_SUCCESS
@ -3104,10 +3104,10 @@ integer function qmckl_compute_ao_basis_primitive_gaussian_vgl_f( &
do inucl=1,nucl_num do inucl=1,nucl_num
! C is zero-based, so shift bounds by one ! C is zero-based, so shift bounds by one
do iprim = nucleus_prim_index(inucl)+1, nucleus_prim_index(inucl+1) do iprim = nucleus_prim_index(inucl)+1, nucleus_prim_index(inucl+1)
do ielec = 1, elec_num do ipoint = 1, point_num
x = elec_coord(ielec,1) - nucl_coord(inucl,1) x = coord(ipoint,1) - nucl_coord(inucl,1)
y = elec_coord(ielec,2) - nucl_coord(inucl,2) y = coord(ipoint,2) - nucl_coord(inucl,2)
z = elec_coord(ielec,3) - nucl_coord(inucl,3) z = coord(ipoint,3) - nucl_coord(inucl,3)
r2 = x*x + y*y + z*z r2 = x*x + y*y + z*z
ar2 = expo(iprim)*r2 ar2 = expo(iprim)*r2
@ -3116,11 +3116,11 @@ integer function qmckl_compute_ao_basis_primitive_gaussian_vgl_f( &
v = dexp(-ar2) v = dexp(-ar2)
two_a = -2.d0 * expo(iprim) * v two_a = -2.d0 * expo(iprim) * v
primitive_vgl(iprim, ielec, 1) = v primitive_vgl(iprim, ipoint, 1) = v
primitive_vgl(iprim, ielec, 2) = two_a * x primitive_vgl(iprim, ipoint, 2) = two_a * x
primitive_vgl(iprim, ielec, 3) = two_a * y primitive_vgl(iprim, ipoint, 3) = two_a * y
primitive_vgl(iprim, ielec, 4) = two_a * z primitive_vgl(iprim, ipoint, 4) = two_a * z
primitive_vgl(iprim, ielec, 5) = two_a * (3.d0 - 2.d0*ar2) primitive_vgl(iprim, ipoint, 5) = two_a * (3.d0 - 2.d0*ar2)
end do end do
end do end do
@ -3136,10 +3136,10 @@ end function qmckl_compute_ao_basis_primitive_gaussian_vgl_f
integer(c_int32_t) function qmckl_compute_ao_basis_primitive_gaussian_vgl & integer(c_int32_t) function qmckl_compute_ao_basis_primitive_gaussian_vgl &
(context, & (context, &
prim_num, & prim_num, &
elec_num, & point_num, &
nucl_num, & nucl_num, &
nucleus_prim_index, & nucleus_prim_index, &
elec_coord, & coord, &
nucl_coord, & nucl_coord, &
expo, & expo, &
primitive_vgl) & primitive_vgl) &
@ -3150,22 +3150,22 @@ end function qmckl_compute_ao_basis_primitive_gaussian_vgl_f
integer (c_int64_t) , intent(in) , value :: context integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: prim_num integer (c_int64_t) , intent(in) , value :: prim_num
integer (c_int64_t) , intent(in) , value :: elec_num integer (c_int64_t) , intent(in) , value :: point_num
integer (c_int64_t) , intent(in) , value :: nucl_num integer (c_int64_t) , intent(in) , value :: nucl_num
integer (c_int64_t) , intent(in) :: nucleus_prim_index(nucl_num) integer (c_int64_t) , intent(in) :: nucleus_prim_index(nucl_num)
real (c_double ) , intent(in) :: elec_coord(elec_num,3) real (c_double ) , intent(in) :: coord(point_num,3)
real (c_double ) , intent(in) :: nucl_coord(elec_num,3) real (c_double ) , intent(in) :: nucl_coord(nucl_num,3)
real (c_double ) , intent(in) :: expo(prim_num) real (c_double ) , intent(in) :: expo(prim_num)
real (c_double ) , intent(out) :: primitive_vgl(prim_num,elec_num,5) real (c_double ) , intent(out) :: primitive_vgl(prim_num,point_num,5)
integer(c_int32_t), external :: qmckl_compute_ao_basis_primitive_gaussian_vgl_f integer(c_int32_t), external :: qmckl_compute_ao_basis_primitive_gaussian_vgl_f
info = qmckl_compute_ao_basis_primitive_gaussian_vgl_f & info = qmckl_compute_ao_basis_primitive_gaussian_vgl_f &
(context, & (context, &
prim_num, & prim_num, &
elec_num, & point_num, &
nucl_num, & nucl_num, &
nucleus_prim_index, & nucleus_prim_index, &
elec_coord, & coord, &
nucl_coord, & nucl_coord, &
expo, & expo, &
primitive_vgl) primitive_vgl)
@ -3201,13 +3201,13 @@ qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context)
} }
/* Compute if necessary */ /* Compute if necessary */
if (ctx->electron.coord_new_date > ctx->ao_basis.primitive_vgl_date) { if (ctx->point.date > ctx->ao_basis.primitive_vgl_date) {
/* Allocate array */ /* Allocate array */
if (ctx->ao_basis.primitive_vgl == NULL) { if (ctx->ao_basis.primitive_vgl == NULL) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->ao_basis.prim_num * 5 * ctx->electron.num * mem_info.size = ctx->ao_basis.prim_num * 5 * ctx->point.num *
sizeof(double); sizeof(double);
double* primitive_vgl = (double*) qmckl_malloc(context, mem_info); double* primitive_vgl = (double*) qmckl_malloc(context, mem_info);
@ -3224,11 +3224,11 @@ qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context)
if (ctx->ao_basis.type == 'G') { if (ctx->ao_basis.type == 'G') {
rc = qmckl_compute_ao_basis_primitive_gaussian_vgl(context, rc = qmckl_compute_ao_basis_primitive_gaussian_vgl(context,
ctx->ao_basis.prim_num, ctx->ao_basis.prim_num,
ctx->electron.num, ctx->point.num,
ctx->nucleus.num, ctx->nucleus.num,
ctx->ao_basis.nucleus_prim_index, ctx->ao_basis.nucleus_prim_index,
ctx->electron.coord_new, ctx->point.coord.data,
ctx->nucleus.coord, ctx->nucleus.coord.data,
ctx->ao_basis.exponent, ctx->ao_basis.exponent,
ctx->ao_basis.primitive_vgl); ctx->ao_basis.primitive_vgl);
} else { } else {
@ -3296,7 +3296,7 @@ print ( "[7][4][26] : %e"% lf(a,x,y))
#+begin_src c :tangle (eval c_test) :exports none #+begin_src c :tangle (eval c_test) :exports none
{ {
#define walk_num chbrclf_walk_num #define walk_num 1 // chbrclf_walk_num
#define elec_num chbrclf_elec_num #define elec_num chbrclf_elec_num
#define prim_num chbrclf_prim_num #define prim_num chbrclf_prim_num
@ -3312,15 +3312,15 @@ print ( "[7][4][26] : %e"% lf(a,x,y))
assert(qmckl_electron_provided(context)); assert(qmckl_electron_provided(context));
rc = qmckl_set_electron_coord (context, 'N', elec_coord, walk_num*3*elec_num); rc = qmckl_set_electron_coord (context, 'N', elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
double prim_vgl[5][elec_num][prim_num]; double prim_vgl[5][elec_num*walk_num][prim_num];
rc = qmckl_get_ao_basis_primitive_vgl(context, &(prim_vgl[0][0][0]), rc = qmckl_get_ao_basis_primitive_vgl(context, &(prim_vgl[0][0][0]),
(int64_t) 5*elec_num*prim_num ); (int64_t) 5*elec_num*walk_num*prim_num );
assert (rc == QMCKL_SUCCESS); assert (rc == QMCKL_SUCCESS);
assert( fabs(prim_vgl[0][26][7] - ( 1.0501570432064878E-003)) < 1.e-14 ); assert( fabs(prim_vgl[0][26][7] - ( 1.0501570432064878E-003)) < 1.e-14 );
@ -3341,10 +3341,10 @@ print ( "[7][4][26] : %e"% lf(a,x,y))
// l : primitives // l : primitives
k=0; k=0;
for (j=0 ; j<elec_num ; ++j) { for (j=0 ; j<point_num ; ++j) {
for (i=0 ; i<nucl_num ; ++i) { for (i=0 ; i<nucl_num ; ++i) {
r2 = nucl_elec_dist[i][j]; r2 = nucl_point_dist[i][j];
if (r2 < nucl_radius2[i]) { if (r2 < nucl_radius2[i]) {
@ -3373,21 +3373,21 @@ for (j=0 ; j<elec_num ; ++j) {
#+NAME: qmckl_ao_basis_shell_gaussian_vgl_args #+NAME: qmckl_ao_basis_shell_gaussian_vgl_args
| Variable | Type | In/Out | Description | | Variable | Type | In/Out | Description |
|---------------------+----------------------------------+--------+----------------------------------------------| |---------------------+-----------------------------------+--------+----------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state | | ~context~ | ~qmckl_context~ | in | Global state |
| ~prim_num~ | ~int64_t~ | in | Number of primitives | | ~prim_num~ | ~int64_t~ | in | Number of primitives |
| ~shell_num~ | ~int64_t~ | in | Number of shells | | ~shell_num~ | ~int64_t~ | in | Number of shells |
| ~elec_num~ | ~int64_t~ | in | Number of electrons | | ~point_num~ | ~int64_t~ | in | Number of points |
| ~nucl_num~ | ~int64_t~ | in | Number of nuclei | | ~nucl_num~ | ~int64_t~ | in | Number of nuclei |
| ~nucleus_shell_num~ | ~int64_t[nucl_num]~ | in | Number of shells for each nucleus | | ~nucleus_shell_num~ | ~int64_t[nucl_num]~ | in | Number of shells for each nucleus |
| ~nucleus_index~ | ~int64_t[nucl_num]~ | in | Index of the 1st shell of each nucleus | | ~nucleus_index~ | ~int64_t[nucl_num]~ | in | Index of the 1st shell of each nucleus |
| ~shell_prim_index~ | ~int64_t[shell_num]~ | in | Index of the 1st primitive of each shell | | ~shell_prim_index~ | ~int64_t[shell_num]~ | in | Index of the 1st primitive of each shell |
| ~shell_prim_num~ | ~int64_t[shell_num]~ | in | Number of primitives per shell | | ~shell_prim_num~ | ~int64_t[shell_num]~ | in | Number of primitives per shell |
| ~elec_coord~ | ~double[3][elec_num]~ | in | Electron coordinates | | ~coord~ | ~double[3][point_num]~ | in | Coordinates |
| ~nucl_coord~ | ~double[3][elec_num]~ | in | Nuclear coordinates | | ~nucl_coord~ | ~double[3][nucl_num]~ | in | Nuclear coordinates |
| ~expo~ | ~double[prim_num]~ | in | Exponents of the primitives | | ~expo~ | ~double[prim_num]~ | in | Exponents of the primitives |
| ~coef_normalized~ | ~double[prim_num]~ | in | Coefficients of the primitives | | ~coef_normalized~ | ~double[prim_num]~ | in | Coefficients of the primitives |
| ~shell_vgl~ | ~double[5][elec_num][shell_num]~ | out | Value, gradients and Laplacian of the shells | | ~shell_vgl~ | ~double[5][point_num][shell_num]~ | out | Value, gradients and Laplacian of the shells |
#+CALL: generate_c_header(table=qmckl_ao_basis_shell_gaussian_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_basis_shell_gaussian_vgl")) #+CALL: generate_c_header(table=qmckl_ao_basis_shell_gaussian_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_basis_shell_gaussian_vgl"))
@ -3397,13 +3397,13 @@ for (j=0 ; j<elec_num ; ++j) {
const qmckl_context context, const qmckl_context context,
const int64_t prim_num, const int64_t prim_num,
const int64_t shell_num, const int64_t shell_num,
const int64_t elec_num, const int64_t point_num,
const int64_t nucl_num, const int64_t nucl_num,
const int64_t* nucleus_shell_num, const int64_t* nucleus_shell_num,
const int64_t* nucleus_index, const int64_t* nucleus_index,
const int64_t* shell_prim_index, const int64_t* shell_prim_index,
const int64_t* shell_prim_num, const int64_t* shell_prim_num,
const double* elec_coord, const double* coord,
const double* nucl_coord, const double* nucl_coord,
const double* expo, const double* expo,
const double* coef_normalized, const double* coef_normalized,
@ -3412,9 +3412,9 @@ for (j=0 ; j<elec_num ; ++j) {
#+begin_src f90 :comments org :tangle (eval f) :noweb yes #+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f( & integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f( &
context, prim_num, shell_num, elec_num, nucl_num, & context, prim_num, shell_num, point_num, nucl_num, &
nucleus_shell_num, nucleus_index, shell_prim_index, & nucleus_shell_num, nucleus_index, shell_prim_index, &
shell_prim_num, elec_coord, nucl_coord, expo, & shell_prim_num, coord, nucl_coord, expo, &
coef_normalized, shell_vgl) & coef_normalized, shell_vgl) &
result(info) result(info)
use qmckl use qmckl
@ -3423,18 +3423,18 @@ integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f( &
integer*8 , intent(in) :: prim_num integer*8 , intent(in) :: prim_num
integer*8 , intent(in) :: shell_num integer*8 , intent(in) :: shell_num
integer*8 , intent(in) :: nucl_num integer*8 , intent(in) :: nucl_num
integer*8 , intent(in) :: elec_num integer*8 , intent(in) :: point_num
integer*8 , intent(in) :: nucleus_shell_num(nucl_num) integer*8 , intent(in) :: nucleus_shell_num(nucl_num)
integer*8 , intent(in) :: nucleus_index(nucl_num) integer*8 , intent(in) :: nucleus_index(nucl_num)
integer*8 , intent(in) :: shell_prim_index(shell_num) integer*8 , intent(in) :: shell_prim_index(shell_num)
integer*8 , intent(in) :: shell_prim_num(shell_num) integer*8 , intent(in) :: shell_prim_num(shell_num)
double precision , intent(in) :: elec_coord(elec_num,3) double precision , intent(in) :: coord(point_num,3)
double precision , intent(in) :: nucl_coord(nucl_num,3) double precision , intent(in) :: nucl_coord(nucl_num,3)
double precision , intent(in) :: expo(prim_num) double precision , intent(in) :: expo(prim_num)
double precision , intent(in) :: coef_normalized(prim_num) double precision , intent(in) :: coef_normalized(prim_num)
double precision , intent(out) :: shell_vgl(shell_num,elec_num,5) double precision , intent(out) :: shell_vgl(shell_num,point_num,5)
integer*8 :: inucl, iprim, ielec, ishell integer*8 :: inucl, iprim, ipoint, ishell
integer*8 :: ishell_start, ishell_end integer*8 :: ishell_start, ishell_end
integer*8 :: iprim_start , iprim_end integer*8 :: iprim_start , iprim_end
double precision :: x, y, z, two_a, ar2, r2, v, cutoff double precision :: x, y, z, two_a, ar2, r2, v, cutoff
@ -3451,21 +3451,21 @@ integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f( &
ishell_start = nucleus_index(inucl) + 1 ishell_start = nucleus_index(inucl) + 1
ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl) ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl)
do ielec = 1, elec_num do ipoint = 1, point_num
x = elec_coord(ielec,1) - nucl_coord(inucl,1) x = coord(ipoint,1) - nucl_coord(inucl,1)
y = elec_coord(ielec,2) - nucl_coord(inucl,2) y = coord(ipoint,2) - nucl_coord(inucl,2)
z = elec_coord(ielec,3) - nucl_coord(inucl,3) z = coord(ipoint,3) - nucl_coord(inucl,3)
r2 = x*x + y*y + z*z r2 = x*x + y*y + z*z
do ishell=ishell_start, ishell_end do ishell=ishell_start, ishell_end
shell_vgl(ishell, ielec, 1) = 0.d0 shell_vgl(ishell, ipoint, 1) = 0.d0
shell_vgl(ishell, ielec, 2) = 0.d0 shell_vgl(ishell, ipoint, 2) = 0.d0
shell_vgl(ishell, ielec, 3) = 0.d0 shell_vgl(ishell, ipoint, 3) = 0.d0
shell_vgl(ishell, ielec, 4) = 0.d0 shell_vgl(ishell, ipoint, 4) = 0.d0
shell_vgl(ishell, ielec, 5) = 0.d0 shell_vgl(ishell, ipoint, 5) = 0.d0
iprim_start = shell_prim_index(ishell) + 1 iprim_start = shell_prim_index(ishell) + 1
iprim_end = shell_prim_index(ishell) + shell_prim_num(ishell) iprim_end = shell_prim_index(ishell) + shell_prim_num(ishell)
@ -3480,20 +3480,20 @@ integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f( &
v = coef_normalized(iprim) * dexp(-ar2) v = coef_normalized(iprim) * dexp(-ar2)
two_a = -2.d0 * expo(iprim) * v two_a = -2.d0 * expo(iprim) * v
shell_vgl(ishell, ielec, 1) = & shell_vgl(ishell, ipoint, 1) = &
shell_vgl(ishell, ielec, 1) + v shell_vgl(ishell, ipoint, 1) + v
shell_vgl(ishell, ielec, 2) = & shell_vgl(ishell, ipoint, 2) = &
shell_vgl(ishell, ielec, 2) + two_a * x shell_vgl(ishell, ipoint, 2) + two_a * x
shell_vgl(ishell, ielec, 3) = & shell_vgl(ishell, ipoint, 3) = &
shell_vgl(ishell, ielec, 3) + two_a * y shell_vgl(ishell, ipoint, 3) + two_a * y
shell_vgl(ishell, ielec, 4) = & shell_vgl(ishell, ipoint, 4) = &
shell_vgl(ishell, ielec, 4) + two_a * z shell_vgl(ishell, ipoint, 4) + two_a * z
shell_vgl(ishell, ielec, 5) = & shell_vgl(ishell, ipoint, 5) = &
shell_vgl(ishell, ielec, 5) + two_a * (3.d0 - 2.d0*ar2) shell_vgl(ishell, ipoint, 5) + two_a * (3.d0 - 2.d0*ar2)
end do end do
@ -3513,13 +3513,13 @@ end function qmckl_compute_ao_basis_shell_gaussian_vgl_f
(context, & (context, &
prim_num, & prim_num, &
shell_num, & shell_num, &
elec_num, & point_num, &
nucl_num, & nucl_num, &
nucleus_shell_num, & nucleus_shell_num, &
nucleus_index, & nucleus_index, &
shell_prim_index, & shell_prim_index, &
shell_prim_num, & shell_prim_num, &
elec_coord, & coord, &
nucl_coord, & nucl_coord, &
expo, & expo, &
coef_normalized, & coef_normalized, &
@ -3532,30 +3532,30 @@ end function qmckl_compute_ao_basis_shell_gaussian_vgl_f
integer (c_int64_t) , intent(in) , value :: context integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: prim_num integer (c_int64_t) , intent(in) , value :: prim_num
integer (c_int64_t) , intent(in) , value :: shell_num integer (c_int64_t) , intent(in) , value :: shell_num
integer (c_int64_t) , intent(in) , value :: elec_num integer (c_int64_t) , intent(in) , value :: point_num
integer (c_int64_t) , intent(in) , value :: nucl_num integer (c_int64_t) , intent(in) , value :: nucl_num
integer (c_int64_t) , intent(in) :: nucleus_shell_num(nucl_num) integer (c_int64_t) , intent(in) :: nucleus_shell_num(nucl_num)
integer (c_int64_t) , intent(in) :: nucleus_index(nucl_num) integer (c_int64_t) , intent(in) :: nucleus_index(nucl_num)
integer (c_int64_t) , intent(in) :: shell_prim_index(shell_num) integer (c_int64_t) , intent(in) :: shell_prim_index(shell_num)
integer (c_int64_t) , intent(in) :: shell_prim_num(shell_num) integer (c_int64_t) , intent(in) :: shell_prim_num(shell_num)
real (c_double ) , intent(in) :: elec_coord(elec_num,3) real (c_double ) , intent(in) :: coord(point_num,3)
real (c_double ) , intent(in) :: nucl_coord(elec_num,3) real (c_double ) , intent(in) :: nucl_coord(nucl_num,3)
real (c_double ) , intent(in) :: expo(prim_num) real (c_double ) , intent(in) :: expo(prim_num)
real (c_double ) , intent(in) :: coef_normalized(prim_num) real (c_double ) , intent(in) :: coef_normalized(prim_num)
real (c_double ) , intent(out) :: shell_vgl(shell_num,elec_num,5) real (c_double ) , intent(out) :: shell_vgl(shell_num,point_num,5)
integer(c_int32_t), external :: qmckl_compute_ao_basis_shell_gaussian_vgl_f integer(c_int32_t), external :: qmckl_compute_ao_basis_shell_gaussian_vgl_f
info = qmckl_compute_ao_basis_shell_gaussian_vgl_f & info = qmckl_compute_ao_basis_shell_gaussian_vgl_f &
(context, & (context, &
prim_num, & prim_num, &
shell_num, & shell_num, &
elec_num, & point_num, &
nucl_num, & nucl_num, &
nucleus_shell_num, & nucleus_shell_num, &
nucleus_index, & nucleus_index, &
shell_prim_index, & shell_prim_index, &
shell_prim_num, & shell_prim_num, &
elec_coord, & coord, &
nucl_coord, & nucl_coord, &
expo, & expo, &
coef_normalized, & coef_normalized, &
@ -3591,21 +3591,14 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context)
NULL); NULL);
} }
if(!(ctx->electron.provided)) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_electron",
NULL);
}
/* Compute if necessary */ /* Compute if necessary */
if (ctx->electron.coord_new_date > ctx->ao_basis.shell_vgl_date) { if (ctx->point.date > ctx->ao_basis.shell_vgl_date) {
/* Allocate array */ /* Allocate array */
if (ctx->ao_basis.shell_vgl == NULL) { if (ctx->ao_basis.shell_vgl == NULL) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->ao_basis.shell_num * 5 * ctx->electron.num * sizeof(double); mem_info.size = ctx->ao_basis.shell_num * 5 * ctx->point.num * sizeof(double);
double* shell_vgl = (double*) qmckl_malloc(context, mem_info); double* shell_vgl = (double*) qmckl_malloc(context, mem_info);
if (shell_vgl == NULL) { if (shell_vgl == NULL) {
@ -3622,14 +3615,14 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context)
rc = qmckl_compute_ao_basis_shell_gaussian_vgl(context, rc = qmckl_compute_ao_basis_shell_gaussian_vgl(context,
ctx->ao_basis.prim_num, ctx->ao_basis.prim_num,
ctx->ao_basis.shell_num, ctx->ao_basis.shell_num,
ctx->electron.num, ctx->point.num,
ctx->nucleus.num, ctx->nucleus.num,
ctx->ao_basis.nucleus_shell_num, ctx->ao_basis.nucleus_shell_num,
ctx->ao_basis.nucleus_index, ctx->ao_basis.nucleus_index,
ctx->ao_basis.shell_prim_index, ctx->ao_basis.shell_prim_index,
ctx->ao_basis.shell_prim_num, ctx->ao_basis.shell_prim_num,
ctx->electron.coord_new, ctx->point.coord.data,
ctx->nucleus.coord, ctx->nucleus.coord.data,
ctx->ao_basis.exponent, ctx->ao_basis.exponent,
ctx->ao_basis.coefficient_normalized, ctx->ao_basis.coefficient_normalized,
ctx->ao_basis.shell_vgl); ctx->ao_basis.shell_vgl);
@ -3680,7 +3673,7 @@ elec_15_w2 = np.array( [ -2.20180344582,-1.9113150239, 2.2193744778600002 ] )
nucl_1 = np.array( [ 1.096243353458458e+00, 8.907054016973815e-01, 7.777092280258892e-01 ] ) nucl_1 = np.array( [ 1.096243353458458e+00, 8.907054016973815e-01, 7.777092280258892e-01 ] )
nucl_2 = np.array( [ 1.168459237342663e+00, 1.125660720053393e+00, 2.833370314829343e+00 ] ) nucl_2 = np.array( [ 1.168459237342663e+00, 1.125660720053393e+00, 2.833370314829343e+00 ] )
#double prim_vgl[prim_num][5][elec_num]; #double prim_vgl[prim_num][5][point_num];
x = elec_26_w1 ; y = nucl_1 x = elec_26_w1 ; y = nucl_1
a = [( 8.236000E+03, -1.130000E-04 * 6.1616545431994848e+02 ), a = [( 8.236000E+03, -1.130000E-04 * 6.1616545431994848e+02 ),
( 1.235000E+03, -8.780000E-04 * 1.4847738511079908e+02 ), ( 1.235000E+03, -8.780000E-04 * 1.4847738511079908e+02 ),
@ -3710,7 +3703,7 @@ print ( "[1][4][26] : %25.15e"% lf(a,x,y))
#+begin_src c :tangle (eval c_test) :exports none #+begin_src c :tangle (eval c_test) :exports none
{ {
#define walk_num chbrclf_walk_num #define walk_num 1 // chbrclf_walk_num
#define elec_num chbrclf_elec_num #define elec_num chbrclf_elec_num
#define shell_num chbrclf_shell_num #define shell_num chbrclf_shell_num
@ -3726,7 +3719,7 @@ print ( "[1][4][26] : %25.15e"% lf(a,x,y))
assert(qmckl_electron_provided(context)); assert(qmckl_electron_provided(context));
rc = qmckl_set_electron_coord (context, 'N', elec_coord, walk_num*3*elec_num); rc = qmckl_set_electron_coord (context, 'N', elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
@ -4341,13 +4334,13 @@ end function test_qmckl_ao_polynomial_vgl
#+NAME: qmckl_ao_vgl_args #+NAME: qmckl_ao_vgl_args
| Variable | Type | In/Out | Description | | Variable | Type | In/Out | Description |
|-----------------------+----------------------------------+--------+----------------------------------------------| |-----------------------+-----------------------------------+--------+----------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state | | ~context~ | ~qmckl_context~ | in | Global state |
| ~ao_num~ | ~int64_t~ | in | Number of AOs | | ~ao_num~ | ~int64_t~ | in | Number of AOs |
| ~shell_num~ | ~int64_t~ | in | Number of shells | | ~shell_num~ | ~int64_t~ | in | Number of shells |
| ~elec_num~ | ~int64_t~ | in | Number of electrons | | ~point_num~ | ~int64_t~ | in | Number of points |
| ~nucl_num~ | ~int64_t~ | in | Number of nuclei | | ~nucl_num~ | ~int64_t~ | in | Number of nuclei |
| ~elec_coord~ | ~double[3][elec_num]~ | in | Electron coordinates | | ~coord~ | ~double[3][point_num]~ | in | Coordinates |
| ~nucl_coord~ | ~double[3][nucl_num]~ | in | Nuclear coordinates | | ~nucl_coord~ | ~double[3][nucl_num]~ | in | Nuclear coordinates |
| ~nucleus_index~ | ~int64_t[nucl_num]~ | in | Index of the 1st shell of each nucleus | | ~nucleus_index~ | ~int64_t[nucl_num]~ | in | Index of the 1st shell of each nucleus |
| ~nucleus_shell_num~ | ~int64_t[nucl_num]~ | in | Number of shells per nucleus | | ~nucleus_shell_num~ | ~int64_t[nucl_num]~ | in | Number of shells per nucleus |
@ -4355,13 +4348,13 @@ end function test_qmckl_ao_polynomial_vgl
| ~nucleus_max_ang_mom~ | ~int32_t[nucl_num]~ | in | Maximum angular momentum per nucleus | | ~nucleus_max_ang_mom~ | ~int32_t[nucl_num]~ | in | Maximum angular momentum per nucleus |
| ~shell_ang_mom~ | ~int32_t[shell_num]~ | in | Angular momentum of each shell | | ~shell_ang_mom~ | ~int32_t[shell_num]~ | in | Angular momentum of each shell |
| ~ao_factor~ | ~double[ao_num]~ | in | Normalization factor of the AOs | | ~ao_factor~ | ~double[ao_num]~ | in | Normalization factor of the AOs |
| ~shell_vgl~ | ~double[5][elec_num][shell_num]~ | in | Value, gradients and Laplacian of the shells | | ~shell_vgl~ | ~double[5][point_num][shell_num]~ | in | Value, gradients and Laplacian of the shells |
| ~ao_vgl~ | ~double[5][elec_num][ao_num]~ | out | Value, gradients and Laplacian of the AOs | | ~ao_vgl~ | ~double[5][point_num][ao_num]~ | out | Value, gradients and Laplacian of the AOs |
#+begin_src f90 :comments org :tangle (eval f) :noweb yes #+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer function qmckl_compute_ao_vgl_f(context, & integer function qmckl_compute_ao_vgl_f(context, &
ao_num, shell_num, elec_num, nucl_num, & ao_num, shell_num, point_num, nucl_num, &
elec_coord, nucl_coord, nucleus_index, nucleus_shell_num, & coord, nucl_coord, nucleus_index, nucleus_shell_num, &
nucleus_range, nucleus_max_ang_mom, shell_ang_mom, & nucleus_range, nucleus_max_ang_mom, shell_ang_mom, &
ao_factor, shell_vgl, ao_vgl) & ao_factor, shell_vgl, ao_vgl) &
result(info) result(info)
@ -4370,9 +4363,9 @@ integer function qmckl_compute_ao_vgl_f(context, &
integer(qmckl_context), intent(in) :: context integer(qmckl_context), intent(in) :: context
integer*8 , intent(in) :: ao_num integer*8 , intent(in) :: ao_num
integer*8 , intent(in) :: shell_num integer*8 , intent(in) :: shell_num
integer*8 , intent(in) :: elec_num integer*8 , intent(in) :: point_num
integer*8 , intent(in) :: nucl_num integer*8 , intent(in) :: nucl_num
double precision , intent(in) :: elec_coord(elec_num,3) double precision , intent(in) :: coord(point_num,3)
double precision , intent(in) :: nucl_coord(nucl_num,3) double precision , intent(in) :: nucl_coord(nucl_num,3)
integer*8 , intent(in) :: nucleus_index(nucl_num) integer*8 , intent(in) :: nucleus_index(nucl_num)
integer*8 , intent(in) :: nucleus_shell_num(nucl_num) integer*8 , intent(in) :: nucleus_shell_num(nucl_num)
@ -4380,13 +4373,13 @@ integer function qmckl_compute_ao_vgl_f(context, &
integer , intent(in) :: nucleus_max_ang_mom(nucl_num) integer , intent(in) :: nucleus_max_ang_mom(nucl_num)
integer , intent(in) :: shell_ang_mom(shell_num) integer , intent(in) :: shell_ang_mom(shell_num)
double precision , intent(in) :: ao_factor(ao_num) double precision , intent(in) :: ao_factor(ao_num)
double precision , intent(in) :: shell_vgl(shell_num,elec_num,5) double precision , intent(in) :: shell_vgl(shell_num,point_num,5)
double precision , intent(out) :: ao_vgl(ao_num,elec_num,5) double precision , intent(out) :: ao_vgl(ao_num,point_num,5)
double precision :: e_coord(3), n_coord(3) double precision :: e_coord(3), n_coord(3)
integer*8 :: n_poly integer*8 :: n_poly
integer :: l, il, k integer :: l, il, k
integer*8 :: ielec, inucl, ishell integer*8 :: ipoint, inucl, ishell
integer*8 :: ishell_start, ishell_end integer*8 :: ishell_start, ishell_end
integer :: lstart(0:20) integer :: lstart(0:20)
double precision :: x, y, z, r2 double precision :: x, y, z, r2
@ -4409,17 +4402,17 @@ integer function qmckl_compute_ao_vgl_f(context, &
! TODO : Use numerical precision here ! TODO : Use numerical precision here
cutoff = -dlog(1.d-15) cutoff = -dlog(1.d-15)
do ielec = 1, elec_num do ipoint = 1, point_num
e_coord(1) = elec_coord(ielec,1) e_coord(1) = coord(ipoint,1)
e_coord(2) = elec_coord(ielec,2) e_coord(2) = coord(ipoint,2)
e_coord(3) = elec_coord(ielec,3) e_coord(3) = coord(ipoint,3)
k=1 k=1
do inucl=1,nucl_num do inucl=1,nucl_num
n_coord(1) = nucl_coord(inucl,1) n_coord(1) = nucl_coord(inucl,1)
n_coord(2) = nucl_coord(inucl,2) n_coord(2) = nucl_coord(inucl,2)
n_coord(3) = nucl_coord(inucl,3) n_coord(3) = nucl_coord(inucl,3)
! Test if the electron is in the range of the nucleus ! Test if the point is in the range of the nucleus
x = e_coord(1) - n_coord(1) x = e_coord(1) - n_coord(1)
y = e_coord(2) - n_coord(2) y = e_coord(2) - n_coord(2)
z = e_coord(3) - n_coord(3) z = e_coord(3) - n_coord(3)
@ -4442,35 +4435,35 @@ integer function qmckl_compute_ao_vgl_f(context, &
l = shell_ang_mom(ishell) l = shell_ang_mom(ishell)
do il = lstart(l), lstart(l+1)-1 do il = lstart(l), lstart(l+1)-1
! Value ! Value
ao_vgl(k,ielec,1) = & ao_vgl(k,ipoint,1) = &
poly_vgl(1,il) * shell_vgl(ishell,ielec,1) * ao_factor(k) poly_vgl(1,il) * shell_vgl(ishell,ipoint,1) * ao_factor(k)
! Grad_x ! Grad_x
ao_vgl(k,ielec,2) = ( & ao_vgl(k,ipoint,2) = ( &
poly_vgl(2,il) * shell_vgl(ishell,ielec,1) + & poly_vgl(2,il) * shell_vgl(ishell,ipoint,1) + &
poly_vgl(1,il) * shell_vgl(ishell,ielec,2) & poly_vgl(1,il) * shell_vgl(ishell,ipoint,2) &
) * ao_factor(k) ) * ao_factor(k)
! Grad_y ! Grad_y
ao_vgl(k,ielec,3) = ( & ao_vgl(k,ipoint,3) = ( &
poly_vgl(3,il) * shell_vgl(ishell,ielec,1) + & poly_vgl(3,il) * shell_vgl(ishell,ipoint,1) + &
poly_vgl(1,il) * shell_vgl(ishell,ielec,3) & poly_vgl(1,il) * shell_vgl(ishell,ipoint,3) &
) * ao_factor(k) ) * ao_factor(k)
! Grad_z ! Grad_z
ao_vgl(k,ielec,4) = ( & ao_vgl(k,ipoint,4) = ( &
poly_vgl(4,il) * shell_vgl(ishell,ielec,1) + & poly_vgl(4,il) * shell_vgl(ishell,ipoint,1) + &
poly_vgl(1,il) * shell_vgl(ishell,ielec,4) & poly_vgl(1,il) * shell_vgl(ishell,ipoint,4) &
) * ao_factor(k) ) * ao_factor(k)
! Lapl_z ! Lapl_z
ao_vgl(k,ielec,5) = ( & ao_vgl(k,ipoint,5) = ( &
poly_vgl(5,il) * shell_vgl(ishell,ielec,1) + & poly_vgl(5,il) * shell_vgl(ishell,ipoint,1) + &
poly_vgl(1,il) * shell_vgl(ishell,ielec,5) + & poly_vgl(1,il) * shell_vgl(ishell,ipoint,5) + &
2.d0 * ( & 2.d0 * ( &
poly_vgl(2,il) * shell_vgl(ishell,ielec,2) + & poly_vgl(2,il) * shell_vgl(ishell,ipoint,2) + &
poly_vgl(3,il) * shell_vgl(ishell,ielec,3) + & poly_vgl(3,il) * shell_vgl(ishell,ipoint,3) + &
poly_vgl(4,il) * shell_vgl(ishell,ielec,4) ) & poly_vgl(4,il) * shell_vgl(ishell,ipoint,4) ) &
) * ao_factor(k) ) * ao_factor(k)
k = k+1 k = k+1
@ -4492,9 +4485,9 @@ end function qmckl_compute_ao_vgl_f
const qmckl_context context, const qmckl_context context,
const int64_t ao_num, const int64_t ao_num,
const int64_t shell_num, const int64_t shell_num,
const int64_t elec_num, const int64_t point_num,
const int64_t nucl_num, const int64_t nucl_num,
const double* elec_coord, const double* coord,
const double* nucl_coord, const double* nucl_coord,
const int64_t* nucleus_index, const int64_t* nucleus_index,
const int64_t* nucleus_shell_num, const int64_t* nucleus_shell_num,
@ -4514,9 +4507,9 @@ end function qmckl_compute_ao_vgl_f
(context, & (context, &
ao_num, & ao_num, &
shell_num, & shell_num, &
elec_num, & point_num, &
nucl_num, & nucl_num, &
elec_coord, & coord, &
nucl_coord, & nucl_coord, &
nucleus_index, & nucleus_index, &
nucleus_shell_num, & nucleus_shell_num, &
@ -4534,9 +4527,9 @@ end function qmckl_compute_ao_vgl_f
integer (c_int64_t) , intent(in) , value :: context integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: ao_num integer (c_int64_t) , intent(in) , value :: ao_num
integer (c_int64_t) , intent(in) , value :: shell_num integer (c_int64_t) , intent(in) , value :: shell_num
integer (c_int64_t) , intent(in) , value :: elec_num integer (c_int64_t) , intent(in) , value :: point_num
integer (c_int64_t) , intent(in) , value :: nucl_num integer (c_int64_t) , intent(in) , value :: nucl_num
real (c_double ) , intent(in) :: elec_coord(elec_num,3) real (c_double ) , intent(in) :: coord(point_num,3)
real (c_double ) , intent(in) :: nucl_coord(nucl_num,3) real (c_double ) , intent(in) :: nucl_coord(nucl_num,3)
integer (c_int64_t) , intent(in) :: nucleus_index(nucl_num) integer (c_int64_t) , intent(in) :: nucleus_index(nucl_num)
integer (c_int64_t) , intent(in) :: nucleus_shell_num(nucl_num) integer (c_int64_t) , intent(in) :: nucleus_shell_num(nucl_num)
@ -4544,17 +4537,17 @@ end function qmckl_compute_ao_vgl_f
integer (c_int32_t) , intent(in) :: nucleus_max_ang_mom(nucl_num) integer (c_int32_t) , intent(in) :: nucleus_max_ang_mom(nucl_num)
integer (c_int32_t) , intent(in) :: shell_ang_mom(shell_num) integer (c_int32_t) , intent(in) :: shell_ang_mom(shell_num)
real (c_double ) , intent(in) :: ao_factor(ao_num) real (c_double ) , intent(in) :: ao_factor(ao_num)
real (c_double ) , intent(in) :: shell_vgl(shell_num,elec_num,5) real (c_double ) , intent(in) :: shell_vgl(shell_num,point_num,5)
real (c_double ) , intent(out) :: ao_vgl(ao_num,elec_num,5) real (c_double ) , intent(out) :: ao_vgl(ao_num,point_num,5)
integer(c_int32_t), external :: qmckl_compute_ao_vgl_f integer(c_int32_t), external :: qmckl_compute_ao_vgl_f
info = qmckl_compute_ao_vgl_f & info = qmckl_compute_ao_vgl_f &
(context, & (context, &
ao_num, & ao_num, &
shell_num, & shell_num, &
elec_num, & point_num, &
nucl_num, & nucl_num, &
elec_coord, & coord, &
nucl_coord, & nucl_coord, &
nucleus_index, & nucleus_index, &
nucleus_shell_num, & nucleus_shell_num, &
@ -4595,15 +4588,8 @@ qmckl_exit_code qmckl_provide_ao_vgl(qmckl_context context)
NULL); NULL);
} }
if(!(ctx->electron.provided)) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_electron",
NULL);
}
/* Compute if necessary */ /* Compute if necessary */
if (ctx->electron.coord_new_date > ctx->ao_basis.ao_vgl_date) { if (ctx->point.date > ctx->ao_basis.ao_vgl_date) {
qmckl_exit_code rc; qmckl_exit_code rc;
@ -4617,7 +4603,7 @@ qmckl_exit_code qmckl_provide_ao_vgl(qmckl_context context)
if (ctx->ao_basis.ao_vgl == NULL) { if (ctx->ao_basis.ao_vgl == NULL) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->ao_basis.ao_num * 5 * ctx->electron.num * sizeof(double); mem_info.size = ctx->ao_basis.ao_num * 5 * ctx->point.num * sizeof(double);
double* ao_vgl = (double*) qmckl_malloc(context, mem_info); double* ao_vgl = (double*) qmckl_malloc(context, mem_info);
if (ao_vgl == NULL) { if (ao_vgl == NULL) {
@ -4632,10 +4618,10 @@ qmckl_exit_code qmckl_provide_ao_vgl(qmckl_context context)
rc = qmckl_compute_ao_vgl(context, rc = qmckl_compute_ao_vgl(context,
ctx->ao_basis.ao_num, ctx->ao_basis.ao_num,
ctx->ao_basis.shell_num, ctx->ao_basis.shell_num,
ctx->electron.num, ctx->point.num,
ctx->nucleus.num, ctx->nucleus.num,
ctx->electron.coord_new, ctx->point.coord.data,
ctx->nucleus.coord, ctx->nucleus.coord.data,
ctx->ao_basis.nucleus_index, ctx->ao_basis.nucleus_index,
ctx->ao_basis.nucleus_shell_num, ctx->ao_basis.nucleus_shell_num,
ctx->ao_basis.nucleus_range, ctx->ao_basis.nucleus_range,
@ -4735,7 +4721,7 @@ print ( "[1][26][224] : %25.15e"%(df(a,x,y,1)* (x[2] - y[2]) * (x[2] - y[2])) )
#+begin_src c :tangle (eval c_test) :exports none #+begin_src c :tangle (eval c_test) :exports none
{ {
#define walk_num chbrclf_walk_num #define walk_num 1 // chbrclf_walk_num
#define elec_num chbrclf_elec_num #define elec_num chbrclf_elec_num
#define shell_num chbrclf_shell_num #define shell_num chbrclf_shell_num
#define ao_num chbrclf_ao_num #define ao_num chbrclf_ao_num
@ -4752,7 +4738,7 @@ assert (rc == QMCKL_SUCCESS);
assert(qmckl_electron_provided(context)); assert(qmckl_electron_provided(context));
rc = qmckl_set_electron_coord (context, 'N', elec_coord, walk_num*3*elec_num); rc = qmckl_set_electron_coord (context, 'N', elec_coord, walk_num*elec_num*3);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);

480
org/qmckl_blas.org
View File

@ -38,8 +38,9 @@
#include "qmckl.h" #include "qmckl.h"
#include "qmckl_context_private_type.h" #include "qmckl_context_private_type.h"
#include "qmckl_memory_private_type.h" #include "qmckl_memory_private_type.h"
#include "qmckl_memory_private_func.h"
#include "qmckl_blas_private_type.h" #include "qmckl_blas_private_type.h"
#include "qmckl_memory_private_func.h"
#include "qmckl_blas_private_func.h" #include "qmckl_blas_private_func.h"
#+end_src #+end_src
@ -379,23 +380,18 @@ qmckl_tensor_of_vector(const qmckl_vector vector,
#+begin_src c :comments org :tangle (eval h_private_func) #+begin_src c :comments org :tangle (eval h_private_func)
qmckl_vector qmckl_vector
qmckl_vector_of_matrix(const qmckl_matrix matrix, qmckl_vector_of_matrix(const qmckl_matrix matrix);
const int64_t size);
#+end_src #+end_src
Reshapes a matrix into a vector. Reshapes a matrix into a vector.
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c)
qmckl_vector qmckl_vector
qmckl_vector_of_matrix(const qmckl_matrix matrix, qmckl_vector_of_matrix(const qmckl_matrix matrix)
const int64_t size)
{ {
/* Always true */
assert (matrix.size[0] * matrix.size[1] == size);
qmckl_vector result; qmckl_vector result;
result.size = size; result.size = matrix.size[0] * matrix.size[1];
result.data = matrix.data; result.data = matrix.data;
return result; return result;
@ -438,27 +434,23 @@ qmckl_tensor_of_matrix(const qmckl_matrix matrix,
#+begin_src c :comments org :tangle (eval h_private_func) #+begin_src c :comments org :tangle (eval h_private_func)
qmckl_vector qmckl_vector
qmckl_vector_of_tensor(const qmckl_tensor tensor, qmckl_vector_of_tensor(const qmckl_tensor tensor);
const int64_t size);
#+end_src #+end_src
Reshapes a tensor into a vector. Reshapes a tensor into a vector.
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c)
qmckl_vector qmckl_vector
qmckl_vector_of_tensor(const qmckl_tensor tensor, qmckl_vector_of_tensor(const qmckl_tensor tensor)
const int64_t size)
{ {
/* Always true */ int64_t prod_size = (int64_t) tensor.size[0];
int64_t prod_size = (int64_t) 1; for (int64_t i=1 ; i<tensor.order ; i++) {
for (int64_t i=0 ; i<tensor.order ; i++) {
prod_size *= tensor.size[i]; prod_size *= tensor.size[i];
} }
assert (prod_size == size);
qmckl_vector result; qmckl_vector result;
result.size = size; result.size = prod_size;
result.data = tensor.data; result.data = tensor.data;
return result; return result;
@ -510,6 +502,186 @@ qmckl_matrix_of_tensor(const qmckl_tensor tensor,
#define qmckl_ten5(t, i, j, k, l, m) t.data[(i) + m.size[0]*((j) + size[1]*((k) + size[2]*((l) + size[3]*(m))))] #define qmckl_ten5(t, i, j, k, l, m) t.data[(i) + m.size[0]*((j) + size[1]*((k) + size[2]*((l) + size[3]*(m))))]
#+end_src #+end_src
** Copy to/from to ~double*~
#+begin_src c :comments org :tangle (eval h_private_func)
qmckl_exit_code
qmckl_double_of_vector(const qmckl_context context,
const qmckl_vector vector,
double* const target,
const int64_t size_max);
#+end_src
Converts a vector to a ~double*~.
#+begin_src c :comments org :tangle (eval c)
qmckl_exit_code
qmckl_double_of_vector(const qmckl_context context,
const qmckl_vector vector,
double* const target,
const int64_t size_max)
{
/* Always true by construction */
assert (qmckl_context_check(context) != QMCKL_NULL_CONTEXT);
assert (vector.size > (int64_t) 0);
assert (target != NULL);
assert (size_max > (int64_t) 0);
assert (size_max >= vector.size);
for (int64_t i=0 ; i<vector.size ; ++i) {
target[i] = vector.data[i];
}
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func)
qmckl_exit_code
qmckl_double_of_matrix(const qmckl_context context,
const qmckl_matrix matrix,
double* const target,
const int64_t size_max);
#+end_src
Converts a matrix to a ~double*~.
#+begin_src c :comments org :tangle (eval c)
qmckl_exit_code
qmckl_double_of_matrix(const qmckl_context context,
const qmckl_matrix matrix,
double* const target,
const int64_t size_max)
{
qmckl_vector vector = qmckl_vector_of_matrix(matrix);
return qmckl_double_of_vector(context, vector, target, size_max);
}
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func)
qmckl_exit_code
qmckl_double_of_tensor(const qmckl_context context,
const qmckl_tensor tensor,
double* const target,
const int64_t size_max);
#+end_src
Converts a tensor to a ~double*~.
#+begin_src c :comments org :tangle (eval c)
qmckl_exit_code
qmckl_double_of_tensor(const qmckl_context context,
const qmckl_tensor tensor,
double* const target,
const int64_t size_max)
{
qmckl_vector vector = qmckl_vector_of_tensor(tensor);
return qmckl_double_of_vector(context, vector, target, size_max);
}
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func)
qmckl_exit_code
qmckl_vector_of_double(const qmckl_context context,
const double* target,
const int64_t size_max,
qmckl_vector* vector);
#+end_src
Converts a ~double*~ to a vector.
#+begin_src c :comments org :tangle (eval c)
qmckl_exit_code
qmckl_vector_of_double(const qmckl_context context,
const double* target,
const int64_t size_max,
qmckl_vector* vector_out)
{
qmckl_vector vector = *vector_out;
/* Always true by construction */
assert (qmckl_context_check(context) != QMCKL_NULL_CONTEXT);
if (vector.size == 0) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_4,
"qmckl_double_of_vector",
"Vector not allocated");
}
if (vector.size != size_max) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_4,
"qmckl_double_of_vector",
"Wrong vector size");
}
for (int64_t i=0 ; i<vector.size ; ++i) {
vector.data[i] = target[i];
}
*vector_out = vector;
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func)
qmckl_exit_code
qmckl_matrix_of_double(const qmckl_context context,
const double* target,
const int64_t size_max,
qmckl_matrix* matrix);
#+end_src
Converts a matrix to a ~double*~.
#+begin_src c :comments org :tangle (eval c)
qmckl_exit_code
qmckl_matrix_of_double(const qmckl_context context,
const double* target,
const int64_t size_max,
qmckl_matrix* matrix)
{
qmckl_vector vector = qmckl_vector_of_matrix(*matrix);
qmckl_exit_code rc =
qmckl_vector_of_double(context, target, size_max, &vector);
,*matrix = qmckl_matrix_of_vector(vector, matrix->size[0], matrix->size[1]);
return rc;
}
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func)
qmckl_exit_code
qmckl_tensor_of_double(const qmckl_context context,
const double* target,
const int64_t size_max,
qmckl_tensor* tensor);
#+end_src
Converts a matrix to a ~double*~.
#+begin_src c :comments org :tangle (eval c)
qmckl_exit_code
qmckl_tensor_of_double(const qmckl_context context,
const double* target,
const int64_t size_max,
qmckl_tensor* tensor)
{
qmckl_vector vector = qmckl_vector_of_tensor(*tensor);
qmckl_exit_code rc =
qmckl_vector_of_double(context, target, size_max, &vector);
*tensor = qmckl_tensor_of_vector(vector, tensor->order, tensor->size);
return rc;
}
#+end_src
** Tests ** Tests
#+begin_src c :comments link :tangle (eval c_test) #+begin_src c :comments link :tangle (eval c_test)
@ -534,7 +706,7 @@ qmckl_matrix_of_tensor(const qmckl_tensor tensor,
for (int64_t i=0 ; i<m ; ++i) for (int64_t i=0 ; i<m ; ++i)
assert ( qmckl_mat(mat, i, j) == qmckl_vec(vec, i+j*m)) ; assert ( qmckl_mat(mat, i, j) == qmckl_vec(vec, i+j*m)) ;
qmckl_vector vec2 = qmckl_vector_of_matrix(mat, p); qmckl_vector vec2 = qmckl_vector_of_matrix(mat);
assert (vec2.size == p); assert (vec2.size == p);
assert (vec2.data == vec.data); assert (vec2.data == vec.data);
for (int64_t i=0 ; i<p ; ++i) for (int64_t i=0 ; i<p ; ++i)
@ -565,14 +737,14 @@ qmckl_matrix_of_tensor(const qmckl_tensor tensor,
| ~m~ | ~int64_t~ | in | Number of rows of the input matrix | | ~m~ | ~int64_t~ | in | Number of rows of the input matrix |
| ~n~ | ~int64_t~ | in | Number of columns of the input matrix | | ~n~ | ~int64_t~ | in | Number of columns of the input matrix |
| ~k~ | ~int64_t~ | in | Number of columns of the input matrix | | ~k~ | ~int64_t~ | in | Number of columns of the input matrix |
| ~alpha~ | ~double~ | in | Number of columns of the input matrix | | ~alpha~ | ~double~ | in | \alpha |
| ~A~ | ~double[][lda]~ | in | Array containing the matrix $A$ | | ~A~ | ~double[][lda]~ | in | Array containing the matrix $A$ |
| ~lda~ | ~int64_t~ | in | Leading dimension of array ~A~ | | ~lda~ | ~int64_t~ | in | Leading dimension of array ~A~ |
| ~B~ | ~double[][ldb]~ | in | Array containing the matrix $B$ | | ~B~ | ~double[][ldb]~ | in | Array containing the matrix $B$ |
| ~ldb~ | ~int64_t~ | in | Leading dimension of array ~B~ | | ~ldb~ | ~int64_t~ | in | Leading dimension of array ~B~ |
| ~beta~ | ~double~ | in | Array containing the matrix $B$ | | ~beta~ | ~double~ | in | \beta |
| ~C~ | ~double[][ldc]~ | out | Array containing the matrix $B$ | | ~C~ | ~double[][ldc]~ | out | Array containing the matrix $C$ |
| ~ldc~ | ~int64_t~ | in | Leading dimension of array ~B~ | | ~ldc~ | ~int64_t~ | in | Leading dimension of array ~C~ |
Requirements: Requirements:
@ -808,6 +980,184 @@ qmckl_exit_code test_qmckl_dgemm(qmckl_context context);
assert(QMCKL_SUCCESS == test_qmckl_dgemm(context)); assert(QMCKL_SUCCESS == test_qmckl_dgemm(context));
#+end_src #+end_src
** ~qmckl_matmul~
Matrix multiplication:
\[
C_{ij} = \beta C_{ij} + \alpha \sum_{k} A_{ik} \cdot B_{kj}
\]
# TODO: Add description about the external library dependence.
#+NAME: qmckl_matmul_args
| Variable | Type | In/Out | Description |
|-----------+-----------------+--------+-------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~TransA~ | ~char~ | in | 'T' is transposed |
| ~TransB~ | ~char~ | in | 'T' is transposed |
| ~alpha~ | ~double~ | in | \alpha |
| ~A~ | ~qmckl_matrix~ | in | Matrix $A$ |
| ~B~ | ~qmckl_matrix~ | in | Matrix $B$ |
| ~beta~ | ~double~ | in | \beta |
| ~C~ | ~qmckl_matrix~ | out | Matrix $C$ |
#+CALL: generate_c_header(table=qmckl_matmul_args,rettyp="qmckl_exit_code",fname="qmckl_matmul")
#+RESULTS:
#+begin_src c :tangle (eval h_private_func) :comments org
qmckl_exit_code
qmckl_matmul (const qmckl_context context,
const char TransA,
const char TransB,
const double alpha,
const qmckl_matrix A,
const qmckl_matrix B,
const double beta,
qmckl_matrix* const C );
#+end_src
#+begin_src c :tangle (eval c) :comments org
qmckl_exit_code
qmckl_matmul (const qmckl_context context,
const char TransA,
const char TransB,
const double alpha,
const qmckl_matrix A,
const qmckl_matrix B,
const double beta,
qmckl_matrix* const C )
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_INVALID_CONTEXT;
}
qmckl_exit_code rc = QMCKL_SUCCESS;
if (TransA != 'N' && TransA != 'T') {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_matmul",
"TransA should be 'N' or 'T'");
}
if (TransB != 'N' && TransB != 'T') {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_matmul",
"TransB should be 'N' or 'T'");
}
if (A.size[0] < 1) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_5,
"qmckl_matmul",
"Invalid size for A");
}
if (B.size[0] < 1) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_6,
"qmckl_matmul",
"Invalid size for B");
}
if (C == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_8,
"qmckl_matmul",
"Null pointer");
}
int t = 0;
if (TransA == 'T') t +=1;
if (TransB == 'T') t +=2;
/*
| t | TransA | TransB |
+---+--------+--------+
| 0 | N | N |
| 1 | T | N |
| 2 | N | T |
| 3 | T | T |
,*/
switch (t) {
case 0:
if (A.size[1] != B.size[0]) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_matmul",
"A and B have incompatible dimensions");
}
C->size[0] = A.size[0];
C->size[1] = B.size[1];
rc = qmckl_dgemm (context, 'N', 'N',
C->size[0], C->size[1], A.size[1],
alpha,
A.data, A.size[0],
B.data, B.size[0],
beta,
C->data, C->size[0]);
break;
case 1:
if (A.size[0] != B.size[0]) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_matmul",
"A and B have incompatible dimensions");
}
C->size[0] = A.size[1];
C->size[1] = B.size[1];
rc = qmckl_dgemm (context, 'T', 'N',
C->size[0], C->size[1], A.size[0],
alpha,
A.data, A.size[0],
B.data, B.size[0],
beta,
C->data, C->size[0]);
break;
case 2:
if (A.size[1] != B.size[1]) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_matmul",
"A and B have incompatible dimensions");
}
C->size[0] = A.size[0];
C->size[1] = B.size[0];
rc = qmckl_dgemm (context, 'N', 'T',
C->size[0], C->size[1], A.size[1],
alpha,
A.data, A.size[0],
B.data, B.size[0],
beta,
C->data, C->size[0]);
break;
case 3:
if (A.size[0] != B.size[1]) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_matmul",
"A and B have incompatible dimensions");
}
C->size[0] = A.size[1];
C->size[1] = B.size[0];
rc = qmckl_dgemm (context, 'T', 'T',
C->size[0], C->size[1], A.size[0],
alpha,
A.data, A.size[0],
B.data, B.size[0],
beta,
C->data, C->size[0]);
break;
}
return rc;
}
#+end_src
*** TODO Test :noexport:
** ~qmckl_adjugate~ ** ~qmckl_adjugate~
Given a matrix $\mathbf{A}$, the adjugate matrix Given a matrix $\mathbf{A}$, the adjugate matrix
@ -1693,6 +2043,90 @@ qmckl_exit_code test_qmckl_adjugate(qmckl_context context);
assert(QMCKL_SUCCESS == test_qmckl_adjugate(context)); assert(QMCKL_SUCCESS == test_qmckl_adjugate(context));
#+end_src #+end_src
** ~qmckl_transpose~
Transposes a matrix: $A^\dagger_{ji} = A_{ij}$.
| Variable | Type | In/Out | Description |
|----------+---------------+--------+-------------------|
| context | qmckl_context | in | Global state |
| A | qmckl_matrix | in | Input matrix |
| At | qmckl_matrix | out | Transposed matrix |
#+begin_src c :tangle (eval h_private_func) :comments org
qmckl_exit_code
qmckl_transpose (qmckl_context context,
const qmckl_matrix A,
qmckl_matrix At );
#+end_src
#+begin_src c :tangle (eval c) :comments org
qmckl_exit_code
qmckl_transpose (qmckl_context context,
const qmckl_matrix A,
qmckl_matrix At )
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_INVALID_CONTEXT;
}
if (A.size[0] < 1) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_transpose",
"Invalid size for A");
}
if (At.data == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_transpose",
"Output matrix not allocated");
}
if (At.size[0] != A.size[1] || At.size[1] != A.size[0]) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_transpose",
"Invalid size for At");
}
for (int64_t j=0 ; j<At.size[1] ; ++j)
for (int64_t i=0 ; i<At.size[0] ; ++i)
qmckl_mat(At, i, j) = qmckl_mat(A, j, i);
return QMCKL_SUCCESS;
}
#+end_src
*** Test
#+begin_src c :comments link :tangle (eval c_test)
{
qmckl_matrix A;
qmckl_matrix At;
A = qmckl_matrix_alloc(context, 2, 3);
At = qmckl_matrix_alloc(context, 3, 2);
for (int j=0 ; j<3 ; ++j)
for (int i=0 ; i<2 ; ++i)
qmckl_mat(A, i, j) = (double) 10*i+j;
qmckl_exit_code rc = qmckl_transpose(context, A, At);
assert(rc == QMCKL_SUCCESS);
assert(A.size[0] == At.size[1]);
assert(A.size[1] == At.size[0]);
for (int j=0 ; j<3 ; ++j)
for (int i=0 ; i<2 ; ++i)
assert (qmckl_mat(A, i, j) == qmckl_mat(At, j, i));
qmckl_matrix_free(context, A);
qmckl_matrix_free(context, At);
}
#+end_src
* End of files :noexport: * End of files :noexport:

2
org/qmckl_context.org
View File

@ -124,7 +124,7 @@ typedef struct qmckl_context_struct {
uint64_t date; uint64_t date;
/* Points */ /* Points */
qmckl_point_struct *point; qmckl_point_struct point;
/* -- Molecular system -- */ /* -- Molecular system -- */
qmckl_nucleus_struct nucleus; qmckl_nucleus_struct nucleus;

4
org/qmckl_determinant.org
View File

@ -1160,10 +1160,10 @@ assert(rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_num (context, nucl_num); rc = qmckl_set_nucleus_num (context, nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0])); rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0]), nucl_num*3);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_charge(context, nucl_charge); rc = qmckl_set_nucleus_charge(context, nucl_charge, nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
assert(qmckl_nucleus_provided(context)); assert(qmckl_nucleus_provided(context));

233
org/qmckl_electron.org
View File

@ -26,6 +26,7 @@ up-spin and down-spin electrons, and the electron coordinates.
#+begin_src c :tangle (eval c_test) :noweb yes #+begin_src c :tangle (eval c_test) :noweb yes
#include "qmckl.h" #include "qmckl.h"
#include <assert.h> #include <assert.h>
#include <stdio.h>
#include <math.h> #include <math.h>
#ifdef HAVE_CONFIG_H #ifdef HAVE_CONFIG_H
#include "config.h" #include "config.h"
@ -69,7 +70,7 @@ int main() {
The following data stored in the context: The following data stored in the context:
| Variable | Type | Description | | Variable | Type | Description |
|---------------------------+----------------------------+-------------------------------------------| |---------------------------+----------------+---------------------------------------------------------------|
| ~uninitialized~ | ~int32_t~ | Keeps bit set for uninitialized data | | ~uninitialized~ | ~int32_t~ | Keeps bit set for uninitialized data |
| ~num~ | ~int64_t~ | Total number of electrons | | ~num~ | ~int64_t~ | Total number of electrons |
| ~up_num~ | ~int64_t~ | Number of up-spin electrons | | ~up_num~ | ~int64_t~ | Number of up-spin electrons |
@ -78,8 +79,8 @@ int main() {
| ~rescale_factor_kappa_ee~ | ~double~ | The distance scaling factor | | ~rescale_factor_kappa_ee~ | ~double~ | The distance scaling factor |
| ~rescale_factor_kappa_en~ | ~double~ | The distance scaling factor | | ~rescale_factor_kappa_en~ | ~double~ | The distance scaling factor |
| ~provided~ | ~bool~ | If true, ~electron~ is valid | | ~provided~ | ~bool~ | If true, ~electron~ is valid |
| ~coord_new~ | ~double[walk_num][3][num]~ | New set of electron coordinates | | ~coord_new~ | ~qmckl_matrix~ | Current set of electron coordinates. Pointer to ~ctx->points~ |
| ~coord_old~ | ~double[walk_num][3][num]~ | Old set of electron coordinates | | ~coord_old~ | ~qmckl_matrix~ | Old set of electron coordinates |
| ~coord_new_date~ | ~uint64_t~ | Last modification date of the coordinates | | ~coord_new_date~ | ~uint64_t~ | Last modification date of the coordinates |
Computed data: Computed data:
@ -122,8 +123,8 @@ typedef struct qmckl_electron_struct {
int64_t ee_distance_rescaled_deriv_e_date; int64_t ee_distance_rescaled_deriv_e_date;
int64_t en_distance_rescaled_date; int64_t en_distance_rescaled_date;
int64_t en_distance_rescaled_deriv_e_date; int64_t en_distance_rescaled_deriv_e_date;
double* coord_new; qmckl_matrix coord_new;
double* coord_old; qmckl_matrix coord_old;
double* ee_distance; double* ee_distance;
double* en_distance; double* en_distance;
double* ee_pot; double* ee_pot;
@ -398,23 +399,30 @@ qmckl_get_electron_rescale_factor_en (const qmckl_context context, double* const
The order of the indices is: The order of the indices is:
| | Normal | Transposed | | | Normal | Transposed |
|---------+---------------------------+---------------------------| |---------+--------------------------+--------------------------|
| C | ~[walk_num][elec_num][3]~ | ~[walk_num][3][elec_num]~ | | C | ~[walk_num*elec_num][3]~ | ~[3][walk_num*elec_num]~ |
| Fortran | ~(3,elec_num,walk_num)~ | ~(elec_num,3,walk_num)~ | | Fortran | ~(3,walk_num*elec_num)~ | ~(walk_num*elec_num, 3)~ |
#+begin_src c :comments org :tangle (eval h_func) :exports none #+begin_src c :comments org :tangle (eval h_func) :exports none
qmckl_exit_code qmckl_get_electron_coord (const qmckl_context context, const char transp, double* const coord); qmckl_exit_code
qmckl_get_electron_coord (const qmckl_context context,
const char transp,
double* const coord,
const int64_t size_max);
#+end_src #+end_src
As the ~coord_new~ attribute is a pointer equal to ~points~,
returning the current electron coordinates is equivalent to
returning the current points.
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_exit_code
qmckl_get_electron_coord (const qmckl_context context, const char transp, double* const coord) { qmckl_get_electron_coord (const qmckl_context context,
const char transp,
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { double* const coord,
return QMCKL_INVALID_CONTEXT; const int64_t size_max)
} {
if (transp != 'N' && transp != 'T') { if (transp != 'N' && transp != 'T') {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_INVALID_ARG_2, QMCKL_INVALID_ARG_2,
@ -429,42 +437,32 @@ qmckl_get_electron_coord (const qmckl_context context, const char transp, double
"coord is a null pointer"); "coord is a null pointer");
} }
if (size_max <= 0) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_4,
"qmckl_get_electron_coord",
"size_max should be > 0");
}
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_INVALID_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
assert (ctx != NULL); assert (ctx != NULL);
if ( !(ctx->electron.provided) ) { if (!ctx->electron.provided) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_NOT_PROVIDED, QMCKL_NOT_PROVIDED,
"qmckl_get_electron_coord", "qmckl_get_electron_coord",
"electron data is not provided"); NULL);
} }
int64_t elec_num = ctx->electron.num; assert (ctx->point.coord.data == ctx->electron.coord_new.data);
int64_t walk_num = ctx->electron.walk_num; assert (ctx->point.coord.size[0] == ctx->electron.coord_new.size[0]);
assert (ctx->point.coord.size[1] == ctx->electron.coord_new.size[1]);
assert (ctx->electron.coord_new != NULL); return qmckl_get_point(context, transp, coord, size_max);
double* ptr1 = ctx->electron.coord_new;
double* ptr2 = coord;
if (transp == 'N') {
for (int64_t i=0 ; i<walk_num ; ++i) {
qmckl_exit_code rc;
rc = qmckl_transpose(context, elec_num, 3,
ptr1, elec_num, ptr2, 3);
if (rc != QMCKL_SUCCESS) return rc;
ptr1 += elec_num * 3;
ptr2 += elec_num * 3;
}
} else {
memcpy(ptr2, ptr1, 3*elec_num*walk_num*sizeof(double));
}
return QMCKL_SUCCESS;
} }
#+end_src #+end_src
@ -500,20 +498,23 @@ ctx->electron.uninitialized &= ~mask;
ctx->electron.provided = (ctx->electron.uninitialized == 0); ctx->electron.provided = (ctx->electron.uninitialized == 0);
if (ctx->electron.provided) { if (ctx->electron.provided) {
if (ctx->electron.coord_new != NULL) { if (ctx->electron.coord_new.data != NULL) {
qmckl_free(context, ctx->electron.coord_new); const qmckl_exit_code rc = qmckl_matrix_free(context, ctx->electron.coord_new);
ctx->electron.coord_new = NULL; assert (rc == QMCKL_SUCCESS);
} }
if (ctx->electron.coord_old != NULL) { if (ctx->electron.coord_old.data != NULL) {
qmckl_free(context, ctx->electron.coord_old); const qmckl_exit_code rc = qmckl_matrix_free(context, ctx->electron.coord_old);
ctx->electron.coord_old = NULL; assert (rc == QMCKL_SUCCESS);
} }
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; const int64_t walk_num = ctx->electron.walk_num;
mem_info.size = ctx->electron.num * ctx->electron.walk_num * 3 * sizeof(double); const int64_t elec_num = ctx->electron.num;
double* coord_new = (double*) qmckl_malloc(context, mem_info); const int64_t point_num = walk_num * elec_num;
if (coord_new == NULL) {
qmckl_matrix coord_new = qmckl_matrix_alloc(context, point_num, 3);
if (coord_new.data == NULL) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED, QMCKL_ALLOCATION_FAILED,
"qmckl_set_electron_num", "qmckl_set_electron_num",
@ -521,8 +522,9 @@ if (ctx->electron.provided) {
} }
ctx->electron.coord_new = coord_new; ctx->electron.coord_new = coord_new;
double* coord_old = (double*) qmckl_malloc(context, mem_info); qmckl_matrix coord_old = qmckl_matrix_alloc(context, point_num, 3);
if (coord_old == NULL) {
if (coord_old.data == NULL) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED, QMCKL_ALLOCATION_FAILED,
"qmckl_set_electron_num", "qmckl_set_electron_num",
@ -530,6 +532,8 @@ if (ctx->electron.provided) {
} }
ctx->electron.coord_old = coord_old; ctx->electron.coord_old = coord_old;
ctx->point.num = point_num;
ctx->point.coord = coord_new;
} }
return QMCKL_SUCCESS; return QMCKL_SUCCESS;
@ -641,6 +645,7 @@ interface
integer (c_int64_t) , intent(in) , value :: beta integer (c_int64_t) , intent(in) , value :: beta
end function end function
end interface end interface
interface interface
integer(c_int32_t) function qmckl_set_electron_walk_num(context, walk_num) bind(C) integer(c_int32_t) function qmckl_set_electron_walk_num(context, walk_num) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
@ -659,6 +664,9 @@ end interface
overwritten. This can be done only when the data relative to overwritten. This can be done only when the data relative to
electrons have been set. electrons have been set.
~size_max~ should be equal to ~elec_num * walk_num * 3~, to be symmetric
with ~qmckl_get_electron_coord~.
Important: changing the electron coordinates increments the date Important: changing the electron coordinates increments the date
in the context. in the context.
@ -686,10 +694,7 @@ qmckl_set_electron_coord(qmckl_context context,
"coord is a null pointer"); "coord is a null pointer");
} }
int64_t elec_num; const int64_t elec_num = ctx->electron.num;
qmckl_exit_code rc;
rc = qmckl_get_electron_num(context, &elec_num);
if (rc != QMCKL_SUCCESS) return rc;
if (elec_num == 0L) { if (elec_num == 0L) {
return qmckl_failwith( context, return qmckl_failwith( context,
@ -698,9 +703,9 @@ qmckl_set_electron_coord(qmckl_context context,
"elec_num is not set"); "elec_num is not set");
} }
int64_t walk_num; const int64_t walk_num = ctx->electron.walk_num;
rc = qmckl_get_electron_walk_num(context, &walk_num);
if (rc != QMCKL_SUCCESS) return rc; const int64_t point_num = ctx->point.num ;
if (walk_num == 0L) { if (walk_num == 0L) {
return qmckl_failwith( context, return qmckl_failwith( context,
@ -709,41 +714,18 @@ qmckl_set_electron_coord(qmckl_context context,
"walk_num is not set"); "walk_num is not set");
} }
if (size_max < walk_num*3*elec_num) { assert(point_num == elec_num * walk_num);
return qmckl_failwith( context,
QMCKL_INVALID_ARG_4,
"qmckl_set_electron_coord",
"destination array is too small");
}
/* If num and walk_num are set, the arrays should be allocated */
assert (ctx->electron.coord_old != NULL);
assert (ctx->electron.coord_new != NULL);
/* Increment the date of the context */
ctx->date += 1UL;
/* Swap pointers */ /* Swap pointers */
double * swap; ctx->point.coord = ctx->electron.coord_old;
swap = ctx->electron.coord_old;
ctx->electron.coord_old = ctx->electron.coord_new ; ctx->electron.coord_old = ctx->electron.coord_new ;
ctx->electron.coord_new = swap;
double* ptr1 = ctx->electron.coord_new; qmckl_exit_code rc;
if (transp == 'N') { rc = qmckl_set_point(context, transp, coord, size_max/3);
assert (rc == QMCKL_SUCCESS);
for (int64_t i=0 ; i<walk_num ; ++i) { ctx->electron.coord_new = ctx->point.coord ;
rc = qmckl_transpose(context, 3, elec_num,
&(coord[i*3*elec_num]), 3, ptr1, elec_num);
if (rc != QMCKL_SUCCESS) return rc;
ptr1 += elec_num * 3;
}
} else {
memcpy(ptr1, coord, 3*elec_num*walk_num*sizeof(double));
}
ctx->electron.coord_new_date = ctx->date; ctx->electron.coord_new_date = ctx->date;
return QMCKL_SUCCESS; return QMCKL_SUCCESS;
@ -865,9 +847,10 @@ assert(rc == QMCKL_SUCCESS);
double elec_coord2[walk_num*3*elec_num]; double elec_coord2[walk_num*3*elec_num];
rc = qmckl_get_electron_coord (context, 'N', elec_coord2); rc = qmckl_get_electron_coord (context, 'N', elec_coord2, walk_num*3*elec_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
for (int64_t i=0 ; i<3*elec_num ; ++i) { for (int64_t i=0 ; i<3*elec_num*walk_num ; ++i) {
printf("%f %f\n", elec_coord[i], elec_coord2[i]);
assert( elec_coord[i] == elec_coord2[i] ); assert( elec_coord[i] == elec_coord2[i] );
} }
@ -969,7 +952,7 @@ qmckl_exit_code qmckl_provide_ee_distance(qmckl_context context)
qmckl_compute_ee_distance(context, qmckl_compute_ee_distance(context,
ctx->electron.num, ctx->electron.num,
ctx->electron.walk_num, ctx->electron.walk_num,
ctx->electron.coord_new, ctx->electron.coord_new.data,
ctx->electron.ee_distance); ctx->electron.ee_distance);
if (rc != QMCKL_SUCCESS) { if (rc != QMCKL_SUCCESS) {
return rc; return rc;
@ -995,7 +978,7 @@ qmckl_exit_code qmckl_provide_ee_distance(qmckl_context context)
| ~context~ | ~qmckl_context~ | in | Global state | | ~context~ | ~qmckl_context~ | in | Global state |
| ~elec_num~ | ~int64_t~ | in | Number of electrons | | ~elec_num~ | ~int64_t~ | in | Number of electrons |
| ~walk_num~ | ~int64_t~ | in | Number of walkers | | ~walk_num~ | ~int64_t~ | in | Number of walkers |
| ~coord~ | ~double[walk_num][3][elec_num]~ | in | Electron coordinates | | ~coord~ | ~double[3][walk_num][elec_num]~ | in | Electron coordinates |
| ~ee_distance~ | ~double[walk_num][elec_num][elec_num]~ | out | Electron-electron distances | | ~ee_distance~ | ~double[walk_num][elec_num][elec_num]~ | out | Electron-electron distances |
#+begin_src f90 :comments org :tangle (eval f) :noweb yes #+begin_src f90 :comments org :tangle (eval f) :noweb yes
@ -1006,10 +989,11 @@ integer function qmckl_compute_ee_distance_f(context, elec_num, walk_num, coord,
integer(qmckl_context), intent(in) :: context integer(qmckl_context), intent(in) :: context
integer*8 , intent(in) :: elec_num integer*8 , intent(in) :: elec_num
integer*8 , intent(in) :: walk_num integer*8 , intent(in) :: walk_num
double precision , intent(in) :: coord(elec_num,3,walk_num) double precision , intent(in) :: coord(elec_num,walk_num,3)
double precision , intent(out) :: ee_distance(elec_num,elec_num,walk_num) double precision , intent(out) :: ee_distance(elec_num,elec_num,walk_num)
integer*8 :: k integer*8 :: k, i, j
double precision :: x, y, z
info = QMCKL_SUCCESS info = QMCKL_SUCCESS
@ -1030,8 +1014,8 @@ integer function qmckl_compute_ee_distance_f(context, elec_num, walk_num, coord,
do k=1,walk_num do k=1,walk_num
info = qmckl_distance(context, 'T', 'T', elec_num, elec_num, & info = qmckl_distance(context, 'T', 'T', elec_num, elec_num, &
coord(1,1,k), elec_num, & coord(1,k,1), elec_num * walk_num, &
coord(1,1,k), elec_num, & coord(1,k,1), elec_num * walk_num, &
ee_distance(1,1,k), elec_num) ee_distance(1,1,k), elec_num)
if (info /= QMCKL_SUCCESS) then if (info /= QMCKL_SUCCESS) then
exit exit
@ -1210,7 +1194,7 @@ qmckl_exit_code qmckl_provide_ee_distance_rescaled(qmckl_context context)
ctx->electron.num, ctx->electron.num,
ctx->electron.rescale_factor_kappa_en, ctx->electron.rescale_factor_kappa_en,
ctx->electron.walk_num, ctx->electron.walk_num,
ctx->electron.coord_new, ctx->electron.coord_new.data,
ctx->electron.ee_distance_rescaled); ctx->electron.ee_distance_rescaled);
if (rc != QMCKL_SUCCESS) { if (rc != QMCKL_SUCCESS) {
return rc; return rc;
@ -1274,8 +1258,8 @@ integer function qmckl_compute_ee_distance_rescaled_f(context, elec_num, rescale
do k=1,walk_num do k=1,walk_num
info = qmckl_distance_rescaled(context, 'T', 'T', elec_num, elec_num, & info = qmckl_distance_rescaled(context, 'T', 'T', elec_num, elec_num, &
coord(1,1,k), elec_num, & coord(1,k,1), elec_num * walk_num, &
coord(1,1,k), elec_num, & coord(1,k,1), elec_num * walk_num, &
ee_distance_rescaled(1,1,k), elec_num, rescale_factor_kappa_ee) ee_distance_rescaled(1,1,k), elec_num, rescale_factor_kappa_ee)
if (info /= QMCKL_SUCCESS) then if (info /= QMCKL_SUCCESS) then
exit exit
@ -1456,7 +1440,7 @@ qmckl_exit_code qmckl_provide_ee_distance_rescaled_deriv_e(qmckl_context context
ctx->electron.num, ctx->electron.num,
ctx->electron.rescale_factor_kappa_en, ctx->electron.rescale_factor_kappa_en,
ctx->electron.walk_num, ctx->electron.walk_num,
ctx->electron.coord_new, ctx->electron.coord_new.data,
ctx->electron.ee_distance_rescaled_deriv_e); ctx->electron.ee_distance_rescaled_deriv_e);
if (rc != QMCKL_SUCCESS) { if (rc != QMCKL_SUCCESS) {
return rc; return rc;
@ -1897,8 +1881,8 @@ qmckl_exit_code qmckl_provide_en_distance(qmckl_context context)
ctx->electron.num, ctx->electron.num,
ctx->nucleus.num, ctx->nucleus.num,
ctx->electron.walk_num, ctx->electron.walk_num,
ctx->electron.coord_new, ctx->electron.coord_new.data,
ctx->nucleus.coord, ctx->nucleus.coord.data,
ctx->electron.en_distance); ctx->electron.en_distance);
if (rc != QMCKL_SUCCESS) { if (rc != QMCKL_SUCCESS) {
return rc; return rc;
@ -1938,7 +1922,7 @@ integer function qmckl_compute_en_distance_f(context, elec_num, nucl_num, walk_n
integer*8 , intent(in) :: elec_num integer*8 , intent(in) :: elec_num
integer*8 , intent(in) :: nucl_num integer*8 , intent(in) :: nucl_num
integer*8 , intent(in) :: walk_num integer*8 , intent(in) :: walk_num
double precision , intent(in) :: elec_coord(elec_num,3,walk_num) double precision , intent(in) :: elec_coord(elec_num,walk_num,3)
double precision , intent(in) :: nucl_coord(nucl_num,3) double precision , intent(in) :: nucl_coord(nucl_num,3)
double precision , intent(out) :: en_distance(elec_num,nucl_num,walk_num) double precision , intent(out) :: en_distance(elec_num,nucl_num,walk_num)
@ -1968,7 +1952,7 @@ integer function qmckl_compute_en_distance_f(context, elec_num, nucl_num, walk_n
do k=1,walk_num do k=1,walk_num
info = qmckl_distance(context, 'T', 'T', elec_num, nucl_num, & info = qmckl_distance(context, 'T', 'T', elec_num, nucl_num, &
elec_coord(1,1,k), elec_num, & elec_coord(1,k,1), elec_num * walk_num, &
nucl_coord, nucl_num, & nucl_coord, nucl_num, &
en_distance(1,1,k), elec_num) en_distance(1,1,k), elec_num)
if (info /= QMCKL_SUCCESS) then if (info /= QMCKL_SUCCESS) then
@ -2005,7 +1989,7 @@ qmckl_exit_code qmckl_compute_en_distance (
integer (c_int64_t) , intent(in) , value :: elec_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 :: nucl_num
integer (c_int64_t) , intent(in) , value :: walk_num integer (c_int64_t) , intent(in) , value :: walk_num
real (c_double ) , intent(in) :: elec_coord(elec_num,3,walk_num) real (c_double ) , intent(in) :: elec_coord(elec_num,walk_num,3)
real (c_double ) , intent(in) :: nucl_coord(elec_num,3) real (c_double ) , intent(in) :: nucl_coord(elec_num,3)
real (c_double ) , intent(out) :: en_distance(elec_num,nucl_num,walk_num) real (c_double ) , intent(out) :: en_distance(elec_num,nucl_num,walk_num)
@ -2052,10 +2036,10 @@ assert(qmckl_electron_provided(context));
rc = qmckl_set_nucleus_num (context, nucl_num); rc = qmckl_set_nucleus_num (context, nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_charge (context, charge); rc = qmckl_set_nucleus_charge (context, charge, nucl_num);
assert (rc == QMCKL_SUCCESS); assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_coord (context, 'T', nucl_coord); rc = qmckl_set_nucleus_coord (context, 'T', nucl_coord, 3*nucl_num);
assert (rc == QMCKL_SUCCESS); assert (rc == QMCKL_SUCCESS);
assert(qmckl_nucleus_provided(context)); assert(qmckl_nucleus_provided(context));
@ -2103,6 +2087,7 @@ assert(fabs(en_distance[1][0][1] - 3.1804527583077356) < 1.e-12);
qmckl_exit_code qmckl_get_electron_en_distance_rescaled(qmckl_context context, double* distance_rescaled); qmckl_exit_code qmckl_get_electron_en_distance_rescaled(qmckl_context context, double* distance_rescaled);
#+end_src #+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_get_electron_en_distance_rescaled(qmckl_context context, double* distance_rescaled) qmckl_exit_code qmckl_get_electron_en_distance_rescaled(qmckl_context context, double* distance_rescaled)
{ {
@ -2173,8 +2158,8 @@ qmckl_exit_code qmckl_provide_en_distance_rescaled(qmckl_context context)
ctx->nucleus.num, ctx->nucleus.num,
ctx->electron.rescale_factor_kappa_en, ctx->electron.rescale_factor_kappa_en,
ctx->electron.walk_num, ctx->electron.walk_num,
ctx->electron.coord_new, ctx->electron.coord_new.data,
ctx->nucleus.coord, ctx->nucleus.coord.data,
ctx->electron.en_distance_rescaled); ctx->electron.en_distance_rescaled);
if (rc != QMCKL_SUCCESS) { if (rc != QMCKL_SUCCESS) {
return rc; return rc;
@ -2217,7 +2202,7 @@ integer function qmckl_compute_en_distance_rescaled_f(context, elec_num, nucl_nu
integer*8 , intent(in) :: nucl_num integer*8 , intent(in) :: nucl_num
double precision , intent(in) :: rescale_factor_kappa_en double precision , intent(in) :: rescale_factor_kappa_en
integer*8 , intent(in) :: walk_num integer*8 , intent(in) :: walk_num
double precision , intent(in) :: elec_coord(elec_num,3,walk_num) double precision , intent(in) :: elec_coord(elec_num,walk_num,3)
double precision , intent(in) :: nucl_coord(nucl_num,3) double precision , intent(in) :: nucl_coord(nucl_num,3)
double precision , intent(out) :: en_distance_rescaled(elec_num,nucl_num,walk_num) double precision , intent(out) :: en_distance_rescaled(elec_num,nucl_num,walk_num)
@ -2253,7 +2238,7 @@ integer function qmckl_compute_en_distance_rescaled_f(context, elec_num, nucl_nu
do k=1,walk_num do k=1,walk_num
info = qmckl_distance_rescaled(context, 'T', 'T', elec_num, nucl_num, & info = qmckl_distance_rescaled(context, 'T', 'T', elec_num, nucl_num, &
elec_coord(1,1,k), elec_num, & elec_coord(1,k,1), elec_num*walk_num, &
nucl_coord, nucl_num, & nucl_coord, nucl_num, &
en_distance_rescaled(1,1,k), elec_num, rescale_factor_kappa_en) en_distance_rescaled(1,1,k), elec_num, rescale_factor_kappa_en)
if (info /= QMCKL_SUCCESS) then if (info /= QMCKL_SUCCESS) then
@ -2292,7 +2277,7 @@ qmckl_exit_code qmckl_compute_en_distance_rescaled (
integer (c_int64_t) , intent(in) , value :: nucl_num integer (c_int64_t) , intent(in) , value :: nucl_num
real (c_double ) , intent(in) , value :: rescale_factor_kappa_en real (c_double ) , intent(in) , value :: rescale_factor_kappa_en
integer (c_int64_t) , intent(in) , value :: walk_num integer (c_int64_t) , intent(in) , value :: walk_num
real (c_double ) , intent(in) :: elec_coord(elec_num,3,walk_num) real (c_double ) , intent(in) :: elec_coord(elec_num,walk_num,3)
real (c_double ) , intent(in) :: nucl_coord(elec_num,3) real (c_double ) , intent(in) :: nucl_coord(elec_num,3)
real (c_double ) , intent(out) :: en_distance_rescaled(elec_num,nucl_num,walk_num) real (c_double ) , intent(out) :: en_distance_rescaled(elec_num,nucl_num,walk_num)
@ -2341,10 +2326,10 @@ assert(qmckl_electron_provided(context));
rc = qmckl_set_nucleus_num (context, nucl_num); rc = qmckl_set_nucleus_num (context, nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_charge (context, charge); rc = qmckl_set_nucleus_charge (context, charge, nucl_num);
assert (rc == QMCKL_SUCCESS); assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_coord (context, 'T', nucl_coord); rc = qmckl_set_nucleus_coord (context, 'T', nucl_coord, 3*nucl_num);
assert (rc == QMCKL_SUCCESS); assert (rc == QMCKL_SUCCESS);
assert(qmckl_nucleus_provided(context)); assert(qmckl_nucleus_provided(context));
@ -2461,8 +2446,8 @@ qmckl_exit_code qmckl_provide_en_distance_rescaled_deriv_e(qmckl_context context
ctx->nucleus.num, ctx->nucleus.num,
ctx->electron.rescale_factor_kappa_en, ctx->electron.rescale_factor_kappa_en,
ctx->electron.walk_num, ctx->electron.walk_num,
ctx->electron.coord_new, ctx->electron.coord_new.data,
ctx->nucleus.coord, ctx->nucleus.coord.data,
ctx->electron.en_distance_rescaled_deriv_e); ctx->electron.en_distance_rescaled_deriv_e);
if (rc != QMCKL_SUCCESS) { if (rc != QMCKL_SUCCESS) {
return rc; return rc;
@ -2506,7 +2491,7 @@ integer function qmckl_compute_en_distance_rescaled_deriv_e_f(context, elec_num,
integer*8 , intent(in) :: nucl_num integer*8 , intent(in) :: nucl_num
double precision , intent(in) :: rescale_factor_kappa_en double precision , intent(in) :: rescale_factor_kappa_en
integer*8 , intent(in) :: walk_num integer*8 , intent(in) :: walk_num
double precision , intent(in) :: elec_coord(elec_num,3,walk_num) double precision , intent(in) :: elec_coord(elec_num,walk_num,3)
double precision , intent(in) :: nucl_coord(nucl_num,3) double precision , intent(in) :: nucl_coord(nucl_num,3)
double precision , intent(out) :: en_distance_rescaled_deriv_e(elec_num,nucl_num,walk_num) double precision , intent(out) :: en_distance_rescaled_deriv_e(elec_num,nucl_num,walk_num)
@ -2542,7 +2527,7 @@ integer function qmckl_compute_en_distance_rescaled_deriv_e_f(context, elec_num,
do k=1,walk_num do k=1,walk_num
info = qmckl_distance_rescaled_deriv_e(context, 'T', 'T', elec_num, nucl_num, & info = qmckl_distance_rescaled_deriv_e(context, 'T', 'T', elec_num, nucl_num, &
elec_coord(1,1,k), elec_num, & elec_coord(1,k,1), elec_num*walk_num, &
nucl_coord, nucl_num, & nucl_coord, nucl_num, &
en_distance_rescaled_deriv_e(1,1,k), elec_num, rescale_factor_kappa_en) en_distance_rescaled_deriv_e(1,1,k), elec_num, rescale_factor_kappa_en)
if (info /= QMCKL_SUCCESS) then if (info /= QMCKL_SUCCESS) then
@ -2581,7 +2566,7 @@ qmckl_exit_code qmckl_compute_en_distance_rescaled_deriv_e (
integer (c_int64_t) , intent(in) , value :: nucl_num integer (c_int64_t) , intent(in) , value :: nucl_num
real (c_double ) , intent(in) , value :: rescale_factor_kappa_en real (c_double ) , intent(in) , value :: rescale_factor_kappa_en
integer (c_int64_t) , intent(in) , value :: walk_num integer (c_int64_t) , intent(in) , value :: walk_num
real (c_double ) , intent(in) :: elec_coord(elec_num,3,walk_num) real (c_double ) , intent(in) :: elec_coord(elec_num,walk_num,3)
real (c_double ) , intent(in) :: nucl_coord(elec_num,3) real (c_double ) , intent(in) :: nucl_coord(elec_num,3)
real (c_double ) , intent(out) :: en_distance_rescaled_deriv_e(elec_num,nucl_num,walk_num) real (c_double ) , intent(out) :: en_distance_rescaled_deriv_e(elec_num,nucl_num,walk_num)
@ -2611,10 +2596,10 @@ assert(rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_rescale_factor (context, nucl_rescale_factor_kappa); rc = qmckl_set_nucleus_rescale_factor (context, nucl_rescale_factor_kappa);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_charge (context, charge); rc = qmckl_set_nucleus_charge (context, charge, nucl_num);
assert (rc == QMCKL_SUCCESS); assert (rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_coord (context, 'T', nucl_coord); rc = qmckl_set_nucleus_coord (context, 'T', nucl_coord, 3*nucl_num);
assert (rc == QMCKL_SUCCESS); assert (rc == QMCKL_SUCCESS);
assert(qmckl_nucleus_provided(context)); assert(qmckl_nucleus_provided(context));
@ -2732,7 +2717,7 @@ qmckl_exit_code qmckl_provide_en_potential(qmckl_context context)
ctx->electron.num, ctx->electron.num,
ctx->nucleus.num, ctx->nucleus.num,
ctx->electron.walk_num, ctx->electron.walk_num,
ctx->nucleus.charge, ctx->nucleus.charge.data,
ctx->electron.en_distance, ctx->electron.en_distance,
ctx->electron.en_pot); ctx->electron.en_pot);
if (rc != QMCKL_SUCCESS) { if (rc != QMCKL_SUCCESS) {

28
org/qmckl_jastrow.org
View File

@ -1,4 +1,5 @@
#+TITLE: Jastrow Factor #+TITLE: Jastrow Factor
#+SETUPFILE: ../tools/theme.setup #+SETUPFILE: ../tools/theme.setup
#+INCLUDE: ../tools/lib.org #+INCLUDE: ../tools/lib.org
@ -104,7 +105,7 @@ int main() {
computed data: computed data:
| Variable | Type | In/Out | Description | | Variable | Type | In/Out | Description |
|-------------------------------+---------------------------------------------------------------------+---------------------------------------------------------------------------------------------------------+---------------------------------| |----------------------------+---------------------------------------------------------------------+-------------------------------------------------+---------------------------------|
| ~dim_cord_vect~ | ~int64_t~ | Number of unique C coefficients | | | ~dim_cord_vect~ | ~int64_t~ | Number of unique C coefficients | |
| ~dim_cord_vect_date~ | ~uint64_t~ | Number of unique C coefficients | | | ~dim_cord_vect_date~ | ~uint64_t~ | Number of unique C coefficients | |
| ~asymp_jasb~ | ~double[2]~ | Asymptotic component | | | ~asymp_jasb~ | ~double[2]~ | Asymptotic component | |
@ -115,8 +116,7 @@ int main() {
| ~lkpm_combined_index_date~ | ~uint64_t~ | Transform l,k,p, and m into consecutive indices | | | ~lkpm_combined_index_date~ | ~uint64_t~ | Transform l,k,p, and m into consecutive indices | |
| ~tmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | out | vector of non-zero coefficients | | ~tmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | out | vector of non-zero coefficients |
| ~dtmp_c~ | ~double[walk_num][elec_num][4][nucl_num][0:cord_num][0:cord_num-1]~ | vector of non-zero coefficients | | | ~dtmp_c~ | ~double[walk_num][elec_num][4][nucl_num][0:cord_num][0:cord_num-1]~ | vector of non-zero coefficients | |
| ~een_rescaled_e~ | ~double[walk_num][walk_num][elec_num][elec_num][0:cord_num]~ | The electron-electron rescaled distances raised to the powers defined by cord | |
| ~een_rescaled_e_date~ | ~uint64_t~ | Keep track of the date of creation | |
| ~een_rescaled_n~ | ~double[walk_num][elec_num][nucl_num][0:cord_num]~ | The electron-electron rescaled distances raised to the powers defined by cord | | | ~een_rescaled_n~ | ~double[walk_num][elec_num][nucl_num][0:cord_num]~ | The electron-electron rescaled distances raised to the powers defined by cord | |
| ~een_rescaled_n_date~ | ~uint64_t~ | Keep track of the date of creation | | | ~een_rescaled_n_date~ | ~uint64_t~ | Keep track of the date of creation | |
| ~een_rescaled_e_deriv_e~ | ~double[walk_num][elec_num][4][elec_num][0:cord_num]~ | The electron-electron rescaled distances raised to the powers defined by cord derivatives wrt electrons | | | ~een_rescaled_e_deriv_e~ | ~double[walk_num][elec_num][4][elec_num][0:cord_num]~ | The electron-electron rescaled distances raised to the powers defined by cord derivatives wrt electrons | |
@ -1093,7 +1093,7 @@ assert(rc == QMCKL_SUCCESS);
double elec_coord2[walk_num*3*elec_num]; double elec_coord2[walk_num*3*elec_num];
rc = qmckl_get_electron_coord (context, 'N', elec_coord2); rc = qmckl_get_electron_coord (context, 'N', elec_coord2, walk_num*3*elec_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
for (int64_t i=0 ; i<3*elec_num ; ++i) { for (int64_t i=0 ; i<3*elec_num ; ++i) {
assert( elec_coord[i] == elec_coord2[i] ); assert( elec_coord[i] == elec_coord2[i] );
@ -1131,15 +1131,15 @@ assert(k == nucl_rescale_factor_kappa);
double nucl_coord2[3*nucl_num]; double nucl_coord2[3*nucl_num];
rc = qmckl_get_nucleus_coord (context, 'T', nucl_coord2); rc = qmckl_get_nucleus_coord (context, 'T', nucl_coord2, 3*nucl_num);
assert(rc == QMCKL_NOT_PROVIDED); assert(rc == QMCKL_NOT_PROVIDED);
rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0])); rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0]), 3*nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
assert(!qmckl_nucleus_provided(context)); assert(!qmckl_nucleus_provided(context));
rc = qmckl_get_nucleus_coord (context, 'N', nucl_coord2); rc = qmckl_get_nucleus_coord (context, 'N', nucl_coord2, nucl_num*3);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
for (int64_t k=0 ; k<3 ; ++k) { for (int64_t k=0 ; k<3 ; ++k) {
for (int64_t i=0 ; i<nucl_num ; ++i) { for (int64_t i=0 ; i<nucl_num ; ++i) {
@ -1147,7 +1147,7 @@ for (int64_t k=0 ; k<3 ; ++k) {
} }
} }
rc = qmckl_get_nucleus_coord (context, 'T', nucl_coord2); rc = qmckl_get_nucleus_coord (context, 'T', nucl_coord2, nucl_num*3);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
for (int64_t i=0 ; i<3*nucl_num ; ++i) { for (int64_t i=0 ; i<3*nucl_num ; ++i) {
assert( nucl_coord[i] == nucl_coord2[i] ); assert( nucl_coord[i] == nucl_coord2[i] );
@ -1155,13 +1155,13 @@ for (int64_t i=0 ; i<3*nucl_num ; ++i) {
double nucl_charge2[nucl_num]; double nucl_charge2[nucl_num];
rc = qmckl_get_nucleus_charge(context, nucl_charge2); rc = qmckl_get_nucleus_charge(context, nucl_charge2, nucl_num);
assert(rc == QMCKL_NOT_PROVIDED); assert(rc == QMCKL_NOT_PROVIDED);
rc = qmckl_set_nucleus_charge(context, nucl_charge); rc = qmckl_set_nucleus_charge(context, nucl_charge, nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_nucleus_charge(context, nucl_charge2); rc = qmckl_get_nucleus_charge(context, nucl_charge2, nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
for (int64_t i=0 ; i<nucl_num ; ++i) { for (int64_t i=0 ; i<nucl_num ; ++i) {
assert( nucl_charge[i] == nucl_charge2[i] ); assert( nucl_charge[i] == nucl_charge2[i] );
@ -3260,7 +3260,7 @@ qmckl_exit_code qmckl_provide_een_rescaled_e_deriv_e(qmckl_context context)
ctx->electron.num, ctx->electron.num,
ctx->jastrow.cord_num, ctx->jastrow.cord_num,
ctx->electron.rescale_factor_kappa_ee, ctx->electron.rescale_factor_kappa_ee,
ctx->electron.coord_new, ctx->electron.coord_new.data,
ctx->electron.ee_distance, ctx->electron.ee_distance,
ctx->jastrow.een_rescaled_e, ctx->jastrow.een_rescaled_e,
ctx->jastrow.een_rescaled_e_deriv_e); ctx->jastrow.een_rescaled_e_deriv_e);
@ -3924,8 +3924,8 @@ qmckl_exit_code qmckl_provide_een_rescaled_n_deriv_e(qmckl_context context)
ctx->nucleus.num, ctx->nucleus.num,
ctx->jastrow.cord_num, ctx->jastrow.cord_num,
ctx->electron.rescale_factor_kappa_en, ctx->electron.rescale_factor_kappa_en,
ctx->electron.coord_new, ctx->electron.coord_new.data,
ctx->nucleus.coord, ctx->nucleus.coord.data,
ctx->electron.en_distance, ctx->electron.en_distance,
ctx->jastrow.een_rescaled_n, ctx->jastrow.een_rescaled_n,
ctx->jastrow.een_rescaled_n_deriv_e); ctx->jastrow.een_rescaled_n_deriv_e);

4
org/qmckl_local_energy.org
View File

@ -576,10 +576,10 @@ assert(rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_num (context, nucl_num); rc = qmckl_set_nucleus_num (context, nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0])); rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0]), nucl_num*3);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_charge(context, nucl_charge); rc = qmckl_set_nucleus_charge(context, nucl_charge, nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
assert(qmckl_nucleus_provided(context)); assert(qmckl_nucleus_provided(context));

4
org/qmckl_mo.org
View File

@ -720,10 +720,10 @@ assert(rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_num (context, nucl_num); rc = qmckl_set_nucleus_num (context, nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0])); rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0]), nucl_num*3);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
rc = qmckl_set_nucleus_charge(context, nucl_charge); rc = qmckl_set_nucleus_charge(context, nucl_charge, nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
assert(qmckl_nucleus_provided(context)); assert(qmckl_nucleus_provided(context));

502
org/qmckl_nucleus.org
View File

@ -67,21 +67,21 @@ int main() {
The following data stored in the context: The following data stored in the context:
|------------------------+----------------+-------------------------------------------| |------------------------+--------------+-------------------------------------------|
| ~uninitialized~ | int32_t | Keeps bit set for uninitialized data | | ~uninitialized~ | int32_t | Keeps bit set for uninitialized data |
| ~num~ | int64_t | Total number of nuclei | | ~num~ | int64_t | Total number of nuclei |
| ~provided~ | bool | If true, ~nucleus~ is valid | | ~provided~ | bool | If true, ~nucleus~ is valid |
| ~charge~ | double[num] | Nuclear charges | | ~charge~ | qmckl_vector | Nuclear charges |
| ~coord~ | double[3][num] | Nuclear coordinates, in transposed format | | ~coord~ | qmckl_matrix | Nuclear coordinates, in transposed format |
| ~coord_date~ | int64_t | Nuclear coordinates, date if modified | | ~coord_date~ | int64_t | Nuclear coordinates, date if modified |
| ~rescale_factor_kappa~ | double | The distance scaling factor | | ~rescale_factor_kappa~ | double | The distance scaling factor |
Computed data: Computed data:
|-----------------------------+------------------+------------------------------------------------------------| |-----------------------------+--------------+------------------------------------------------------------|
| ~nn_distance~ | double[num][num] | Nucleus-nucleus distances | | ~nn_distance~ | qmckl_matrix | Nucleus-nucleus distances |
| ~nn_distance_date~ | int64_t | Date when Nucleus-nucleus distances were computed | | ~nn_distance_date~ | int64_t | Date when Nucleus-nucleus distances were computed |
| ~nn_distance_rescaled~ | double[num][num] | Nucleus-nucleus rescaled distances | | ~nn_distance_rescaled~ | qmckl_matrix | Nucleus-nucleus rescaled distances |
| ~nn_distance_rescaled_date~ | int64_t | Date when Nucleus-nucleus rescaled distances were computed | | ~nn_distance_rescaled_date~ | int64_t | Date when Nucleus-nucleus rescaled distances were computed |
| ~repulsion~ | double | Nuclear repulsion energy | | ~repulsion~ | double | Nuclear repulsion energy |
| ~repulsion_date~ | int64_t | Date when the nuclear repulsion energy was computed | | ~repulsion_date~ | int64_t | Date when the nuclear repulsion energy was computed |
@ -95,10 +95,10 @@ typedef struct qmckl_nucleus_struct {
int64_t nn_distance_date; int64_t nn_distance_date;
int64_t nn_distance_rescaled_date; int64_t nn_distance_rescaled_date;
int64_t coord_date; int64_t coord_date;
double* coord; qmckl_vector charge;
double* charge; qmckl_matrix coord;
double* nn_distance; qmckl_matrix nn_distance;
double* nn_distance_rescaled; qmckl_matrix nn_distance_rescaled;
double repulsion; double repulsion;
double rescale_factor_kappa; double rescale_factor_kappa;
int32_t uninitialized; int32_t uninitialized;
@ -138,15 +138,6 @@ qmckl_exit_code qmckl_init_nucleus(qmckl_context context) {
#+end_src #+end_src
** Access functions ** Access functions
#+begin_src c :comments org :tangle (eval h_func) :exports none
qmckl_exit_code qmckl_get_nucleus_num (const qmckl_context context, int64_t* const num);
qmckl_exit_code qmckl_get_nucleus_charge (const qmckl_context context, double* const charge);
qmckl_exit_code qmckl_get_nucleus_coord (const qmckl_context context, const char transp, double* const coord);
qmckl_exit_code qmckl_get_nucleus_rescale_factor (const qmckl_context context, double* const rescale_factor_kappa);
#+end_src
#+NAME:post #+NAME:post
#+begin_src c :exports none #+begin_src c :exports none
if ( (ctx->nucleus.uninitialized & mask) != 0) { if ( (ctx->nucleus.uninitialized & mask) != 0) {
@ -154,6 +145,13 @@ if ( (ctx->nucleus.uninitialized & mask) != 0) {
} }
#+end_src #+end_src
#+begin_src c :comments org :tangle (eval h_func) :exports none
qmckl_exit_code
qmckl_get_nucleus_num(const qmckl_context context,
int64_t* const num);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_exit_code
qmckl_get_nucleus_num (const qmckl_context context, int64_t* const num) { qmckl_get_nucleus_num (const qmckl_context context, int64_t* const num) {
@ -187,10 +185,22 @@ qmckl_get_nucleus_num (const qmckl_context context, int64_t* const num) {
return QMCKL_SUCCESS; return QMCKL_SUCCESS;
} }
#+end_src
#+begin_src c :comments org :tangle (eval h_func) :exports none
qmckl_exit_code qmckl_exit_code
qmckl_get_nucleus_charge (const qmckl_context context, double* const charge) { qmckl_get_nucleus_charge(const qmckl_context context,
double* const charge,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_nucleus_charge (const qmckl_context context,
double* const charge,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_INVALID_CONTEXT; return QMCKL_INVALID_CONTEXT;
@ -215,16 +225,31 @@ qmckl_get_nucleus_charge (const qmckl_context context, double* const charge) {
"nucleus data is not provided"); "nucleus data is not provided");
} }
assert (ctx->nucleus.charge != NULL); assert (ctx->nucleus.charge.data != NULL);
int64_t nucl_num = ctx->nucleus.num; if (ctx->nucleus.num > size_max) {
return qmckl_failwith( context,
memcpy(charge, ctx->nucleus.charge, nucl_num*sizeof(double)); QMCKL_INVALID_ARG_3,
"qmckl_get_nucleus_charge",
return QMCKL_SUCCESS; "Array too small");
} }
qmckl_exit_code rc;
rc = qmckl_double_of_vector(context, ctx->nucleus.charge, charge, size_max);
return rc;
}
#+end_src
#+begin_src c :comments org :tangle (eval h_func) :exports none
qmckl_exit_code
qmckl_get_nucleus_rescale_factor(const qmckl_context context,
double* const rescale_factor_kappa);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_exit_code
qmckl_get_nucleus_rescale_factor (const qmckl_context context, qmckl_get_nucleus_rescale_factor (const qmckl_context context,
double* const rescale_factor_kappa) double* const rescale_factor_kappa)
@ -250,10 +275,24 @@ qmckl_get_nucleus_rescale_factor (const qmckl_context context,
return QMCKL_SUCCESS; return QMCKL_SUCCESS;
} }
#+end_src
#+begin_src c :comments org :tangle (eval h_func) :exports none
qmckl_exit_code qmckl_exit_code
qmckl_get_nucleus_coord (const qmckl_context context, const char transp, double* const coord) { qmckl_get_nucleus_coord(const qmckl_context context,
const char transp,
double* const coord,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_nucleus_coord (const qmckl_context context,
const char transp,
double* const coord,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_INVALID_CONTEXT; return QMCKL_INVALID_CONTEXT;
@ -285,25 +324,21 @@ qmckl_get_nucleus_coord (const qmckl_context context, const char transp, double*
"nucleus data is not provided"); "nucleus data is not provided");
} }
int64_t nucl_num = ctx->nucleus.num; assert (ctx->nucleus.coord.data != NULL);
assert (ctx->nucleus.coord != NULL);
if (transp == 'N') {
qmckl_exit_code rc; qmckl_exit_code rc;
rc = qmckl_transpose(context, nucl_num, 3, if (transp == 'N') {
ctx->nucleus.coord, nucl_num, qmckl_matrix At = qmckl_matrix_alloc(context, 3, ctx->nucleus.coord.size[0]);
coord, 3); rc = qmckl_transpose(context, ctx->nucleus.coord, At);
if (rc != QMCKL_SUCCESS) return rc; if (rc != QMCKL_SUCCESS) return rc;
rc = qmckl_double_of_matrix(context, At, coord, size_max);
qmckl_matrix_free(context, At);
} else { } else {
rc = qmckl_double_of_matrix(context, ctx->nucleus.coord, coord, size_max);
memcpy(coord, ctx->nucleus.coord, 3*nucl_num*sizeof(double));
} }
return QMCKL_SUCCESS; return rc;
} }
#+end_src #+end_src
@ -330,51 +365,6 @@ bool qmckl_nucleus_provided(const qmckl_context context) {
** Initialization functions ** Initialization functions
To set the data relative to the nuclei in the context, the
following functions need to be called.
#+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code qmckl_set_nucleus_num (qmckl_context context, const int64_t num);
qmckl_exit_code qmckl_set_nucleus_charge (qmckl_context context, const double* charge);
qmckl_exit_code qmckl_set_nucleus_coord (qmckl_context context, const char transp, const double* coord);
qmckl_exit_code qmckl_set_nucleus_rescale_factor (qmckl_context context, const double rescale_factor_kappa);
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
integer(c_int32_t) function qmckl_set_nucleus_num(context, num) &
bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: num
end function
end interface
interface
integer(c_int32_t) function qmckl_set_nucleus_charge(context, charge) &
bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
real (c_double) , intent(in) :: charge(*)
end function
end interface
interface
integer(c_int32_t) function qmckl_set_nucleus_coord(context, transp, coord) &
bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
character(c_char) , intent(in) , value :: transp
real (c_double) , intent(in) :: coord(*)
end function
end interface
#+end_src
#+NAME:pre2 #+NAME:pre2
#+begin_src c :exports none #+begin_src c :exports none
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
@ -392,12 +382,22 @@ ctx->nucleus.provided = (ctx->nucleus.uninitialized == 0);
return QMCKL_SUCCESS; return QMCKL_SUCCESS;
#+end_src #+end_src
To set the data relative to the nuclei in the context, the
following functions need to be called.
To set the number of nuclei, use #+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_set_nucleus_num(qmckl_context context,
const int64_t num);
#+end_src
Sets the number of nuclei.
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_exit_code
qmckl_set_nucleus_num(qmckl_context context, const int64_t num) { qmckl_set_nucleus_num(qmckl_context context,
const int64_t num)
{
<<pre2>> <<pre2>>
if (num <= 0) { if (num <= 0) {
@ -415,11 +415,35 @@ qmckl_set_nucleus_num(qmckl_context context, const int64_t num) {
} }
#+end_src #+end_src
The following function sets the nuclear charges of all the atoms. #+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
integer(c_int32_t) function qmckl_set_nucleus_num(context, num) &
bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: num
end function
end interface
#+end_src
#+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_set_nucleus_charge(qmckl_context context,
const double* charge,
const int64_t size_max);
#+end_src
Sets the nuclear charges of all the atoms.
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_exit_code
qmckl_set_nucleus_charge(qmckl_context context, const double* charge) { qmckl_set_nucleus_charge(qmckl_context context,
const double* charge,
const int64_t size_max)
{
<<pre2>> <<pre2>>
if (charge == NULL) { if (charge == NULL) {
@ -437,34 +461,126 @@ qmckl_set_nucleus_charge(qmckl_context context, const double* charge) {
rc = qmckl_get_nucleus_num(context, &num); rc = qmckl_get_nucleus_num(context, &num);
if (rc != QMCKL_SUCCESS) return rc; if (rc != QMCKL_SUCCESS) return rc;
if (ctx->nucleus.charge != NULL) { if (num > size_max) {
qmckl_free(context, ctx->nucleus.charge);
ctx->nucleus.charge= NULL;
}
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = num*sizeof(double);
assert (ctx->nucleus.charge == NULL);
ctx->nucleus.charge = (double*) qmckl_malloc(context, mem_info);
if (ctx->nucleus.charge == NULL) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED, QMCKL_INVALID_ARG_3,
"qmckl_set_nucleus_charge", "qmckl_set_nucleus_charge",
NULL); "Array too small");
} }
ctx->nucleus.charge= memcpy(ctx->nucleus.charge, charge, num*sizeof(double));
assert (ctx->nucleus.charge != NULL); ctx->nucleus.charge = qmckl_vector_alloc(context, num);
rc = qmckl_vector_of_double(context, charge, num, &(ctx->nucleus.charge));
<<post2>> <<post2>>
} }
#+end_src #+end_src
The following function sets the rescale parameter for the nuclear distances. #+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
integer(c_int32_t) function qmckl_set_nucleus_charge(context, charge, size_max) &
bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
real (c_double) , intent(in) :: charge(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function
end interface
#+end_src
#+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_set_nucleus_coord(qmckl_context context,
const char transp,
const double* coord,
const int64_t size_max);
#+end_src
Sets the nuclear coordinates of all the atoms. The coordinates
are be given in atomic units.
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_exit_code
qmckl_set_nucleus_rescale_factor(qmckl_context context, const double rescale_factor_kappa) { qmckl_set_nucleus_coord(qmckl_context context,
const char transp,
const double* coord,
const int64_t size_max)
{
<<pre2>>
qmckl_exit_code rc;
int32_t mask = 1 << 2;
const int64_t nucl_num = (int64_t) ctx->nucleus.num;
if (ctx->nucleus.coord.data != NULL) {
rc = qmckl_matrix_free(context, ctx->nucleus.coord);
if (rc != QMCKL_SUCCESS) return rc;
}
ctx->nucleus.coord = qmckl_matrix_alloc(context, nucl_num, 3);
if (ctx->nucleus.coord.data == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_set_nucleus_coord",
NULL);
}
if (size_max < 3*nucl_num) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_4,
"qmckl_set_nucleus_coord",
"Array too small");
}
if (transp == 'N') {
qmckl_matrix At;
At = qmckl_matrix_alloc(context, 3, nucl_num);
rc = qmckl_matrix_of_double(context, coord, 3*nucl_num, &At);
if (rc != QMCKL_SUCCESS) return rc;
rc = qmckl_transpose(context, At, ctx->nucleus.coord);
} else {
rc = qmckl_matrix_of_double(context, coord, nucl_num*3, &(ctx->nucleus.coord));
}
if (rc != QMCKL_SUCCESS) return rc;
<<post2>>
}
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
integer(c_int32_t) function qmckl_set_nucleus_coord(context, transp, coord, size_max) &
bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
character(c_char) , intent(in) , value :: transp
real (c_double) , intent(in) :: coord(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function
end interface
#+end_src
#+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_set_nucleus_rescale_factor(qmckl_context context,
const double kappa);
#+end_src
Sets the rescale parameter for the nuclear distances.
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_set_nucleus_rescale_factor(qmckl_context context,
const double rescale_factor_kappa)
{
<<pre2>> <<pre2>>
if (rescale_factor_kappa <= 0.0) { if (rescale_factor_kappa <= 0.0) {
@ -480,50 +596,17 @@ qmckl_set_nucleus_rescale_factor(qmckl_context context, const double rescale_fac
} }
#+end_src #+end_src
The following function sets the nuclear coordinates of all the #+begin_src f90 :tangle (eval fh_func) :comments org :exports none
atoms. The coordinates should be given in atomic units. interface
integer(c_int32_t) function qmckl_set_rescale_factor(context, kappa) &
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none bind(C)
qmckl_exit_code use, intrinsic :: iso_c_binding
qmckl_set_nucleus_coord(qmckl_context context, const char transp, const double* coord) { import
<<pre2>> implicit none
integer (c_int64_t) , intent(in) , value :: context
int64_t nucl_num = (int64_t) 0; real (c_double) , intent(in) , value :: kappa
qmckl_exit_code rc; end function
end interface
int32_t mask = 1 << 2;
rc = qmckl_get_nucleus_num(context, &nucl_num);
if (rc != QMCKL_SUCCESS) return rc;
if (ctx->nucleus.coord != NULL) {
qmckl_free(context, ctx->nucleus.coord);
ctx->nucleus.coord = NULL;
}
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = 3*nucl_num*sizeof(double);
assert(ctx->nucleus.coord == NULL);
ctx->nucleus.coord = (double*) qmckl_malloc(context, mem_info);
if (coord == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_set_nucleus_coord",
NULL);
}
if (transp == 'N') {
rc = qmckl_transpose(context, 3, nucl_num,
coord, 3,
ctx->nucleus.coord, nucl_num);
if (rc != QMCKL_SUCCESS) return rc;
} else {
memcpy(ctx->nucleus.coord, coord, 3*nucl_num*sizeof(double));
}
<<post2>>
}
#+end_src #+end_src
** Test ** Test
@ -568,15 +651,15 @@ assert(k == nucl_rescale_factor_kappa);
double nucl_coord2[3*nucl_num]; double nucl_coord2[3*nucl_num];
rc = qmckl_get_nucleus_coord (context, 'T', nucl_coord2); rc = qmckl_get_nucleus_coord (context, 'T', nucl_coord2, 3*nucl_num);
assert(rc == QMCKL_NOT_PROVIDED); assert(rc == QMCKL_NOT_PROVIDED);
rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0])); rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0]), 3*nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
assert(!qmckl_nucleus_provided(context)); assert(!qmckl_nucleus_provided(context));
rc = qmckl_get_nucleus_coord (context, 'N', nucl_coord2); rc = qmckl_get_nucleus_coord (context, 'N', nucl_coord2, 3*nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
for (size_t k=0 ; k<3 ; ++k) { for (size_t k=0 ; k<3 ; ++k) {
for (size_t i=0 ; i<nucl_num ; ++i) { for (size_t i=0 ; i<nucl_num ; ++i) {
@ -584,7 +667,7 @@ for (size_t k=0 ; k<3 ; ++k) {
} }
} }
rc = qmckl_get_nucleus_coord (context, 'T', nucl_coord2); rc = qmckl_get_nucleus_coord (context, 'T', nucl_coord2, 3*nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
for (size_t i=0 ; i<3*nucl_num ; ++i) { for (size_t i=0 ; i<3*nucl_num ; ++i) {
assert( nucl_coord[i] == nucl_coord2[i] ); assert( nucl_coord[i] == nucl_coord2[i] );
@ -592,13 +675,13 @@ for (size_t i=0 ; i<3*nucl_num ; ++i) {
double nucl_charge2[nucl_num]; double nucl_charge2[nucl_num];
rc = qmckl_get_nucleus_charge(context, nucl_charge2); rc = qmckl_get_nucleus_charge(context, nucl_charge2, nucl_num);
assert(rc == QMCKL_NOT_PROVIDED); assert(rc == QMCKL_NOT_PROVIDED);
rc = qmckl_set_nucleus_charge(context, nucl_charge); rc = qmckl_set_nucleus_charge(context, nucl_charge, nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_nucleus_charge(context, nucl_charge2); rc = qmckl_get_nucleus_charge(context, nucl_charge2, nucl_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
for (size_t i=0 ; i<nucl_num ; ++i) { for (size_t i=0 ; i<nucl_num ; ++i) {
assert( nucl_charge[i] == nucl_charge2[i] ); assert( nucl_charge[i] == nucl_charge2[i] );
@ -621,11 +704,17 @@ assert(qmckl_nucleus_provided(context));
*** Get *** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes #+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code qmckl_get_nucleus_nn_distance(qmckl_context context, double* distance); qmckl_exit_code
qmckl_get_nucleus_nn_distance(qmckl_context context,
double* distance,
const int64_t size_max);
#+end_src #+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_get_nucleus_nn_distance(qmckl_context context, double* distance) qmckl_exit_code
qmckl_get_nucleus_nn_distance(qmckl_context context,
double* distance,
const int64_t size_max)
{ {
/* Check input parameters */ /* Check input parameters */
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
@ -638,22 +727,29 @@ qmckl_exit_code qmckl_get_nucleus_nn_distance(qmckl_context context, double* dis
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
assert (ctx != NULL); assert (ctx != NULL);
size_t sze = ctx->nucleus.num * ctx->nucleus.num; const int64_t sze = ctx->nucleus.num * ctx->nucleus.num;
memcpy(distance, ctx->nucleus.nn_distance, sze * sizeof(double)); if (sze > size_max) {
return qmckl_failwith(context,
QMCKL_INVALID_ARG_3,
"qmckl_get_nucleus_nn_distance",
"Array too small");
}
rc = qmckl_double_of_matrix(context, ctx->nucleus.nn_distance, distance, size_max);
return QMCKL_SUCCESS; return rc;
} }
#+end_src #+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none #+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface interface
integer(c_int32_t) function qmckl_get_nucleus_nn_distance(context, distance) & integer(c_int32_t) function qmckl_get_nucleus_nn_distance(context, distance, size_max) &
bind(C) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
import import
implicit none implicit none
integer (c_int64_t) , intent(in) , value :: context integer (c_int64_t) , intent(in) , value :: context
real (c_double ) , intent(out) :: distance(*) real (c_double ) , intent(out) :: distance(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function end function
end interface end interface
#+end_src #+end_src
@ -678,26 +774,23 @@ qmckl_exit_code qmckl_provide_nn_distance(qmckl_context context)
if (!ctx->nucleus.provided) return QMCKL_NOT_PROVIDED; if (!ctx->nucleus.provided) return QMCKL_NOT_PROVIDED;
/* Allocate array */ /* Allocate array */
if (ctx->nucleus.nn_distance == NULL) { if (ctx->nucleus.nn_distance.data == NULL) {
ctx->nucleus.nn_distance =
qmckl_matrix_alloc(context, ctx->nucleus.num, ctx->nucleus.num);
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; if (ctx->nucleus.nn_distance.data == NULL) {
mem_info.size = ctx->nucleus.num * ctx->nucleus.num * sizeof(double);
double* nn_distance = (double*) qmckl_malloc(context, mem_info);
if (nn_distance == NULL) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED, QMCKL_ALLOCATION_FAILED,
"qmckl_nn_distance", "qmckl_nn_distance",
NULL); NULL);
} }
ctx->nucleus.nn_distance = nn_distance;
} }
qmckl_exit_code rc = qmckl_exit_code rc =
qmckl_compute_nn_distance(context, qmckl_compute_nn_distance(context,
ctx->nucleus.num, ctx->nucleus.num,
ctx->nucleus.coord, ctx->nucleus.coord.data,
ctx->nucleus.nn_distance); ctx->nucleus.nn_distance.data);
if (rc != QMCKL_SUCCESS) { if (rc != QMCKL_SUCCESS) {
return rc; return rc;
} }
@ -788,7 +881,7 @@ qmckl_exit_code qmckl_compute_nn_distance (
assert(qmckl_nucleus_provided(context)); assert(qmckl_nucleus_provided(context));
double distance[nucl_num*nucl_num]; double distance[nucl_num*nucl_num];
rc = qmckl_get_nucleus_nn_distance(context, distance); rc = qmckl_get_nucleus_nn_distance(context, distance, nucl_num*nucl_num);
assert(distance[0] == 0.); assert(distance[0] == 0.);
assert(distance[1] == distance[nucl_num]); assert(distance[1] == distance[nucl_num]);
assert(fabs(distance[1]-2.070304721365169) < 1.e-12); assert(fabs(distance[1]-2.070304721365169) < 1.e-12);
@ -800,11 +893,17 @@ assert(fabs(distance[1]-2.070304721365169) < 1.e-12);
*** Get *** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes #+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code qmckl_get_nucleus_nn_distance_rescaled(qmckl_context context, double* distance_rescaled); qmckl_exit_code
qmckl_get_nucleus_nn_distance_rescaled(qmckl_context context,
double* distance_rescaled,
const int64_t size_max);
#+end_src #+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_get_nucleus_nn_distance_rescaled(qmckl_context context, double* distance_rescaled) qmckl_exit_code
qmckl_get_nucleus_nn_distance_rescaled(qmckl_context context,
double* distance_rescaled,
const int64_t size_max)
{ {
/* Check input parameters */ /* Check input parameters */
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
@ -817,11 +916,33 @@ qmckl_exit_code qmckl_get_nucleus_nn_distance_rescaled(qmckl_context context, do
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
assert (ctx != NULL); assert (ctx != NULL);
size_t sze = ctx->nucleus.num * ctx->nucleus.num; const int64_t sze = ctx->nucleus.num * ctx->nucleus.num;
memcpy(distance_rescaled, ctx->nucleus.nn_distance_rescaled, sze * sizeof(double)); if (sze > size_max) {
return qmckl_failwith(context,
return QMCKL_SUCCESS; QMCKL_INVALID_ARG_3,
"qmckl_get_nucleus_nn_distance_rescaled",
"Array too small");
} }
rc = qmckl_double_of_matrix(context,
ctx->nucleus.nn_distance_rescaled,
distance_rescaled,
size_max);
return rc;
}
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
integer(c_int32_t) function qmckl_get_nucleus_nn_distance_rescaled(context, distance_rescaled, 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_rescaled(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function
end interface
#+end_src #+end_src
*** Provide :noexport: *** Provide :noexport:
@ -844,27 +965,24 @@ qmckl_exit_code qmckl_provide_nn_distance_rescaled(qmckl_context context)
if (!ctx->nucleus.provided) return QMCKL_NOT_PROVIDED; if (!ctx->nucleus.provided) return QMCKL_NOT_PROVIDED;
/* Allocate array */ /* Allocate array */
if (ctx->nucleus.nn_distance_rescaled == NULL) { if (ctx->nucleus.nn_distance_rescaled.data == NULL) {
ctx->nucleus.nn_distance_rescaled =
qmckl_matrix_alloc(context, ctx->nucleus.num, ctx->nucleus.num);
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; if (ctx->nucleus.nn_distance_rescaled.data == NULL) {
mem_info.size = ctx->nucleus.num * ctx->nucleus.num * sizeof(double);
double* nn_distance_rescaled = (double*) qmckl_malloc(context, mem_info);
if (nn_distance_rescaled == NULL) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED, QMCKL_ALLOCATION_FAILED,
"qmckl_nn_distance_rescaled", "qmckl_nn_distance_rescaled",
NULL); NULL);
} }
ctx->nucleus.nn_distance_rescaled = nn_distance_rescaled;
} }
qmckl_exit_code rc = qmckl_exit_code rc =
qmckl_compute_nn_distance_rescaled(context, qmckl_compute_nn_distance_rescaled(context,
ctx->nucleus.num, ctx->nucleus.num,
ctx->nucleus.rescale_factor_kappa, ctx->nucleus.rescale_factor_kappa,
ctx->nucleus.coord, ctx->nucleus.coord.data,
ctx->nucleus.nn_distance_rescaled); ctx->nucleus.nn_distance_rescaled.data);
if (rc != QMCKL_SUCCESS) { if (rc != QMCKL_SUCCESS) {
return rc; return rc;
} }
@ -959,7 +1077,7 @@ qmckl_exit_code qmckl_compute_nn_distance_rescaled (
//assert(qmckl_nucleus_provided(context)); //assert(qmckl_nucleus_provided(context));
// //
//double distance[nucl_num*nucl_num]; //double distance[nucl_num*nucl_num];
//rc = qmckl_get_nucleus_nn_distance(context, distance); //rc = qmckl_get_nucleus_nn_distance(context, distance, nucl_num*nucl_num);
//assert(distance[0] == 0.); //assert(distance[0] == 0.);
//assert(distance[1] == distance[nucl_num]); //assert(distance[1] == distance[nucl_num]);
//assert(fabs(distance[1]-2.070304721365169) < 1.e-12); //assert(fabs(distance[1]-2.070304721365169) < 1.e-12);
@ -975,11 +1093,11 @@ qmckl_exit_code qmckl_compute_nn_distance_rescaled (
*** Get *** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes #+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code qmckl_get_nucleus_repulsion(qmckl_context context, double* energy); qmckl_exit_code qmckl_get_nucleus_repulsion(qmckl_context context, double* const energy);
#+end_src #+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_get_nucleus_repulsion(qmckl_context context, double* energy) qmckl_exit_code qmckl_get_nucleus_repulsion(qmckl_context context, double* const energy)
{ {
/* Check input parameters */ /* Check input parameters */
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
@ -1037,8 +1155,8 @@ qmckl_exit_code qmckl_provide_nucleus_repulsion(qmckl_context context)
rc = qmckl_compute_nucleus_repulsion(context, rc = qmckl_compute_nucleus_repulsion(context,
ctx->nucleus.num, ctx->nucleus.num,
ctx->nucleus.charge, ctx->nucleus.charge.data,
ctx->nucleus.nn_distance, ctx->nucleus.nn_distance.data,
&(ctx->nucleus.repulsion)); &(ctx->nucleus.repulsion));
if (rc != QMCKL_SUCCESS) { if (rc != QMCKL_SUCCESS) {
return rc; return rc;

377
org/qmckl_point.org
View File

@ -17,11 +17,14 @@ walkers.
#ifndef QMCKL_POINT_HPT #ifndef QMCKL_POINT_HPT
#define QMCKL_POINT_HPT #define QMCKL_POINT_HPT
#include <stdbool.h> #include <stdbool.h>
#include "qmckl_blas_private_type.h"
#+end_src #+end_src
#+begin_src c :tangle (eval h_private_func) #+begin_src c :tangle (eval h_private_func)
#ifndef QMCKL_POINT_HPF #ifndef QMCKL_POINT_HPF
#define QMCKL_POINT_HPF #define QMCKL_POINT_HPF
#include "qmckl_blas_private_type.h"
#include "qmckl_blas_private_func.h"
#+end_src #+end_src
#+begin_src c :tangle (eval c_test) :noweb yes #+begin_src c :tangle (eval c_test) :noweb yes
@ -33,6 +36,8 @@ walkers.
#endif #endif
#include "chbrclf.h" #include "chbrclf.h"
#include "qmckl_blas_private_type.h"
#include "qmckl_blas_private_func.h"
int main() { int main() {
qmckl_context context; qmckl_context context;
@ -61,8 +66,11 @@ int main() {
#include "qmckl.h" #include "qmckl.h"
#include "qmckl_context_private_type.h" #include "qmckl_context_private_type.h"
#include "qmckl_memory_private_type.h" #include "qmckl_memory_private_type.h"
#include "qmckl_memory_private_func.h" #include "qmckl_blas_private_type.h"
#include "qmckl_point_private_func.h" #include "qmckl_point_private_func.h"
#include "qmckl_memory_private_func.h"
#include "qmckl_blas_private_func.h"
#+end_src #+end_src
* Context * Context
@ -70,27 +78,21 @@ int main() {
The following data stored in the context: The following data stored in the context:
| Variable | Type | Description | | Variable | Type | Description |
|-----------+---------------+------------------------| |----------+----------------+-------------------------------------------|
| ~num~ | ~int64_t~ | Total number of points | | ~num~ | ~int64_t~ | Total number of points |
| ~coord_x~ | ~double[num]~ | X coordinates | | ~date~ | ~uint64_t~ | Last modification date of the coordinates |
| ~coord_y~ | ~double[num]~ | Y coordinates | | ~coord~ | ~qmckl_matrix~ | ~num~ \times 3 matrix3 |
| ~coord_z~ | ~double[num]~ | Z coordinates |
We consider that 'transposed' and 'normal' storage follows the convention: We consider that the matrix is stored 'transposed' and 'normal'
corresponds to the 3 \times ~num~ matrix.
| | Normal | Transposed |
|---------+------------------+------------------|
| C | ~[point_num][3]~ | ~[3][point_num]~ |
| Fortran | ~(3,point_num)~ | ~(point_num,3)~ |
** Data structure ** Data structure
#+begin_src c :comments org :tangle (eval h_private_type) #+begin_src c :comments org :tangle (eval h_private_type)
typedef struct qmckl_point_struct { typedef struct qmckl_point_struct {
double* coord_x;
double* coord_y;
double* coord_z;
int64_t num; int64_t num;
uint64_t date;
qmckl_matrix coord;
} qmckl_point_struct; } qmckl_point_struct;
#+end_src #+end_src
@ -109,16 +111,7 @@ qmckl_exit_code qmckl_init_point(qmckl_context context) {
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
assert (ctx != NULL); assert (ctx != NULL);
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; memset(&(ctx->point), 0, sizeof(qmckl_point_struct));
mem_info.size = sizeof(qmckl_point_struct);
ctx->point = (qmckl_point_struct*) qmckl_malloc(context, mem_info);
if (ctx->point == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_init_point",
NULL);
}
memset(ctx->point, 0, sizeof(qmckl_point_struct));
return QMCKL_SUCCESS; return QMCKL_SUCCESS;
} }
@ -157,10 +150,9 @@ qmckl_get_point_num (const qmckl_context context, int64_t* const num) {
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
assert (ctx != NULL); assert (ctx != NULL);
assert (ctx->point != NULL);
assert (ctx->point->num > (int64_t) 0); assert (ctx->point.num >= (int64_t) 0);
,*num = ctx->point->num; ,*num = ctx->point.num;
return QMCKL_SUCCESS; return QMCKL_SUCCESS;
} }
#+end_src #+end_src
@ -182,6 +174,7 @@ end interface
#+begin_src c :comments org :tangle (eval h_func) :exports none #+begin_src c :comments org :tangle (eval h_func) :exports none
qmckl_exit_code qmckl_get_point(const qmckl_context context, qmckl_exit_code qmckl_get_point(const qmckl_context context,
const char transp,
double* const coord, double* const coord,
const int64_t size_max); const int64_t size_max);
#+end_src #+end_src
@ -193,6 +186,7 @@ qmckl_exit_code qmckl_get_point(const qmckl_context context,
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_exit_code
qmckl_get_point(const qmckl_context context, qmckl_get_point(const qmckl_context context,
const char transp,
double* const coord, double* const coord,
const int64_t size_max) const int64_t size_max)
{ {
@ -210,13 +204,11 @@ qmckl_get_point(const qmckl_context context,
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
assert (ctx != NULL); assert (ctx != NULL);
assert (ctx->point != NULL);
int64_t point_num = ctx->point->num; int64_t point_num = ctx->point.num;
if (point_num == 0) return QMCKL_NOT_PROVIDED;
assert (ctx->point->coord_x != NULL); assert (ctx->point.coord.data != NULL);
assert (ctx->point->coord_y != NULL);
assert (ctx->point->coord_z != NULL);
if (size_max < 3*point_num) { if (size_max < 3*point_num) {
return qmckl_failwith( context, return qmckl_failwith( context,
@ -225,27 +217,33 @@ qmckl_get_point(const qmckl_context context,
"size_max too small"); "size_max too small");
} }
qmckl_exit_code rc;
double * ptr = coord; if (transp == 'N') {
for (int64_t i=0 ; i<point_num ; ++i) { qmckl_matrix At = qmckl_matrix_alloc( context, 3, point_num);
,*ptr = ctx->point->coord_x[i]; ++ptr; rc = qmckl_transpose( context, ctx->point.coord, At );
,*ptr = ctx->point->coord_y[i]; ++ptr; if (rc != QMCKL_SUCCESS) return rc;
,*ptr = ctx->point->coord_z[i]; ++ptr; rc = qmckl_double_of_matrix( context, At, coord, size_max);
if (rc != QMCKL_SUCCESS) return rc;
rc = qmckl_matrix_free(context, At);
} else {
rc = qmckl_double_of_matrix( context, ctx->point.coord, coord, size_max);
} }
if (rc != QMCKL_SUCCESS) return rc;
return QMCKL_SUCCESS; return rc;
} }
#+end_src #+end_src
#+begin_src f90 :comments org :tangle (eval fh_func) :noweb yes #+begin_src f90 :comments org :tangle (eval fh_func) :noweb yes
interface interface
integer(c_int32_t) function qmckl_get_point(context, coord, size_max) bind(C) integer(c_int32_t) function qmckl_get_point(context, transp, coord, size_max) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
import import
implicit none implicit none
integer (c_int64_t) , intent(in) , value :: context integer (c_int64_t) , intent(in) , value :: context
character(c_char) , intent(in) , value :: transp
real (c_double ) , intent(out) :: coord(*) real (c_double ) , intent(out) :: coord(*)
integer (c_int64_t) , intent(in) :: size_max integer (c_int64_t) , intent(in) :: size_max
end function end function
@ -253,184 +251,86 @@ end interface
#+end_src #+end_src
#+begin_src c :comments org :tangle (eval h_func) :exports none
qmckl_exit_code qmckl_get_point_xyz (const qmckl_context context,
double* const coord_x,
double* const coord_y,
double* const coord_z,
const int64_t size_max);
#+end_src
Returns the point coordinates in three different arrays, one for
each component x,y,z.
The pointers are assumed to point on a memory block of size
~size_max~ \ge ~point_num~.
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_point_xyz (const qmckl_context context,
double* const coord_x,
double* const coord_y,
double* const coord_z,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_INVALID_CONTEXT;
}
if (coord_x == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_get_point_coord_xyz",
"coord_x is a null pointer");
}
if (coord_y == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_point_coord_xyz",
"coord_y is a null pointer");
}
if (coord_z == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_4,
"qmckl_get_point_coord_xyz",
"coord_z is a null pointer");
}
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
assert (ctx != NULL);
assert (ctx->point != NULL);
int64_t point_num = ctx->point->num;
assert (ctx->point->coord_x != NULL);
assert (ctx->point->coord_y != NULL);
assert (ctx->point->coord_z != NULL);
if (size_max < point_num) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_5,
"qmckl_get_point_coord_xyz",
"size_max too small");
}
memcpy(coord_x, ctx->point->coord_x, point_num*sizeof(double));
memcpy(coord_y, ctx->point->coord_y, point_num*sizeof(double));
memcpy(coord_z, ctx->point->coord_z, point_num*sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src f90 :comments org :tangle (eval fh_func) :noweb yes
interface
integer(c_int32_t) function qmckl_get_point_xyz(context, &
coord_x, coord_y, coord_z, 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) :: coord_x(*)
real (c_double ) , intent(out) :: coord_y(*)
real (c_double ) , intent(out) :: coord_z(*)
integer (c_int64_t) , intent(in) :: size_max
end function
end interface
#+end_src
** Initialization functions ** Initialization functions
When the data is set in the context, if the arrays are large When the data is set in the context, if the arrays are large
enough, we overwrite the data contained in them. enough, we overwrite the data contained in them.
#+NAME: check_alloc
#+begin_src c :exports none
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
assert (ctx != NULL);
assert (ctx->point != NULL);
if (ctx->point->num < num) {
if (ctx->point->coord_x != NULL) {
qmckl_free(context, ctx->point->coord_x);
ctx->point->coord_x = NULL;
}
if (ctx->point->coord_y != NULL) {
qmckl_free(context, ctx->point->coord_y);
ctx->point->coord_y = NULL;
}
if (ctx->point->coord_z != NULL) {
qmckl_free(context, ctx->point->coord_z);
ctx->point->coord_z = NULL;
}
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = num*sizeof(double);
ctx->point->coord_x = (double*) qmckl_malloc(context, mem_info);
if (ctx->point->coord_x == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_set_point",
NULL);
}
ctx->point->coord_y = (double*) qmckl_malloc(context, mem_info);
if (ctx->point->coord_y == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_set_point",
NULL);
}
ctx->point->coord_z = (double*) qmckl_malloc(context, mem_info);
if (ctx->point->coord_z == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_set_point",
NULL);
}
};
ctx->point->num = num;
#+end_src
To set the data relative to the points in the context, one of the To set the data relative to the points in the context, one of the
following functions need to be called. following functions need to be called.
#+begin_src c :comments org :tangle (eval h_func) #+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code qmckl_set_point (qmckl_context context, qmckl_exit_code qmckl_set_point (qmckl_context context,
const char transp,
const double* coord, const double* coord,
const int64_t num); const int64_t num);
#+end_src #+end_src
Copy a sequence of (x,y,z) into the context. Copy a sequence of ~num~ points $(x,y,z)$ into the context.
#+begin_src c :comments org :tangle (eval c) :noweb yes #+begin_src c :comments org :tangle (eval c) :noweb yes
qmckl_exit_code qmckl_exit_code
qmckl_set_point (qmckl_context context, qmckl_set_point (qmckl_context context,
const char transp,
const double* coord, const double* coord,
const int64_t num) const int64_t num)
{ {
<<check_alloc>> if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
for (int64_t i=0 ; i<num ; ++i) {
ctx->point->coord_x[i] = coord[3*i ];
ctx->point->coord_y[i] = coord[3*i+1];
ctx->point->coord_z[i] = coord[3*i+2];
} }
if (transp != 'N' && transp != 'T') {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_set_point",
"transp should be 'N' or 'T'");
}
if (coord == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_set_point",
"coord is a NULL pointer");
}
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
assert (ctx != NULL);
qmckl_exit_code rc;
if (ctx->point.num < num) {
if (ctx->point.coord.data != NULL) {
rc = qmckl_matrix_free(context, ctx->point.coord);
assert (rc == QMCKL_SUCCESS);
}
ctx->point.coord = qmckl_matrix_alloc(context, num, 3);
if (ctx->point.coord.data == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_set_point",
NULL);
}
};
ctx->point.num = num;
if (transp == 'T') {
memcpy(ctx->point.coord.data, coord, 3*num*sizeof(double));
} else {
for (int64_t i=0 ; i<num ; ++i) {
qmckl_mat(ctx->point.coord, i, 0) = coord[3*i ];
qmckl_mat(ctx->point.coord, i, 1) = coord[3*i+1];
qmckl_mat(ctx->point.coord, i, 2) = coord[3*i+2];
}
}
/* Increment the date of the context */
ctx->date += 1UL;
ctx->point.date = ctx->date;
return QMCKL_SUCCESS; return QMCKL_SUCCESS;
} }
@ -439,76 +339,38 @@ qmckl_set_point (qmckl_context context,
#+begin_src f90 :comments org :tangle (eval fh_func) :noweb yes #+begin_src f90 :comments org :tangle (eval fh_func) :noweb yes
interface interface
integer(c_int32_t) function qmckl_set_point(context, & integer(c_int32_t) function qmckl_set_point(context, &
coord_x, coord_y, coord_z, size_max) bind(C) transp, coord, size_max) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
import import
implicit none implicit none
integer (c_int64_t) , intent(in) , value :: context integer (c_int64_t) , intent(in) , value :: context
real (c_double ) , intent(in) :: coord_x(*) character(c_char) , intent(in) , value :: transp
real (c_double ) , intent(in) :: coord_y(*) real (c_double ) , intent(in) :: coord(*)
real (c_double ) , intent(in) :: coord_z(*)
integer (c_int64_t) , intent(in) , value :: size_max integer (c_int64_t) , intent(in) , value :: size_max
end function end function
end interface end interface
#+end_src #+end_src
#+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code qmckl_set_point_xyz (qmckl_context context,
const double* coord_x,
const double* coord_y,
const double* coord_z,
const int64_t num);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes
qmckl_exit_code
qmckl_set_point_xyz (qmckl_context context,
const double* coord_x,
const double* coord_y,
const double* coord_z,
const int64_t num)
{
<<check_alloc>>
memcpy(ctx->point->coord_x, coord_x, num*sizeof(double));
memcpy(ctx->point->coord_y, coord_y, num*sizeof(double));
memcpy(ctx->point->coord_z, coord_z, num*sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src f90 :comments org :tangle (eval fh_func) :noweb yes
interface
integer(c_int32_t) function qmckl_set_point_xyz(context, &
coord_x, coord_y, coord_z, size_max) bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
real (c_double ) , intent(in) :: coord_x(*)
real (c_double ) , intent(in) :: coord_y(*)
real (c_double ) , intent(in) :: coord_z(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function
end interface
#+end_src
** Test ** Test
#+begin_src c :tangle (eval c_test) #+begin_src c :tangle (eval c_test)
/* Reference input data */ /* Reference input data */
int64_t point_num = chbrclf_elec_num; int64_t point_num = chbrclf_elec_num;
double* coord = &(chbrclf_elec_coord[0][0][0]); const double* coord = &(chbrclf_elec_coord[0][0][0]);
/* --- */ /* --- */
qmckl_exit_code rc; qmckl_exit_code rc;
double coord2[point_num*3];
double coord3[point_num*3];
rc = qmckl_set_point (context, coord, point_num);
rc = qmckl_get_point (context, 'N', coord2, (point_num*3));
assert(rc == QMCKL_NOT_PROVIDED);
rc = qmckl_set_point (context, 'N', coord, point_num);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
int64_t n; int64_t n;
@ -516,25 +378,30 @@ rc = qmckl_get_point_num (context, &n);
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
assert(n == point_num); assert(n == point_num);
double coord2[point_num*3]; rc = qmckl_get_point (context, 'N', coord2, (point_num*3));
double coord_x[point_num];
double coord_y[point_num];
double coord_z[point_num];
rc = qmckl_get_point_xyz (context, coord_x, coord_y, coord_z, point_num);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_point (context, coord2, (point_num*3));
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
for (int64_t i=0 ; i<3*point_num ; ++i) { for (int64_t i=0 ; i<3*point_num ; ++i) {
assert( coord[i] == coord2[i] ); assert( coord[i] == coord2[i] );
} }
rc = qmckl_get_point (context, 'T', coord2, (point_num*3));
assert(rc == QMCKL_SUCCESS);
for (int64_t i=0 ; i<point_num ; ++i) { for (int64_t i=0 ; i<point_num ; ++i) {
assert( coord[3*i+0] == coord_x[i] ); assert( coord[3*i+0] == coord2[i] );
assert( coord[3*i+1] == coord_y[i] ); assert( coord[3*i+1] == coord2[i+point_num] );
assert( coord[3*i+2] == coord_z[i] ); assert( coord[3*i+2] == coord2[i+point_num*2] );
}
rc = qmckl_set_point (context, 'T', coord2, point_num);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_get_point (context, 'N', coord3, (point_num*3));
assert(rc == QMCKL_SUCCESS);
for (int64_t i=0 ; i<3*point_num ; ++i) {
assert( coord[i] == coord3[i] );
} }
#+end_src #+end_src

10
org/qmckl_trexio.org
View File

@ -208,8 +208,7 @@ qmckl_trexio_read_nucleus_X(qmckl_context context, trexio_t* const file)
trexio_string_of_error(rcio)); trexio_string_of_error(rcio));
} }
//rc = qmckl_set_nucleus_charge(context, nucl_charge, nucleus_num); rc = qmckl_set_nucleus_charge(context, nucl_charge, nucleus_num);
rc = qmckl_set_nucleus_charge(context, nucl_charge);
qmckl_free(context, nucl_charge); qmckl_free(context, nucl_charge);
nucl_charge = NULL; nucl_charge = NULL;
@ -249,8 +248,7 @@ qmckl_trexio_read_nucleus_X(qmckl_context context, trexio_t* const file)
trexio_string_of_error(rcio)); trexio_string_of_error(rcio));
} }
//rc = qmckl_set_nucleus_coord(context, 'N', nucl_coord, 3*nucleus_num); rc = qmckl_set_nucleus_coord(context, 'N', nucl_coord, 3*nucleus_num);
rc = qmckl_set_nucleus_coord(context, 'N', nucl_coord);
qmckl_free(context, nucl_coord); qmckl_free(context, nucl_coord);
nucl_coord = NULL; nucl_coord = NULL;
@ -1183,7 +1181,7 @@ assert (nucl_num == chbrclf_nucl_num);
printf("Nuclear charges\n"); printf("Nuclear charges\n");
double * charge = (double*) malloc (nucl_num * sizeof(double)); double * charge = (double*) malloc (nucl_num * sizeof(double));
rc = qmckl_get_nucleus_charge(context, charge); rc = qmckl_get_nucleus_charge(context, charge, nucl_num);
assert (rc == QMCKL_SUCCESS); assert (rc == QMCKL_SUCCESS);
for (int i=0 ; i<nucl_num ; i++) { for (int i=0 ; i<nucl_num ; i++) {
assert (charge[i] == chbrclf_charge[i]); assert (charge[i] == chbrclf_charge[i]);
@ -1193,7 +1191,7 @@ charge = NULL;
printf("Nuclear coordinates\n"); printf("Nuclear coordinates\n");
double * coord = (double*) malloc (nucl_num * 3 * sizeof(double)); double * coord = (double*) malloc (nucl_num * 3 * sizeof(double));
rc = qmckl_get_nucleus_coord(context, 'T', coord); rc = qmckl_get_nucleus_coord(context, 'T', coord, 3*nucl_num);
assert (rc == QMCKL_SUCCESS); assert (rc == QMCKL_SUCCESS);
int k=0; int k=0;
for (int j=0 ; j<3 ; ++j) { for (int j=0 ; j<3 ; ++j) {

229
org/qmckl_utils.org
View File

@ -1,229 +0,0 @@
#+TITLE: Utility functions
#+SETUPFILE: ../tools/theme.setup
#+INCLUDE: ../tools/lib.org
* Headers :noexport:
#+begin_src elisp :noexport :results none
(org-babel-lob-ingest "../tools/lib.org")
#+end_src
#+begin_src c :comments link :tangle (eval c_test) :noweb yes
#include "qmckl.h"
#include "assert.h"
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
int main() {
qmckl_context context;
context = qmckl_context_create();
#+end_src
* Matrix operations
** ~qmckl_transpose~
Transposes a matrix: $B_{ji} = A_{ij}$
#+NAME: qmckl_transpose_args
| qmckl_context | context | in | Global state |
| int64_t | m | in | Number of rows of the input matrix |
| int64_t | n | in | Number of columns of the input matrix |
| double | A[][lda] | in | Array containing the $m \times n$ matrix $A$ |
| int64_t | lda | in | Leading dimension of array ~A~ |
| double | B[][ldb] | out | Array containing the $n \times m$ matrix $B$ |
| int64_t | ldb | in | Leading dimension of array ~B~ |
*** Requirements
- ~context~ is not ~QMCKL_NULL_CONTEXT~
- ~m > 0~
- ~n > 0~
- ~lda >= m~
- ~ldb >= n~
- ~A~ is allocated with at least $m \times n \times 8$ bytes
- ~B~ is allocated with at least $n \times m \times 8$ bytes
*** C header
#+CALL: generate_c_header(table=qmckl_transpose_args,rettyp="qmckl_exit_code",fname="qmckl_transpose")
#+RESULTS:
#+begin_src c :tangle (eval h_func) :comments org
qmckl_exit_code qmckl_transpose (
const qmckl_context context,
const int64_t m,
const int64_t n,
const double* A,
const int64_t lda,
double* const B,
const int64_t ldb );
#+end_src
*** Source
#+begin_src f90 :tangle (eval f)
integer function qmckl_transpose_f(context, m, n, A, LDA, B, LDB) &
result(info)
use qmckl
implicit none
integer(qmckl_context) , intent(in) :: context
integer*8 , intent(in) :: m, n
integer*8 , intent(in) :: lda
real*8 , intent(in) :: A(lda,*)
integer*8 , intent(in) :: ldb
real*8 , intent(out) :: B(ldb,*)
integer*8 :: i,j
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif
if (m <= 0_8) then
info = QMCKL_INVALID_ARG_2
return
endif
if (n <= 0_8) then
info = QMCKL_INVALID_ARG_3
return
endif
if (LDA < m) then
info = QMCKL_INVALID_ARG_5
return
endif
if (LDB < n) then
info = QMCKL_INVALID_ARG_7
return
endif
do j=1,m
do i=1,n
B(i,j) = A(j,i)
end do
end do
end function qmckl_transpose_f
#+end_src
*** C interface :noexport:
#+CALL: generate_c_interface(table=qmckl_transpose_args,rettyp="qmckl_exit_code",fname="qmckl_transpose")
#+RESULTS:
#+begin_src f90 :tangle (eval f) :comments org :exports none
integer(c_int32_t) function qmckl_transpose &
(context, m, n, A, lda, B, ldb) &
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 :: m
integer (c_int64_t) , intent(in) , value :: n
real (c_double ) , intent(in) :: A(lda,*)
integer (c_int64_t) , intent(in) , value :: lda
real (c_double ) , intent(out) :: B(ldb,*)
integer (c_int64_t) , intent(in) , value :: ldb
integer(c_int32_t), external :: qmckl_transpose_f
info = qmckl_transpose_f &
(context, m, n, A, lda, B, ldb)
end function qmckl_transpose
#+end_src
#+CALL: generate_f_interface(table=qmckl_transpose_args,rettyp="qmckl_exit_code",fname="qmckl_transpose")
#+RESULTS:
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
integer(c_int32_t) function qmckl_transpose &
(context, m, n, A, lda, B, ldb) &
bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: m
integer (c_int64_t) , intent(in) , value :: n
real (c_double ) , intent(in) :: A(lda,*)
integer (c_int64_t) , intent(in) , value :: lda
real (c_double ) , intent(out) :: B(ldb,*)
integer (c_int64_t) , intent(in) , value :: ldb
end function qmckl_transpose
end interface
#+end_src
*** Test :noexport:
#+begin_src f90 :tangle (eval f_test)
integer(qmckl_exit_code) function test_qmckl_transpose(context) bind(C)
use qmckl
implicit none
integer(qmckl_context), intent(in), value :: context
double precision, allocatable :: A(:,:), B(:,:)
integer*8 :: m, n, LDA, LDB
integer*8 :: i,j
double precision :: x
m = 5
n = 6
LDA = m+3
LDB = n+1
allocate( A(LDA,n), B(LDB,m) )
A = 0.d0
B = 0.d0
do j=1,n
do i=1,m
A(i,j) = -10.d0 + dble(i+j)
end do
end do
test_qmckl_transpose = qmckl_transpose(context, m, n, A, LDA, B, LDB)
if (test_qmckl_transpose /= QMCKL_SUCCESS) return
test_qmckl_transpose = QMCKL_FAILURE
x = 0.d0
do j=1,n
do i=1,m
x = x + (A(i,j)-B(j,i))**2
end do
end do
if (dabs(x) <= 1.d-15) then
test_qmckl_transpose = QMCKL_SUCCESS
endif
deallocate(A,B)
end function test_qmckl_transpose
#+end_src
#+begin_src c :comments link :tangle (eval c_test)
qmckl_exit_code test_qmckl_transpose(qmckl_context context);
assert(QMCKL_SUCCESS == test_qmckl_transpose(context));
#+end_src
* End of files :noexport:
#+begin_src c :comments link :tangle (eval c_test)
assert (qmckl_context_destroy(context) == QMCKL_SUCCESS);
return 0;
}
#+end_src
# -*- mode: org -*-
# vim: syntax=c