mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2025-01-03 10:06:09 +01:00
Auto-generate interfaces
This commit is contained in:
parent
ff8330f8f9
commit
33f33fcdf3
@ -13,3 +13,4 @@
|
||||
#+LANGUAGE: en
|
||||
|
||||
|
||||
|
||||
|
||||
344
src/qmckl_ao.org
344
src/qmckl_ao.org
@ -34,6 +34,10 @@ In this section we describe the kernels used to compute the values,
|
||||
gradients and Laplacian of the atomic basis functions.
|
||||
|
||||
* Headers :noexport:
|
||||
#+begin_src elisp :noexport :results none
|
||||
(org-babel-lob-ingest "../tools/lib.org")
|
||||
#+end_src
|
||||
|
||||
|
||||
#+begin_src c :tangle (eval h_private_type)
|
||||
#ifndef QMCKL_AO_HPT
|
||||
@ -759,11 +763,13 @@ qmckl_exit_code qmckl_set_ao_basis_coefficient(qmckl_context context, const dou
|
||||
|
||||
#+end_src
|
||||
|
||||
|
||||
|
||||
* Polynomial part
|
||||
|
||||
** Powers of $x-X_i$
|
||||
:PROPERTIES:
|
||||
:Name: qmckl_ao_power
|
||||
:CRetType: qmckl_exit_code
|
||||
:FRetType: qmckl_exit_code
|
||||
:END:
|
||||
|
||||
The ~qmckl_ao_power~ function computes all the powers of the ~n~
|
||||
input data up to the given maximum value given in input for each of
|
||||
@ -771,33 +777,41 @@ qmckl_exit_code qmckl_set_ao_basis_coefficient(qmckl_context context, const dou
|
||||
|
||||
\[ P_{ik} = X_i^k \]
|
||||
|
||||
| ~context~ | input | Global state |
|
||||
| ~n~ | input | Number of values |
|
||||
| ~X(n)~ | input | Array containing the input values |
|
||||
| ~LMAX(n)~ | input | Array containing the maximum power for each value |
|
||||
| ~P(LDP,n)~ | output | Array containing all the powers of ~X~ |
|
||||
| ~LDP~ | input | Leading dimension of array ~P~ |
|
||||
#+NAME: qmckl_ao_power_args
|
||||
| qmckl_context | context | in | Global state |
|
||||
| int64_t | n | in | Number of values |
|
||||
| double | X[n] | in | Array containing the input values |
|
||||
| int32_t | LMAX[n] | in | Array containing the maximum power for each value |
|
||||
| double | P[n][ldp] | out | Array containing all the powers of ~X~ |
|
||||
| int64_t | ldp | in | Leading dimension of array ~P~ |
|
||||
|
||||
Requirements:
|
||||
*** Requirements:
|
||||
|
||||
- ~context~ is not ~QMCKL_NULL_CONTEXT~
|
||||
- ~n~ > 0
|
||||
- ~X~ is allocated with at least $n \times 8$ bytes
|
||||
- ~LMAX~ is allocated with at least $n \times 4$ bytes
|
||||
- ~P~ is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes
|
||||
- ~LDP~ >= $\max_i$ ~LMAX[i]~
|
||||
- ~context~ is not ~QMCKL_NULL_CONTEXT~
|
||||
- ~n~ > 0
|
||||
- ~X~ is allocated with at least $n \times 8$ bytes
|
||||
- ~LMAX~ is allocated with at least $n \times 4$ bytes
|
||||
- ~P~ is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes
|
||||
- ~LDP~ >= $\max_i$ ~LMAX[i]~
|
||||
|
||||
#+begin_src c :tangle (eval h_func)
|
||||
qmckl_exit_code
|
||||
qmckl_ao_power(const qmckl_context context,
|
||||
const int64_t n,
|
||||
const double *X,
|
||||
const int32_t *LMAX,
|
||||
const double *P,
|
||||
const int64_t LDP);
|
||||
#+end_src
|
||||
*** C Header
|
||||
|
||||
#+begin_src f90 :tangle (eval f)
|
||||
#+CALL: generate_c_header(table=qmckl_ao_power_args,rettyp=get_value("CRetType"),fname="qmckl_ao_power")
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src c :tangle (eval h_func) :comments org
|
||||
qmckl_exit_code qmckl_ao_power (
|
||||
const qmckl_context context,
|
||||
const int64_t n,
|
||||
const double* X,
|
||||
const int32_t* LMAX,
|
||||
double* const P,
|
||||
const int64_t ldp );
|
||||
#+end_src
|
||||
|
||||
*** Source
|
||||
|
||||
#+begin_src f90 :tangle (eval f)
|
||||
integer function qmckl_ao_power_f(context, n, X, LMAX, P, ldp) result(info)
|
||||
use qmckl
|
||||
implicit none
|
||||
@ -841,41 +855,62 @@ integer function qmckl_ao_power_f(context, n, X, LMAX, P, ldp) result(info)
|
||||
end do
|
||||
|
||||
end function qmckl_ao_power_f
|
||||
#+end_src
|
||||
#+end_src
|
||||
|
||||
#+begin_src f90 :tangle (eval f) :exports none
|
||||
integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) &
|
||||
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) , value :: n
|
||||
real (c_double) , intent(in) :: X(n)
|
||||
integer (c_int32_t) , intent(in) :: LMAX(n)
|
||||
real (c_double) , intent(out) :: P(ldp,n)
|
||||
integer (c_int64_t) , intent(in) , value :: ldp
|
||||
*** C interface
|
||||
#+CALL: generate_c_interface(table=qmckl_ao_power_args,rettyp=get_value("CRetType"),fname="qmckl_ao_power")
|
||||
|
||||
integer, external :: qmckl_ao_power_f
|
||||
info = qmckl_ao_power_f(context, n, X, LMAX, P, ldp)
|
||||
end function qmckl_ao_power
|
||||
#+end_src
|
||||
#+RESULTS:
|
||||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||||
integer(c_int32_t) function qmckl_ao_power &
|
||||
(context, n, X, LMAX, P, ldp) &
|
||||
bind(C) result(info)
|
||||
|
||||
#+begin_src f90 :tangle (eval fh_func) :exports none
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
integer (c_int64_t) , intent(in) , value :: context
|
||||
integer (c_int64_t) , intent(in) , value :: n
|
||||
integer (c_int64_t) , intent(in) , value :: ldp
|
||||
real (c_double) , intent(in) :: X(n)
|
||||
integer (c_int32_t) , intent(in) :: LMAX(n)
|
||||
real (c_double) , intent(out) :: P(ldp,n)
|
||||
end function qmckl_ao_power
|
||||
end interface
|
||||
#+end_src
|
||||
use, intrinsic :: iso_c_binding
|
||||
implicit none
|
||||
|
||||
# Test
|
||||
#+begin_src f90 :tangle (eval f_test)
|
||||
integer (c_int64_t) , intent(in) , value :: context
|
||||
integer (c_int64_t) , intent(in) , value :: n
|
||||
real (c_double ) , intent(in) :: X(n)
|
||||
integer (c_int32_t) , intent(in) :: LMAX(n)
|
||||
real (c_double ) , intent(out) :: P(ldp,n)
|
||||
integer (c_int64_t) , intent(in) , value :: ldp
|
||||
|
||||
integer(c_int32_t), external :: qmckl_ao_power_f
|
||||
info = qmckl_ao_power_f &
|
||||
(context, n, X, LMAX, P, ldp)
|
||||
|
||||
end function qmckl_ao_power
|
||||
#+end_src
|
||||
|
||||
*** Fortran interface
|
||||
|
||||
#+CALL: generate_f_interface(table=qmckl_ao_power_args,rettyp=get_value("CRetType"),fname="qmckl_ao_power")
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_ao_power &
|
||||
(context, n, X, LMAX, P, ldp) &
|
||||
bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
implicit none
|
||||
|
||||
integer (c_int64_t) , intent(in) , value :: context
|
||||
integer (c_int64_t) , intent(in) , value :: n
|
||||
real (c_double ) , intent(in) :: X(n)
|
||||
integer (c_int32_t) , intent(in) :: LMAX(n)
|
||||
real (c_double ) , intent(out) :: P(ldp,n)
|
||||
integer (c_int64_t) , intent(in) , value :: ldp
|
||||
|
||||
end function qmckl_ao_power
|
||||
end interface
|
||||
#+end_src
|
||||
|
||||
*** Test
|
||||
|
||||
#+begin_src f90 :tangle (eval f_test)
|
||||
integer(c_int32_t) function test_qmckl_ao_power(context) bind(C)
|
||||
use qmckl
|
||||
implicit none
|
||||
@ -919,14 +954,19 @@ integer(c_int32_t) function test_qmckl_ao_power(context) bind(C)
|
||||
test_qmckl_ao_power = QMCKL_SUCCESS
|
||||
deallocate(X,P,LMAX)
|
||||
end function test_qmckl_ao_power
|
||||
#+end_src
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval c_test) :exports none
|
||||
#+begin_src c :tangle (eval c_test) :exports none
|
||||
int test_qmckl_ao_power(qmckl_context context);
|
||||
munit_assert_int(0, ==, test_qmckl_ao_power(context));
|
||||
#+end_src
|
||||
#+end_src
|
||||
|
||||
** Value, Gradient and Laplacian of a polynomial
|
||||
:PROPERTIES:
|
||||
:Name: qmckl_ao_polynomial_vgl
|
||||
:CRetType: qmckl_exit_code
|
||||
:FRetType: qmckl_exit_code
|
||||
:END:
|
||||
|
||||
A polynomial is centered on a nucleus $\mathbf{R}_i$
|
||||
|
||||
@ -961,51 +1001,56 @@ munit_assert_int(0, ==, test_qmckl_ao_power(context));
|
||||
Laplacians at a given point in space, of all polynomials with an
|
||||
angular momentum up to ~lmax~.
|
||||
|
||||
| ~context~ | input | Global state |
|
||||
| ~X(3)~ | input | Array containing the coordinates of the points |
|
||||
| ~R(3)~ | input | Array containing the x,y,z coordinates of the center |
|
||||
| ~lmax~ | input | Maximum angular momentum |
|
||||
| ~n~ | output | Number of computed polynomials |
|
||||
| ~L(ldl,n)~ | output | Contains a,b,c for all ~n~ results |
|
||||
| ~ldl~ | input | Leading dimension of ~L~ |
|
||||
| ~VGL(ldv,n)~ | output | Value, gradients and Laplacian of the polynomials |
|
||||
| ~ldv~ | input | Leading dimension of array ~VGL~ |
|
||||
#+NAME: qmckl_ao_polynomial_vgl_args
|
||||
| qmckl_context | context | in | Global state |
|
||||
| double | X[3] | in | Array containing the coordinates of the points |
|
||||
| double | R[3] | in | Array containing the x,y,z coordinates of the center |
|
||||
| int32_t | lmax | in | Maximum angular momentum |
|
||||
| int64_t | n | inout | Number of computed polynomials |
|
||||
| int32_t | L[n][ldl] | out | Contains a,b,c for all ~n~ results |
|
||||
| int64_t | ldl | in | Leading dimension of ~L~ |
|
||||
| double | VGL[n][ldv] | out | Value, gradients and Laplacian of the polynomials |
|
||||
| int64_t | ldv | in | Leading dimension of array ~VGL~ |
|
||||
|
||||
Requirements:
|
||||
*** Requirements:
|
||||
|
||||
- ~context~ is not ~QMCKL_NULL_CONTEXT~
|
||||
- ~n~ > 0
|
||||
- ~lmax~ >= 0
|
||||
- ~ldl~ >= 3
|
||||
- ~ldv~ >= 5
|
||||
- ~X~ is allocated with at least $3 \times 8$ bytes
|
||||
- ~R~ is allocated with at least $3 \times 8$ bytes
|
||||
- ~n~ >= ~(lmax+1)(lmax+2)(lmax+3)/6~
|
||||
- ~L~ is allocated with at least $3 \times n \times 4$ bytes
|
||||
- ~VGL~ is allocated with at least $5 \times n \times 8$ bytes
|
||||
- On output, ~n~ should be equal to ~(lmax+1)(lmax+2)(lmax+3)/6~
|
||||
- On output, the powers are given in the following order (l=a+b+c):
|
||||
- Increasing values of ~l~
|
||||
- Within a given value of ~l~, alphabetical order of the
|
||||
string made by a*"x" + b*"y" + c*"z" (in Python notation).
|
||||
For example, with a=0, b=2 and c=1 the string is "yyz"
|
||||
- ~context~ is not ~QMCKL_NULL_CONTEXT~
|
||||
- ~n~ > 0
|
||||
- ~lmax~ >= 0
|
||||
- ~ldl~ >= 3
|
||||
- ~ldv~ >= 5
|
||||
- ~X~ is allocated with at least $3 \times 8$ bytes
|
||||
- ~R~ is allocated with at least $3 \times 8$ bytes
|
||||
- ~n~ >= ~(lmax+1)(lmax+2)(lmax+3)/6~
|
||||
- ~L~ is allocated with at least $3 \times n \times 4$ bytes
|
||||
- ~VGL~ is allocated with at least $5 \times n \times 8$ bytes
|
||||
- On output, ~n~ should be equal to ~(lmax+1)(lmax+2)(lmax+3)/6~
|
||||
- On output, the powers are given in the following order (l=a+b+c):
|
||||
- Increasing values of ~l~
|
||||
- Within a given value of ~l~, alphabetical order of the
|
||||
string made by a*"x" + b*"y" + c*"z" (in Python notation).
|
||||
For example, with a=0, b=2 and c=1 the string is "yyz"
|
||||
|
||||
# Header
|
||||
#+begin_src c :tangle (eval h_func)
|
||||
qmckl_exit_code
|
||||
qmckl_ao_polynomial_vgl(const qmckl_context context,
|
||||
const double *X,
|
||||
const double *R,
|
||||
const int32_t lmax,
|
||||
const int64_t *n,
|
||||
const int32_t *L,
|
||||
const int64_t ldl,
|
||||
const double *VGL,
|
||||
const int64_t ldv);
|
||||
#+end_src
|
||||
*** C Header
|
||||
|
||||
# Source
|
||||
#+begin_src f90 :tangle (eval f)
|
||||
#+CALL: generate_c_header(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src c :tangle (eval h_func) :comments org
|
||||
qmckl_exit_code qmckl_ao_polynomial_vgl (
|
||||
const qmckl_context context,
|
||||
const double* X,
|
||||
const double* R,
|
||||
const int32_t lmax,
|
||||
int64_t* n,
|
||||
int32_t* const L,
|
||||
const int64_t ldl,
|
||||
double* const VGL,
|
||||
const int64_t ldv );
|
||||
#+end_src
|
||||
|
||||
*** Source
|
||||
#+begin_src f90 :tangle (eval f)
|
||||
integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) result(info)
|
||||
use qmckl
|
||||
implicit none
|
||||
@ -1133,46 +1178,69 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL,
|
||||
info = QMCKL_SUCCESS
|
||||
|
||||
end function qmckl_ao_polynomial_vgl_f
|
||||
#+end_src
|
||||
#+end_src
|
||||
|
||||
*** C interface
|
||||
|
||||
#+begin_src f90 :tangle (eval f) :exports none
|
||||
integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) &
|
||||
bind(C) result(info)
|
||||
use, intrinsic :: iso_c_binding
|
||||
implicit none
|
||||
integer (c_int64_t) , intent(in) , value :: context
|
||||
real (c_double) , intent(in) :: X(3), R(3)
|
||||
integer (c_int32_t) , intent(in) , value :: lmax
|
||||
integer (c_int64_t) , intent(out) :: n
|
||||
integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6)
|
||||
integer (c_int64_t) , intent(in) , value :: ldl
|
||||
real (c_double) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6)
|
||||
integer (c_int64_t) , intent(in) , value :: ldv
|
||||
#+CALL: generate_c_interface(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
||||
|
||||
integer, external :: qmckl_ao_polynomial_vgl_f
|
||||
info = qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv)
|
||||
end function qmckl_ao_polynomial_vgl
|
||||
#+end_src
|
||||
#+RESULTS:
|
||||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||||
integer(c_int32_t) function qmckl_ao_polynomial_vgl &
|
||||
(context, X, R, lmax, n, L, ldl, VGL, ldv) &
|
||||
bind(C) result(info)
|
||||
|
||||
#+begin_src f90 :tangle (eval fh_func) :exports none
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) &
|
||||
use, intrinsic :: iso_c_binding
|
||||
implicit none
|
||||
|
||||
integer (c_int64_t) , intent(in) , value :: context
|
||||
real (c_double ) , intent(in) :: X(3)
|
||||
real (c_double ) , intent(in) :: R(3)
|
||||
integer (c_int32_t) , intent(in) , value :: lmax
|
||||
integer (c_int64_t) , intent(inout) :: n
|
||||
integer (c_int32_t) , intent(out) :: L(ldl,n)
|
||||
integer (c_int64_t) , intent(in) , value :: ldl
|
||||
real (c_double ) , intent(out) :: VGL(ldv,n)
|
||||
integer (c_int64_t) , intent(in) , value :: ldv
|
||||
|
||||
integer(c_int32_t), external :: qmckl_ao_polynomial_vgl_f
|
||||
info = qmckl_ao_polynomial_vgl_f &
|
||||
(context, X, R, lmax, n, L, ldl, VGL, ldv)
|
||||
|
||||
end function qmckl_ao_polynomial_vgl
|
||||
#+end_src
|
||||
|
||||
*** Fortran interface
|
||||
|
||||
#+CALL: generate_f_interface(table=qmckl_ao_polynomial_vgl_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_ao_polynomial_vgl &
|
||||
(context, X, R, lmax, n, L, ldl, VGL, ldv) &
|
||||
bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
integer (c_int64_t) , intent(in) , value :: context
|
||||
integer (c_int32_t) , intent(in) , value :: lmax
|
||||
integer (c_int64_t) , intent(in) , value :: ldl
|
||||
integer (c_int64_t) , intent(in) , value :: ldv
|
||||
real (c_double) , intent(in) :: X(3), R(3)
|
||||
integer (c_int64_t) , intent(out) :: n
|
||||
integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6)
|
||||
real (c_double) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6)
|
||||
end function qmckl_ao_polynomial_vgl
|
||||
end interface
|
||||
#+end_src
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
implicit none
|
||||
|
||||
#+begin_src f90 :tangle (eval f_test)
|
||||
integer (c_int64_t) , intent(in) , value :: context
|
||||
real (c_double ) , intent(in) :: X(3)
|
||||
real (c_double ) , intent(in) :: R(3)
|
||||
integer (c_int32_t) , intent(in) , value :: lmax
|
||||
integer (c_int64_t) , intent(inout) :: n
|
||||
integer (c_int32_t) , intent(out) :: L(ldl,n)
|
||||
integer (c_int64_t) , intent(in) , value :: ldl
|
||||
real (c_double ) , intent(out) :: VGL(ldv,n)
|
||||
integer (c_int64_t) , intent(in) , value :: ldv
|
||||
|
||||
end function qmckl_ao_polynomial_vgl
|
||||
end interface
|
||||
#+end_src
|
||||
|
||||
*** Test
|
||||
|
||||
#+begin_src f90 :tangle (eval f_test)
|
||||
integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
|
||||
use qmckl
|
||||
implicit none
|
||||
@ -1262,12 +1330,12 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
|
||||
|
||||
deallocate(L,VGL)
|
||||
end function test_qmckl_ao_polynomial_vgl
|
||||
#+end_src
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval c_test)
|
||||
#+begin_src c :tangle (eval c_test)
|
||||
int test_qmckl_ao_polynomial_vgl(qmckl_context context);
|
||||
munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context));
|
||||
#+end_src
|
||||
#+end_src
|
||||
|
||||
* Gaussian basis functions
|
||||
|
||||
|
||||
@ -212,12 +212,12 @@ end function qmckl_distance_sq_f
|
||||
This function might be more efficient when ~A~ and ~B~ are
|
||||
transposed.
|
||||
|
||||
*** C interface :noexport:
|
||||
** C interface :noexport:
|
||||
|
||||
#+CALL: generate_c_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name"))
|
||||
#+CALL: generate_c_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name"))
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||||
#+RESULTS:
|
||||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||||
integer (c_int32_t) function qmckl_distance_sq &
|
||||
(context, transa, transb, m, n, A, lda, B, ldb, C, ldc) &
|
||||
bind(C) result(info)
|
||||
@ -241,12 +241,12 @@ end function qmckl_distance_sq_f
|
||||
(context, transa, transb, m, n, A, lda, B, ldb, C, ldc)
|
||||
|
||||
end function qmckl_distance_sq
|
||||
#+end_src
|
||||
#+end_src
|
||||
|
||||
#+CALL: generate_f_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name"))
|
||||
#+CALL: generate_f_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name"))
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
|
||||
#+RESULTS:
|
||||
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
|
||||
interface
|
||||
integer (qmckl_exit_code) function qmckl_distance_sq &
|
||||
(context, transa, transb, m, n, A, lda, B, ldb, C, ldc) &
|
||||
@ -269,7 +269,7 @@ end function qmckl_distance_sq_f
|
||||
|
||||
end function qmckl_distance_sq
|
||||
end interface
|
||||
#+end_src
|
||||
#+end_src
|
||||
|
||||
*** Test :noexport:
|
||||
#+begin_src f90 :tangle (eval f_test)
|
||||
|
||||
@ -38,8 +38,8 @@
|
||||
#+NAME:f_of_c
|
||||
#+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none"
|
||||
f_of_c_d = { '' : ''
|
||||
, 'qmckl_context' : 'integer (qmckl_context)'
|
||||
, 'qmckl_exit_code' : 'integer (qmckl_exit_code)'
|
||||
, 'qmckl_context' : 'integer (c_int64_t)'
|
||||
, 'qmckl_exit_code' : 'integer (c_int32_t)'
|
||||
, 'int32_t' : 'integer (c_int32_t)'
|
||||
, 'int64_t' : 'integer (c_int64_t)'
|
||||
, 'float' : 'real (c_float )'
|
||||
@ -48,11 +48,16 @@ f_of_c_d = { '' : ''
|
||||
}
|
||||
#+END_SRC
|
||||
|
||||
#+RESULTS: f_of_c
|
||||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||||
None
|
||||
#+end_src
|
||||
|
||||
#+NAME:c_of_f
|
||||
#+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none"
|
||||
ctypeid_d = { '' : ''
|
||||
, 'qmckl_context' : 'integer (qmckl_context)'
|
||||
, 'qmckl_exit_code' : 'integer (qmckl_exit_code)'
|
||||
, 'qmckl_context' : 'integer(c_int64_t)'
|
||||
, 'qmckl_exit_code' : 'integer(c_int32_t)'
|
||||
, 'integer' : 'integer(c_int32_t)'
|
||||
, 'integer*8' : 'integer(c_int64_t)'
|
||||
, 'real' : 'real(c_float)'
|
||||
@ -61,6 +66,11 @@ ctypeid_d = { '' : ''
|
||||
}
|
||||
#+END_SRC
|
||||
|
||||
#+RESULTS: c_of_f
|
||||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||||
None
|
||||
#+end_src
|
||||
|
||||
*** Parse the table
|
||||
|
||||
#+NAME: parse_table
|
||||
@ -108,16 +118,19 @@ for d in parse_table(table):
|
||||
c_type = d["c_type"]
|
||||
|
||||
# Add star for arrays
|
||||
if d["rank"] > 0:
|
||||
if d["rank"] > 0 or d["inout"] in ["out", "inout"]:
|
||||
c_type += "*"
|
||||
|
||||
if d["inout"] == "out":
|
||||
c_type += " const"
|
||||
|
||||
# Only inputs are const
|
||||
if d["inout"] == "in":
|
||||
const = "const"
|
||||
const = "const "
|
||||
else:
|
||||
const = " "
|
||||
const = ""
|
||||
|
||||
results += [ f" {const} {c_type} {name}" ]
|
||||
results += [ f" {const}{c_type} {name}" ]
|
||||
|
||||
results=',\n'.join(results)
|
||||
template = f"""{rettyp} {fname} (
|
||||
@ -128,8 +141,18 @@ return template
|
||||
|
||||
#+RESULTS: generate_c_header
|
||||
#+begin_src c :tangle (eval h_func) :comments org
|
||||
[] [] (
|
||||
);
|
||||
[] [] (
|
||||
const qmckl_context context,
|
||||
const char transa,
|
||||
const char transb,
|
||||
const int64_t m,
|
||||
const int64_t n,
|
||||
const double* const A,
|
||||
const int64_t lda,
|
||||
const double* const B,
|
||||
const int64_t ldb,
|
||||
double* const C,
|
||||
const int64_t ldc );
|
||||
#+end_src
|
||||
|
||||
*** Generates a C interface to the Fortran function
|
||||
@ -150,7 +173,6 @@ results = [ f"{rettyp_c} function {fname} &"
|
||||
, " bind(C) result(info)"
|
||||
, ""
|
||||
, " use, intrinsic :: iso_c_binding"
|
||||
, " import"
|
||||
, " implicit none"
|
||||
, ""
|
||||
]
|
||||
@ -161,7 +183,7 @@ for d in parse_table(table):
|
||||
name = d["name"]
|
||||
|
||||
# Input scalars are passed by value
|
||||
if d["rank"] == 0 and inout == "in":
|
||||
if d["rank"] == 0 and d["inout"] == "in":
|
||||
value = ", value"
|
||||
else:
|
||||
value = " "
|
||||
@ -189,7 +211,7 @@ return results
|
||||
*** Generates a Fortran interface to the C function
|
||||
|
||||
#+NAME: generate_f_interface
|
||||
#+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval fh) :comments org :exports none"
|
||||
#+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval fh_func) :comments org :exports none"
|
||||
<<c_of_f>>
|
||||
<<f_of_c>>
|
||||
<<parse_table>>
|
||||
@ -215,7 +237,7 @@ for d in parse_table(table):
|
||||
name = d["name"]
|
||||
|
||||
# Input scalars are passed by value
|
||||
if d["rank"] == 0 and inout == "in":
|
||||
if d["rank"] == 0 and d["inout"] == "in":
|
||||
value = ", value"
|
||||
else:
|
||||
value = " "
|
||||
@ -237,6 +259,29 @@ results='\n'.join(results)
|
||||
return results
|
||||
#+END_SRC
|
||||
|
||||
#+RESULTS: generate_c_interface
|
||||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||||
#+RESULTS: generate_f_interface
|
||||
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
|
||||
interface
|
||||
integer(c_int32_t) function [] &
|
||||
(context, transa, transb, m, n, A, lda, B, ldb, C, ldc) &
|
||||
bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
implicit none
|
||||
|
||||
integer (qmckl_context), intent(in) , value :: context
|
||||
character , intent(in) , value :: transa
|
||||
character , intent(in) , value :: transb
|
||||
integer (c_int64_t) , intent(in) , value :: m
|
||||
integer (c_int64_t) , intent(in) , value :: n
|
||||
real (c_double ) , intent(in) :: A(lda,3)
|
||||
integer (c_int64_t) , intent(in) , value :: lda
|
||||
real (c_double ) , intent(in) :: B(ldb,3)
|
||||
integer (c_int64_t) , intent(in) , value :: ldb
|
||||
real (c_double ) , intent(out) :: C(ldc,n)
|
||||
integer (c_int64_t) , intent(in) , value :: ldc
|
||||
|
||||
end function []
|
||||
end interface
|
||||
#+end_src
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user