mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2025-01-03 18:16:28 +01:00
All Fortran interfaces to C/C++ added and tested. Library and tests compile smoothly.
This commit is contained in:
Francois Coppens
parent
c9e6bcdab1
commit
908e52b855
@ -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
|
||||
@ -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 <stdbool.h>
|
||||
#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;
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user