TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2025-01-03 18:16:28 +01:00
Code Issues Projects Releases Wiki Activity

All Fortran interfaces to C/C++ added and tested. Library and tests compile smoothly.

Browse Source
This commit is contained in:
Francois Coppens 2021-09-16 17:24:19 +02:00
parent c9e6bcdab1
commit 908e52b855
3 changed files with 115 additions and 146 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

130
org/qmckl_mykernel.org
View File

@ -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 <stdio.h>
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 <stdbool.h>
#include <stdio.h>
#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

130
org/qmckl_sherman_morrison_woodbury.org
View File

@ -811,7 +811,7 @@ qmckl_exit_code qmckl_sherman_morrison_splitting_c_(const qmckl_context context,
*breakdown, Slater_inv, later_updates, later_index, &later); *breakdown, Slater_inv, later_updates, later_index, &later);
if (later > 0) { 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); 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")) #+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")) #+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: *** Test :noexport:
#+begin_src c :tangle (eval c_test) #+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 i = 0; i < Dim; i++) {
for (unsigned int j = 0; j < Dim; j++) { for (unsigned int j = 0; j < Dim; j++) {
res[i * Dim + j] = 0; res[i * Dim + j] = 0;
@ -901,14 +948,14 @@ assert(rc == QMCKL_SUCCESS);
#+RESULTS: #+RESULTS:
#+begin_src c :tangle (eval h_func) :comments org #+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 qmckl_context context,
const uint64_t Dim, const uint64_t* Dim_p,
const uint64_t N_updates, const uint64_t* N_updates_p,
const double* Updates, const double* Updates,
const uint64_t* Updates_index, const uint64_t* Updates_index,
const double breakdown, const double* breakdown_p,
double* Slater_inv ); double* Slater_inv);
#+end_src #+end_src
*** Source *** Source
@ -917,14 +964,18 @@ assert(rc == QMCKL_SUCCESS);
#include <stdbool.h> #include <stdbool.h>
#include "qmckl.h" #include "qmckl.h"
qmckl_exit_code qmckl_sherman_morrison_smw32s_c(const qmckl_context context, qmckl_exit_code qmckl_sherman_morrison_smw32s_c_(const qmckl_context context,
const uint64_t Dim, const uint64_t* Dim_p,
const uint64_t N_updates, const uint64_t* N_updates_p,
const double* Updates, const double* Updates,
const uint64_t* Updates_index, const uint64_t* Updates_index,
const double breakdown, const double* breakdown_p,
double * Slater_inv) { 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; qmckl_exit_code rc;
uint64_t n_of_3blocks = N_updates / 3; 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 double *Updates_2block = &Updates[n_of_3blocks * length_3block];
const uint64_t *Updates_index_2block = &Updates_index[3 * n_of_3blocks]; 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); 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; 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 double *Updates_1block = &Updates[n_of_3blocks * length_3block];
const uint64_t *Updates_index_1block = &Updates_index[3 * n_of_3blocks]; const uint64_t *Updates_index_1block = &Updates_index[3 * n_of_3blocks];
uint64_t l = 0; uint64_t l = 0;
@ -971,7 +1024,7 @@ qmckl_exit_code qmckl_sherman_morrison_smw32s_c(const qmckl_context context,
} }
if (later > 0) { 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; 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")) #+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")) #+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: *** Test :noexport:
#+begin_src c :tangle (eval c_test) #+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 i = 0; i < Dim; i++) {
for (unsigned int j = 0; j < Dim; j++) { for (unsigned int j = 0; j < Dim; j++) {
res[i * Dim + j] = 0; res[i * Dim + j] = 0;

1
org/table_of_contents
View File

@ -7,7 +7,6 @@ qmckl_nucleus.org
qmckl_electron.org qmckl_electron.org
qmckl_ao.org qmckl_ao.org
qmckl_jastrow.org qmckl_jastrow.org
qmckl_mykernel.org
qmckl_sherman_morrison_woodbury.org qmckl_sherman_morrison_woodbury.org
qmckl_distance.org qmckl_distance.org
qmckl_utils.org qmckl_utils.org