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:
parent
51bddd0864
commit
c9e6bcdab1
130
org/qmckl_mykernel.org
Normal file
130
org/qmckl_mykernel.org
Normal 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
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user