From 908e52b855a0a94c6e793ea4ddf7ae3abac1565a Mon Sep 17 00:00:00 2001 From: Francois Coppens Date: Thu, 16 Sep 2021 17:24:19 +0200 Subject: [PATCH] All Fortran interfaces to C/C++ added and tested. Library and tests compile smoothly. --- org/qmckl_mykernel.org | 130 ------------------------ org/qmckl_sherman_morrison_woodbury.org | 130 +++++++++++++++++++++--- org/table_of_contents | 1 - 3 files changed, 115 insertions(+), 146 deletions(-) delete mode 100644 org/qmckl_mykernel.org diff --git a/org/qmckl_mykernel.org b/org/qmckl_mykernel.org deleted file mode 100644 index 9c807f0..0000000 --- a/org/qmckl_mykernel.org +++ /dev/null @@ -1,130 +0,0 @@ -#+TITLE: My Kernel -#+SETUPFILE: ../tools/theme.setup -#+INCLUDE: ../tools/lib.org -#+STARTUP: content - -* Headers - #+begin_src elisp :noexport :results none :exports 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 -#include - -int main() { - qmckl_context context; - context = qmckl_context_create(); - qmckl_exit_code rc; - #+end_src - -* My Kernel - -** ~qmckl_mykernel~ - :PROPERTIES: - :Name: qmckl_mykernel - :CRetType: qmckl_exit_code - :FRetType: qmckl_exit_code - :END: - - #+NAME: qmckl_mykernel_args - | qmckl_context | context | in | Global state | - | int64_t | myarg1 | in | The only input argument | - -*** Requirements - - * ~context~ is not ~QMCKL_NULL_CONTEXT~ - -*** C header - - #+CALL: generate_c_header(table=qmckl_mykernel_args,rettyp=get_value("CRetType"),fname=get_value("Name")) - - #+RESULTS: - #+begin_src c :tangle (eval h_func) :comments org - qmckl_exit_code qmckl_mykernel(const qmckl_context context, - const int64_t* myarg1); - #+end_src - -*** C source - - #+begin_src c :tangle (eval c) :comments org - #include - #include - #include "qmckl.h" - - qmckl_exit_code qmckl_mykernel_c_(const qmckl_context context, - const int64_t* myarg1) { - - printf("Hello from qmckl_mykernel_c_\n"); - printf("Value of argument 'myarg1' from within 'qmckl_mykernel_c_' is: %i\n", *myarg1); - return QMCKL_SUCCESS; -} - #+end_src - -** C interface :noexport: - :PROPERTIES: - :Name: qmckl_mykernel - :CRetType: qmckl_exit_code - :FRetType: qmckl_exit_code - :END: - - #+CALL: generate_c_interface(table=qmckl_mykernel_args,rettyp=get_value("FRetType"),fname=get_value("Name")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_mykernel(context, myarg1) 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) :: myarg1 - integer(c_int32_t) , external :: qmckl_mykernel_c - - write(*,*) "Hello from Fortran wrapper-function 'qmckl_mykernel'" - write(*,*) "Value of argument 'myarg1' from within 'qmckl_mykernel' before call to C-function 'qmckl_mykernel_c' is: ", myarg1 - info = qmckl_mykernel_c(context, myarg1) - write(*,*) "Value of argument 'myarg1' from within 'qmckl_mykernel' after call to C-function 'qmckl_mykernel_c' is: ", myarg1 - - end function qmckl_mykernel - #+end_src - - #+CALL: generate_f_interface(table=qmckl_mykernel_args,rettyp=get_value("FRetType"),fname=get_value("Name")) - - #+RESULTS: - #+begin_src f90 :tangle (eval fh_func) :comments org :exports none - interface - integer(c_int32_t) function qmckl_mykernel(context, myarg1) bind(C) - use, intrinsic :: iso_c_binding - import - implicit none - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) :: myarg1 - end function qmckl_mykernel - end interface - #+end_src - -*** Test :noexport: - - #+begin_src c :tangle (eval c_test) - const int64_t arg1 = 10; - const int64_t* arg1p = &arg1; - printf("Value of arg1 before passing to 'qmckl_mykernel': %i\n", arg1); - rc = qmckl_mykernel(context, arg1p); - assert(rc == QMCKL_SUCCESS); - #+end_src - -* End of files - - #+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 diff --git a/org/qmckl_sherman_morrison_woodbury.org b/org/qmckl_sherman_morrison_woodbury.org index 256affd..ad34d60 100644 --- a/org/qmckl_sherman_morrison_woodbury.org +++ b/org/qmckl_sherman_morrison_woodbury.org @@ -811,7 +811,7 @@ qmckl_exit_code qmckl_sherman_morrison_splitting_c_(const qmckl_context context, *breakdown, Slater_inv, later_updates, later_index, &later); if (later > 0) { - (void) qmckl_sherman_morrison_splitting_c_(context, Dim, later, + (void) qmckl_sherman_morrison_splitting_c_(context, Dim, &later, later_updates, later_index, breakdown, Slater_inv); } @@ -833,12 +833,59 @@ qmckl_exit_code qmckl_sherman_morrison_splitting_c_(const qmckl_context context, #+CALL: generate_c_interface(table=qmckl_sherman_morrison_splitting_args,rettyp=get_value("FRetType"),fname=get_value("Name")) + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_sherman_morrison_splitting & + (context, Dim, N_updates, Updates, Updates_index, breakdown, Slater_inv) & + 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) :: Dim + integer (c_int64_t) , intent(in) :: N_updates + real (c_double ) , intent(in) :: Updates(N_updates*Dim) + integer (c_int64_t) , intent(in) :: Updates_index(N_updates) + real (c_double ) , intent(in) :: breakdown + real (c_double ) , intent(inout) :: Slater_inv(Dim*Dim) + + integer(c_int32_t), external :: qmckl_sherman_morrison_splitting_c + info = qmckl_sherman_morrison_splitting_c & + (context, Dim, N_updates, Updates, Updates_index, breakdown, Slater_inv) + + end function qmckl_sherman_morrison_splitting + #+end_src + #+CALL: generate_f_interface(table=qmckl_sherman_morrison_splitting_args,rettyp=get_value("FRetType"),fname=get_value("Name")) + #+RESULTS: + #+begin_src f90 :tangle (eval fh_func) :comments org :exports none + interface + integer(c_int32_t) function qmckl_sherman_morrison_splitting & + (context, Dim, N_updates, Updates, Updates_index, breakdown, Slater_inv) & + bind(C) + use, intrinsic :: iso_c_binding + import + implicit none + + integer (c_int64_t) , intent(in) , value :: context + integer (c_int64_t) , intent(in) :: Dim + integer (c_int64_t) , intent(in) :: N_updates + real (c_double ) , intent(in) :: Updates(N_updates*Dim) + integer (c_int64_t) , intent(in) :: Updates_index(N_updates) + real (c_double ) , intent(in) :: breakdown + real (c_double ) , intent(inout) :: Slater_inv(Dim*Dim) + + end function qmckl_sherman_morrison_splitting + end interface + #+end_src + *** Test :noexport: #+begin_src c :tangle (eval c_test) -rc = qmckl_sherman_morrison_splitting_c(context, Dim, N_updates3, Updates3, Updates_index3, breakdown, Slater_inv3_2); +N_updates_p = &N_updates3; +rc = qmckl_sherman_morrison_splitting(context, Dim_p, N_updates_p, Updates3, Updates_index3, breakdown_p, Slater_inv3_2); for (unsigned int i = 0; i < Dim; i++) { for (unsigned int j = 0; j < Dim; j++) { res[i * Dim + j] = 0; @@ -901,14 +948,14 @@ assert(rc == QMCKL_SUCCESS); #+RESULTS: #+begin_src c :tangle (eval h_func) :comments org - qmckl_exit_code qmckl_sherman_morrison_smw32s_c ( + qmckl_exit_code qmckl_sherman_morrison_smw32s( const qmckl_context context, - const uint64_t Dim, - const uint64_t N_updates, + const uint64_t* Dim_p, + const uint64_t* N_updates_p, const double* Updates, const uint64_t* Updates_index, - const double breakdown, - double* Slater_inv ); + const double* breakdown_p, + double* Slater_inv); #+end_src *** Source @@ -917,14 +964,18 @@ assert(rc == QMCKL_SUCCESS); #include #include "qmckl.h" -qmckl_exit_code qmckl_sherman_morrison_smw32s_c(const qmckl_context context, - const uint64_t Dim, - const uint64_t N_updates, +qmckl_exit_code qmckl_sherman_morrison_smw32s_c_(const qmckl_context context, + const uint64_t* Dim_p, + const uint64_t* N_updates_p, const double* Updates, const uint64_t* Updates_index, - const double breakdown, + const double* breakdown_p, double * Slater_inv) { + const uint64_t Dim = *Dim_p; + const uint64_t N_updates = *N_updates_p; + const double breakdown = *breakdown_p; + qmckl_exit_code rc; uint64_t n_of_3blocks = N_updates / 3; @@ -950,7 +1001,8 @@ qmckl_exit_code qmckl_sherman_morrison_smw32s_c(const qmckl_context context, } } - if (remainder == 2) { // Apply last remaining block of 2 updates with Woodbury 2x2 kernel + // Apply last remaining block of 2 updates with Woodbury 2x2 kernel + if (remainder == 2) { const double *Updates_2block = &Updates[n_of_3blocks * length_3block]; const uint64_t *Updates_index_2block = &Updates_index[3 * n_of_3blocks]; rc = qmckl_woodbury_2_c_(context, &Dim, Updates_2block, Updates_index_2block, &breakdown, Slater_inv); @@ -961,7 +1013,8 @@ qmckl_exit_code qmckl_sherman_morrison_smw32s_c(const qmckl_context context, later = later + l; } } - else if (remainder == 1) { // Apply last remaining update with slagel_splitting + // Apply last remaining update with slagel_splitting + else if (remainder == 1) { const double *Updates_1block = &Updates[n_of_3blocks * length_3block]; const uint64_t *Updates_index_1block = &Updates_index[3 * n_of_3blocks]; uint64_t l = 0; @@ -971,7 +1024,7 @@ qmckl_exit_code qmckl_sherman_morrison_smw32s_c(const qmckl_context context, } if (later > 0) { - (void) qmckl_sherman_morrison_splitting_c(context, Dim, later, later_updates, later_index, breakdown, Slater_inv); + (void) qmckl_sherman_morrison_splitting_c_(context, &Dim, &later, later_updates, later_index, &breakdown, Slater_inv); } return QMCKL_SUCCESS; } @@ -991,12 +1044,59 @@ qmckl_exit_code qmckl_sherman_morrison_smw32s_c(const qmckl_context context, #+CALL: generate_c_interface(table=qmckl_sherman_morrison_smw32s_args,rettyp=get_value("FRetType"),fname=get_value("Name")) + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_sherman_morrison_smw32s & + (context, Dim, N_updates, Updates, Updates_index, breakdown, Slater_inv) & + 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) :: Dim + integer (c_int64_t) , intent(in) :: N_updates + real (c_double ) , intent(in) :: Updates(N_updates*Dim) + integer (c_int64_t) , intent(in) :: Updates_index(N_updates) + real (c_double ) , intent(in) :: breakdown + real (c_double ) , intent(inout) :: Slater_inv(Dim*Dim) + + integer(c_int32_t), external :: qmckl_sherman_morrison_smw32s_c + info = qmckl_sherman_morrison_smw32s_c & + (context, Dim, N_updates, Updates, Updates_index, breakdown, Slater_inv) + + end function qmckl_sherman_morrison_smw32s + #+end_src + #+CALL: generate_f_interface(table=qmckl_sherman_morrison_smw32s_args,rettyp=get_value("FRetType"),fname=get_value("Name")) + #+RESULTS: + #+begin_src f90 :tangle (eval fh_func) :comments org :exports none + interface + integer(c_int32_t) function qmckl_sherman_morrison_smw32s & + (context, Dim, N_updates, Updates, Updates_index, breakdown, Slater_inv) & + bind(C) + use, intrinsic :: iso_c_binding + import + implicit none + + integer (c_int64_t) , intent(in) , value :: context + integer (c_int64_t) , intent(in) :: Dim + integer (c_int64_t) , intent(in) :: N_updates + real (c_double ) , intent(in) :: Updates(N_updates*Dim) + integer (c_int64_t) , intent(in) :: Updates_index(N_updates) + real (c_double ) , intent(in) :: breakdown + real (c_double ) , intent(inout) :: Slater_inv(Dim*Dim) + + end function qmckl_sherman_morrison_smw32s + end interface + #+end_src + *** Test :noexport: #+begin_src c :tangle (eval c_test) -rc = qmckl_sherman_morrison_smw32s_c(context, Dim, N_updates5, Updates5, Updates_index5, breakdown, Slater_inv5_3); +N_updates_p = &N_updates5; +rc = qmckl_sherman_morrison_smw32s(context, Dim_p, N_updates_p, Updates5, Updates_index5, breakdown_p, Slater_inv5_3); for (unsigned int i = 0; i < Dim; i++) { for (unsigned int j = 0; j < Dim; j++) { res[i * Dim + j] = 0; diff --git a/org/table_of_contents b/org/table_of_contents index 7aa7dc6..dfc6f52 100644 --- a/org/table_of_contents +++ b/org/table_of_contents @@ -7,7 +7,6 @@ qmckl_nucleus.org qmckl_electron.org qmckl_ao.org qmckl_jastrow.org -qmckl_mykernel.org qmckl_sherman_morrison_woodbury.org qmckl_distance.org qmckl_utils.org