mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-12-31 08:36:11 +01:00
Introduce Fortran interface for Jastrow
This commit is contained in:
parent
3a3b03b2ce
commit
d69e4ca2a5
@ -426,7 +426,7 @@ qmckl_exit_code qmckl_init_jastrow(qmckl_context context) {
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
||||
assert (ctx != NULL);
|
||||
|
||||
ctx->jastrow.uninitialized = (1 << 8) - 1;
|
||||
ctx->jastrow.uninitialized = (1 << 10) - 1;
|
||||
|
||||
/* Default values */
|
||||
|
||||
@ -442,7 +442,9 @@ qmckl_exit_code qmckl_init_jastrow(qmckl_context context) {
|
||||
#+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_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_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);
|
||||
@ -482,10 +484,7 @@ return QMCKL_SUCCESS;
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
||||
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_set_jastrow_aord_num(qmckl_context context, const int64_t aord_num)
|
||||
{
|
||||
|
||||
int32_t mask = 1 << 0;
|
||||
@ -495,26 +494,50 @@ qmckl_set_jastrow_ord_num(qmckl_context context,
|
||||
if (aord_num <= 0) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"qmckl_set_jastrow_ord_num",
|
||||
"qmckl_set_jastrow_aord_num",
|
||||
"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) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"qmckl_set_jastrow_ord_num",
|
||||
"qmckl_set_jastrow_bord_num",
|
||||
"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) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"qmckl_set_jastrow_ord_num",
|
||||
"qmckl_set_jastrow_cord_num",
|
||||
"cord_num <= 0");
|
||||
}
|
||||
|
||||
ctx->jastrow.aord_num = aord_num;
|
||||
ctx->jastrow.bord_num = bord_num;
|
||||
ctx->jastrow.cord_num = cord_num;
|
||||
|
||||
<<post2>>
|
||||
@ -524,7 +547,7 @@ qmckl_set_jastrow_ord_num(qmckl_context context,
|
||||
qmckl_exit_code
|
||||
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>>
|
||||
|
||||
@ -547,7 +570,7 @@ qmckl_set_jastrow_type_nucl_vector(qmckl_context context,
|
||||
const int64_t nucl_num)
|
||||
{
|
||||
|
||||
int32_t mask = 1 << 2;
|
||||
int32_t mask = 1 << 4;
|
||||
|
||||
<<pre2>>
|
||||
|
||||
@ -602,7 +625,7 @@ qmckl_set_jastrow_aord_vector(qmckl_context context,
|
||||
double const * aord_vector,
|
||||
const int64_t size_max)
|
||||
{
|
||||
int32_t mask = 1 << 3;
|
||||
int32_t mask = 1 << 5;
|
||||
|
||||
<<pre2>>
|
||||
|
||||
@ -669,7 +692,7 @@ qmckl_set_jastrow_bord_vector(qmckl_context context,
|
||||
double const * bord_vector,
|
||||
const int64_t size_max)
|
||||
{
|
||||
int32_t mask = 1 << 4;
|
||||
int32_t mask = 1 << 6;
|
||||
|
||||
<<pre2>>
|
||||
|
||||
@ -732,7 +755,7 @@ qmckl_set_jastrow_cord_vector(qmckl_context context,
|
||||
double const * cord_vector,
|
||||
const int64_t size_max)
|
||||
{
|
||||
int32_t mask = 1 << 5;
|
||||
int32_t mask = 1 << 7;
|
||||
|
||||
<<pre2>>
|
||||
|
||||
@ -800,7 +823,7 @@ qmckl_exit_code
|
||||
qmckl_set_jastrow_rescale_factor_ee(qmckl_context context,
|
||||
const double rescale_factor_ee) {
|
||||
|
||||
int32_t mask = 1 << 6;
|
||||
int32_t mask = 1 << 8;
|
||||
|
||||
<<pre2>>
|
||||
|
||||
@ -822,7 +845,7 @@ qmckl_set_jastrow_rescale_factor_en(qmckl_context context,
|
||||
const double* rescale_factor_en,
|
||||
const int64_t size_max) {
|
||||
|
||||
int32_t mask = 1 << 7;
|
||||
int32_t mask = 1 << 9;
|
||||
|
||||
<<pre2>>
|
||||
|
||||
@ -922,6 +945,108 @@ qmckl_exit_code qmckl_finalize_jastrow(qmckl_context context) {
|
||||
}
|
||||
#+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
|
||||
|
||||
#+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);
|
||||
#+end_src
|
||||
|
||||
# TODO Fortran interface
|
||||
|
||||
Along with these core functions, calculation of the jastrow factor
|
||||
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;
|
||||
assert (ctx != NULL);
|
||||
|
||||
int32_t mask = 1 << 0;
|
||||
int32_t mask = 1 << 1;
|
||||
|
||||
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
||||
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;
|
||||
assert (ctx != NULL);
|
||||
|
||||
int32_t mask = 1 << 0;
|
||||
int32_t mask = 1 << 2;
|
||||
|
||||
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
||||
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;
|
||||
assert (ctx != NULL);
|
||||
|
||||
int32_t mask = 1 << 1;
|
||||
int32_t mask = 1 << 3;
|
||||
|
||||
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
||||
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;
|
||||
assert (ctx != NULL);
|
||||
|
||||
int32_t mask = 1 << 2;
|
||||
int32_t mask = 1 << 4;
|
||||
|
||||
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
||||
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;
|
||||
assert (ctx != NULL);
|
||||
|
||||
int32_t mask = 1 << 3;
|
||||
int32_t mask = 1 << 5;
|
||||
|
||||
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
||||
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;
|
||||
assert (ctx != NULL);
|
||||
|
||||
int32_t mask = 1 << 4;
|
||||
int32_t mask = 1 << 6;
|
||||
|
||||
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
||||
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;
|
||||
assert (ctx != NULL);
|
||||
|
||||
int32_t mask = 1 << 5;
|
||||
int32_t mask = 1 << 7;
|
||||
|
||||
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
||||
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;
|
||||
assert (ctx != NULL);
|
||||
|
||||
int32_t mask = 1 << 6;
|
||||
int32_t mask = 1 << 8;
|
||||
|
||||
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
||||
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;
|
||||
assert (ctx != NULL);
|
||||
|
||||
int32_t mask = 1 << 7;
|
||||
int32_t mask = 1 << 9;
|
||||
|
||||
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
||||
return QMCKL_NOT_PROVIDED;
|
||||
@ -1658,7 +1785,13 @@ assert(!qmckl_jastrow_provided(context));
|
||||
|
||||
/* Set the data */
|
||||
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);
|
||||
rc = qmckl_check(context,
|
||||
@ -2986,7 +3119,6 @@ qmckl_exit_code qmckl_compute_factor_en (
|
||||
double* const factor_en );
|
||||
#+end_src
|
||||
|
||||
|
||||
*** Test
|
||||
#+begin_src python :results output :exports none :noweb yes
|
||||
import numpy as np
|
||||
|
||||
Loading…
Reference in New Issue
Block a user