From d69e4ca2a525144dfda4d063b2db0ba1d2167d4e Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 14 Nov 2022 14:57:16 +0100 Subject: [PATCH] Introduce Fortran interface for Jastrow --- org/qmckl_jastrow.org | 190 +++++++++++++++++++++++++++++++++++------- 1 file changed, 161 insertions(+), 29 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index 1744358..768086d 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -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; + + <> +} + +qmckl_exit_code +qmckl_set_jastrow_bord_num(qmckl_context context, const int64_t bord_num) +{ + + int32_t mask = 1 << 1; + +<> + 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; + + <> +} + +qmckl_exit_code +qmckl_set_jastrow_cord_num(qmckl_context context, const int64_t cord_num) +{ + + int32_t mask = 1 << 2; + +<> + 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; <> @@ -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; <> @@ -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; <> @@ -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; <> @@ -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; <> @@ -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; <> @@ -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; <> @@ -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; <> @@ -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