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_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
|
||||||
|
Loading…
Reference in New Issue
Block a user