TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-08-14 16:58:38 +02:00
Code Issues Projects Releases Wiki Activity

Introduce Fortran interface for Jastrow

Browse Source
This commit is contained in:
Anthony Scemama 2022-11-14 14:57:16 +01:00
parent 3a3b03b2ce
commit d69e4ca2a5
1 changed files with 161 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

190
org/qmckl_jastrow.org
View File

@ -426,7 +426,7 @@ qmckl_exit_code qmckl_init_jastrow(qmckl_context context) {
qmckl_context_struct* const ctx = (qmckl_context_struct*) context; qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL); assert (ctx != NULL);
ctx->jastrow.uninitialized = (1 << 8) - 1; ctx->jastrow.uninitialized = (1 << 10) - 1;
/* Default values */ /* Default values */
@ -442,7 +442,9 @@ qmckl_exit_code qmckl_init_jastrow(qmckl_context context) {
#+begin_src c :comments org :tangle (eval h_func) #+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code qmckl_set_jastrow_rescale_factor_ee (qmckl_context context, const double kappa_ee); qmckl_exit_code qmckl_set_jastrow_rescale_factor_ee (qmckl_context context, const double kappa_ee);
qmckl_exit_code qmckl_set_jastrow_rescale_factor_en (qmckl_context context, const double* kappa_en, const int64_t size_max); qmckl_exit_code qmckl_set_jastrow_rescale_factor_en (qmckl_context context, const double* kappa_en, const int64_t size_max);
qmckl_exit_code qmckl_set_jastrow_ord_num (qmckl_context context, const int64_t aord_num, const int64_t bord_num, const int64_t cord_num); qmckl_exit_code qmckl_set_jastrow_aord_num (qmckl_context context, const int64_t aord_num);
qmckl_exit_code qmckl_set_jastrow_bord_num (qmckl_context context, const int64_t bord_num);
qmckl_exit_code qmckl_set_jastrow_cord_num (qmckl_context context, const int64_t cord_num);
qmckl_exit_code qmckl_set_jastrow_type_nucl_num (qmckl_context context, const int64_t type_nucl_num); qmckl_exit_code qmckl_set_jastrow_type_nucl_num (qmckl_context context, const int64_t type_nucl_num);
qmckl_exit_code qmckl_set_jastrow_type_nucl_vector (qmckl_context context, const int64_t* type_nucl_vector, const int64_t nucl_num); qmckl_exit_code qmckl_set_jastrow_type_nucl_vector (qmckl_context context, const int64_t* type_nucl_vector, const int64_t nucl_num);
qmckl_exit_code qmckl_set_jastrow_aord_vector (qmckl_context context, const double * aord_vector, const int64_t size_max); qmckl_exit_code qmckl_set_jastrow_aord_vector (qmckl_context context, const double * aord_vector, const int64_t size_max);
@ -482,10 +484,7 @@ return QMCKL_SUCCESS;
#+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_jastrow_ord_num(qmckl_context context, qmckl_set_jastrow_aord_num(qmckl_context context, const int64_t aord_num)
const int64_t aord_num,
const int64_t bord_num,
const int64_t cord_num)
{ {
int32_t mask = 1 << 0; int32_t mask = 1 << 0;
@ -495,26 +494,50 @@ qmckl_set_jastrow_ord_num(qmckl_context context,
if (aord_num <= 0) { if (aord_num <= 0) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_INVALID_ARG_2, QMCKL_INVALID_ARG_2,
"qmckl_set_jastrow_ord_num", "qmckl_set_jastrow_aord_num",
"aord_num <= 0"); "aord_num <= 0");
} }
ctx->jastrow.aord_num = aord_num;
<<post2>>
}
qmckl_exit_code
qmckl_set_jastrow_bord_num(qmckl_context context, const int64_t bord_num)
{
int32_t mask = 1 << 1;
<<pre2>>
if (bord_num <= 0) { if (bord_num <= 0) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_INVALID_ARG_2, QMCKL_INVALID_ARG_2,
"qmckl_set_jastrow_ord_num", "qmckl_set_jastrow_bord_num",
"bord_num <= 0"); "bord_num <= 0");
} }
ctx->jastrow.bord_num = bord_num;
<<post2>>
}
qmckl_exit_code
qmckl_set_jastrow_cord_num(qmckl_context context, const int64_t cord_num)
{
int32_t mask = 1 << 2;
<<pre2>>
if (cord_num <= 0) { if (cord_num <= 0) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_INVALID_ARG_2, QMCKL_INVALID_ARG_2,
"qmckl_set_jastrow_ord_num", "qmckl_set_jastrow_cord_num",
"cord_num <= 0"); "cord_num <= 0");
} }
ctx->jastrow.aord_num = aord_num;
ctx->jastrow.bord_num = bord_num;
ctx->jastrow.cord_num = cord_num; ctx->jastrow.cord_num = cord_num;
<<post2>> <<post2>>
@ -524,7 +547,7 @@ qmckl_set_jastrow_ord_num(qmckl_context context,
qmckl_exit_code qmckl_exit_code
qmckl_set_jastrow_type_nucl_num(qmckl_context context, const int64_t type_nucl_num) qmckl_set_jastrow_type_nucl_num(qmckl_context context, const int64_t type_nucl_num)
{ {
int32_t mask = 1 << 1; int32_t mask = 1 << 3;
<<pre2>> <<pre2>>
@ -547,7 +570,7 @@ qmckl_set_jastrow_type_nucl_vector(qmckl_context context,
const int64_t nucl_num) const int64_t nucl_num)
{ {
int32_t mask = 1 << 2; int32_t mask = 1 << 4;
<<pre2>> <<pre2>>
@ -602,7 +625,7 @@ qmckl_set_jastrow_aord_vector(qmckl_context context,
double const * aord_vector, double const * aord_vector,
const int64_t size_max) const int64_t size_max)
{ {
int32_t mask = 1 << 3; int32_t mask = 1 << 5;
<<pre2>> <<pre2>>
@ -669,7 +692,7 @@ qmckl_set_jastrow_bord_vector(qmckl_context context,
double const * bord_vector, double const * bord_vector,
const int64_t size_max) const int64_t size_max)
{ {
int32_t mask = 1 << 4; int32_t mask = 1 << 6;
<<pre2>> <<pre2>>
@ -732,7 +755,7 @@ qmckl_set_jastrow_cord_vector(qmckl_context context,
double const * cord_vector, double const * cord_vector,
const int64_t size_max) const int64_t size_max)
{ {
int32_t mask = 1 << 5; int32_t mask = 1 << 7;
<<pre2>> <<pre2>>
@ -800,7 +823,7 @@ qmckl_exit_code
qmckl_set_jastrow_rescale_factor_ee(qmckl_context context, qmckl_set_jastrow_rescale_factor_ee(qmckl_context context,
const double rescale_factor_ee) { const double rescale_factor_ee) {
int32_t mask = 1 << 6; int32_t mask = 1 << 8;
<<pre2>> <<pre2>>
@ -822,7 +845,7 @@ qmckl_set_jastrow_rescale_factor_en(qmckl_context context,
const double* rescale_factor_en, const double* rescale_factor_en,
const int64_t size_max) { const int64_t size_max) {
int32_t mask = 1 << 7; int32_t mask = 1 << 9;
<<pre2>> <<pre2>>
@ -922,6 +945,108 @@ qmckl_exit_code qmckl_finalize_jastrow(qmckl_context context) {
} }
#+end_src #+end_src
**** Fortran interface
#+begin_src f90 :tangle (eval fh_func) :comments org
interface
integer(qmckl_exit_code) function qmckl_set_jastrow_rescale_factor_ee (context, &
kappa_ee) bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (qmckl_context) , intent(in) , value :: context
double precision, intent(in), value :: kappa_ee
end function
integer(qmckl_exit_code) qmckl_set_jastrow_rescale_factor_en (context, &
kappa_en, size_max) bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (qmckl_context) , intent(in) , value :: context
integer, intent(in), value :: size_max
double precision, intent(in) :: kappa_en(size_max)
end function
integer(qmckl_exit_code) qmckl_set_jastrow_aord_num (context, &
aord_num) bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (qmckl_context) , intent(in) , value :: context
integer(c_int64_t), intent(in), value :: aord_num
end function
integer(qmckl_exit_code) qmckl_set_jastrow_bord_num (context, &
aord_num) bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (qmckl_context) , intent(in) , value :: context
integer(c_int64_t), intent(in), value :: bord_num
end function
integer(qmckl_exit_code) qmckl_set_jastrow_cord_num (context, &
aord_num) bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (qmckl_context) , intent(in) , value :: context
integer(c_int64_t), intent(in), value :: cord_num
end function
integer(qmckl_exit_code) qmckl_set_jastrow_type_nucl_num (context, &
type_nucl_num) bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (qmckl_context) , intent(in) , value :: context
integer(c_int64_t), intent(in), value :: type_nucl_num
end function
integer(qmckl_exit_code) qmckl_set_jastrow_type_nucl_vector (context, &
type_nucl_vector, size_max) bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (qmckl_context) , intent(in) , value :: context
integer(c_int64_t), intent(in) :: type_nucl_vector(size_max)
integer(c_int64_t), intent(in), value :: size_max
end function
integer(qmckl_exit_code) qmckl_set_jastrow_aord_vector(context, &
aord_vector, size_max) bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (qmckl_context) , intent(in) , value :: context
double precision, intent(in) :: aord_vector(size_max)
integer(c_int64_t), intent(in), value :: size_max
end function
integer(qmckl_exit_code) qmckl_set_jastrow_bord_vector(context, &
bord_vector, size_max) bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (qmckl_context) , intent(in) , value :: context
double precision, intent(in) :: bord_vector(size_max)
integer(c_int64_t), intent(in), value :: size_max
end function
integer(qmckl_exit_code) qmckl_set_jastrow_cord_vector(context, &
cord_vector, size_max) bind(C)
use, intrinsic :: iso_c_binding
import
implicit none
integer (qmckl_context) , intent(in) , value :: context
double precision, intent(in) :: cord_vector(size_max)
integer(c_int64_t), intent(in), value :: size_max
end function
end interface
#+end_src
** Access functions ** Access functions
#+begin_src c :comments org :tangle (eval h_func) :exports none #+begin_src c :comments org :tangle (eval h_func) :exports none
@ -937,6 +1062,8 @@ qmckl_exit_code qmckl_get_jastrow_rescale_factor_ee (const qmckl_context contex
qmckl_exit_code qmckl_get_jastrow_rescale_factor_en (const qmckl_context context, double* const rescale_factor_en, const int64_t size_max); qmckl_exit_code qmckl_get_jastrow_rescale_factor_en (const qmckl_context context, double* const rescale_factor_en, const int64_t size_max);
#+end_src #+end_src
# TODO Fortran interface
Along with these core functions, calculation of the jastrow factor Along with these core functions, calculation of the jastrow factor
requires the following additional information to be set: requires the following additional information to be set:
@ -1006,7 +1133,7 @@ qmckl_exit_code qmckl_get_jastrow_bord_num (const qmckl_context context, int64_t
qmckl_context_struct* const ctx = (qmckl_context_struct*) context; qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL); assert (ctx != NULL);
int32_t mask = 1 << 0; int32_t mask = 1 << 1;
if ( (ctx->jastrow.uninitialized & mask) != 0) { if ( (ctx->jastrow.uninitialized & mask) != 0) {
return QMCKL_NOT_PROVIDED; return QMCKL_NOT_PROVIDED;
@ -1033,7 +1160,7 @@ qmckl_exit_code qmckl_get_jastrow_cord_num (const qmckl_context context, int64_t
qmckl_context_struct* const ctx = (qmckl_context_struct*) context; qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL); assert (ctx != NULL);
int32_t mask = 1 << 0; int32_t mask = 1 << 2;
if ( (ctx->jastrow.uninitialized & mask) != 0) { if ( (ctx->jastrow.uninitialized & mask) != 0) {
return QMCKL_NOT_PROVIDED; return QMCKL_NOT_PROVIDED;
@ -1060,7 +1187,7 @@ qmckl_exit_code qmckl_get_jastrow_type_nucl_num (const qmckl_context context, in
qmckl_context_struct* const ctx = (qmckl_context_struct*) context; qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL); assert (ctx != NULL);
int32_t mask = 1 << 1; int32_t mask = 1 << 3;
if ( (ctx->jastrow.uninitialized & mask) != 0) { if ( (ctx->jastrow.uninitialized & mask) != 0) {
return QMCKL_NOT_PROVIDED; return QMCKL_NOT_PROVIDED;
@ -1091,7 +1218,7 @@ qmckl_get_jastrow_type_nucl_vector (const qmckl_context context,
qmckl_context_struct* const ctx = (qmckl_context_struct*) context; qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL); assert (ctx != NULL);
int32_t mask = 1 << 2; int32_t mask = 1 << 4;
if ( (ctx->jastrow.uninitialized & mask) != 0) { if ( (ctx->jastrow.uninitialized & mask) != 0) {
return QMCKL_NOT_PROVIDED; return QMCKL_NOT_PROVIDED;
@ -1128,7 +1255,7 @@ qmckl_get_jastrow_aord_vector (const qmckl_context context,
qmckl_context_struct* const ctx = (qmckl_context_struct*) context; qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL); assert (ctx != NULL);
int32_t mask = 1 << 3; int32_t mask = 1 << 5;
if ( (ctx->jastrow.uninitialized & mask) != 0) { if ( (ctx->jastrow.uninitialized & mask) != 0) {
return QMCKL_NOT_PROVIDED; return QMCKL_NOT_PROVIDED;
@ -1165,7 +1292,7 @@ qmckl_get_jastrow_bord_vector (const qmckl_context context,
qmckl_context_struct* const ctx = (qmckl_context_struct*) context; qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL); assert (ctx != NULL);
int32_t mask = 1 << 4; int32_t mask = 1 << 6;
if ( (ctx->jastrow.uninitialized & mask) != 0) { if ( (ctx->jastrow.uninitialized & mask) != 0) {
return QMCKL_NOT_PROVIDED; return QMCKL_NOT_PROVIDED;
@ -1202,7 +1329,7 @@ qmckl_get_jastrow_cord_vector (const qmckl_context context,
qmckl_context_struct* const ctx = (qmckl_context_struct*) context; qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL); assert (ctx != NULL);
int32_t mask = 1 << 5; int32_t mask = 1 << 7;
if ( (ctx->jastrow.uninitialized & mask) != 0) { if ( (ctx->jastrow.uninitialized & mask) != 0) {
return QMCKL_NOT_PROVIDED; return QMCKL_NOT_PROVIDED;
@ -1243,7 +1370,7 @@ qmckl_get_jastrow_rescale_factor_ee (const qmckl_context context,
qmckl_context_struct* const ctx = (qmckl_context_struct*) context; qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL); assert (ctx != NULL);
int32_t mask = 1 << 6; int32_t mask = 1 << 8;
if ( (ctx->jastrow.uninitialized & mask) != 0) { if ( (ctx->jastrow.uninitialized & mask) != 0) {
return QMCKL_NOT_PROVIDED; return QMCKL_NOT_PROVIDED;
@ -1273,7 +1400,7 @@ qmckl_get_jastrow_rescale_factor_en (const qmckl_context context,
qmckl_context_struct* const ctx = (qmckl_context_struct*) context; qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL); assert (ctx != NULL);
int32_t mask = 1 << 7; int32_t mask = 1 << 9;
if ( (ctx->jastrow.uninitialized & mask) != 0) { if ( (ctx->jastrow.uninitialized & mask) != 0) {
return QMCKL_NOT_PROVIDED; return QMCKL_NOT_PROVIDED;
@ -1658,7 +1785,13 @@ assert(!qmckl_jastrow_provided(context));
/* Set the data */ /* Set the data */
rc = qmckl_check(context, rc = qmckl_check(context,
qmckl_set_jastrow_ord_num(context, aord_num, bord_num, cord_num) qmckl_set_jastrow_aord_num(context, aord_num)
);
rc = qmckl_check(context,
qmckl_set_jastrow_bord_num(context, bord_num)
);
rc = qmckl_check(context,
qmckl_set_jastrow_cord_num(context, cord_num)
); );
assert(rc == QMCKL_SUCCESS); assert(rc == QMCKL_SUCCESS);
rc = qmckl_check(context, rc = qmckl_check(context,
@ -2986,7 +3119,6 @@ qmckl_exit_code qmckl_compute_factor_en (
double* const factor_en ); double* const factor_en );
#+end_src #+end_src
*** Test *** Test
#+begin_src python :results output :exports none :noweb yes #+begin_src python :results output :exports none :noweb yes
import numpy as np import numpy as np