1
0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-12-23 04:44:03 +01:00

Almost done with fixing interfaces.

This commit is contained in:
Francois Coppens 2021-09-16 13:44:12 +02:00
parent 51bddd0864
commit c9e6bcdab1
3 changed files with 282 additions and 66 deletions

130
org/qmckl_mykernel.org Normal file
View File

@ -0,0 +1,130 @@
#+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

File diff suppressed because one or more lines are too long

View File

@ -7,6 +7,7 @@ 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