mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-08-25 06:31:45 +02:00
Merge pull request #107 from fmgjcoppens/generate_private
Generate private C-header / Fortran interface
This commit is contained in:
commit
0834c77946
@ -58,8 +58,8 @@
|
|||||||
(add-hook 'org-babel-after-execute-hook 'org-display-inline-images)
|
(add-hook 'org-babel-after-execute-hook 'org-display-inline-images)
|
||||||
'(indent-tabs-mode nil)
|
'(indent-tabs-mode nil)
|
||||||
|
|
||||||
(require 'evil)
|
|
||||||
(setq evil-want-C-i-jump nil)
|
(setq evil-want-C-i-jump nil)
|
||||||
|
(require 'evil)
|
||||||
(evil-mode 1)
|
(evil-mode 1)
|
||||||
(global-font-lock-mode t)
|
(global-font-lock-mode t)
|
||||||
(global-superword-mode 1)
|
(global-superword-mode 1)
|
||||||
|
@ -32,7 +32,6 @@
|
|||||||
| ~C~ | ~double[n][ldc]~ | out | Array containing the $m \times n$ matrix $C$ |
|
| ~C~ | ~double[n][ldc]~ | out | Array containing the $m \times n$ matrix $C$ |
|
||||||
| ~ldc~ | ~int64_t~ | in | Leading dimension of array ~C~ |
|
| ~ldc~ | ~int64_t~ | in | Leading dimension of array ~C~ |
|
||||||
|
|
||||||
|
|
||||||
*** Fortran-C type conversions
|
*** Fortran-C type conversions
|
||||||
|
|
||||||
#+NAME:f_of_c
|
#+NAME:f_of_c
|
||||||
@ -132,21 +131,35 @@ return template
|
|||||||
|
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
#+RESULTS: generate_c_header
|
#+NAME: generate_private_c_header
|
||||||
#+begin_src c :tangle (eval h_func) :comments org
|
#+BEGIN_SRC python :var table=test :var rettyp="qmckl_exit_code" :var fname=[] :results drawer :noweb yes :wrap "src c :tangle (eval h_private_func) :comments org"
|
||||||
qmckl_exit_code [] (
|
<<parse_table>>
|
||||||
const qmckl_context context,
|
|
||||||
const char transa,
|
results = []
|
||||||
const char transb,
|
for d in parse_table(table):
|
||||||
const int64_t m,
|
name = d["name"]
|
||||||
const int64_t n,
|
c_type = d["c_type"]
|
||||||
const double* A,
|
|
||||||
const int64_t lda,
|
# Add star for arrays
|
||||||
const double* B,
|
if d["rank"] > 0 or d["inout"] in ["out", "inout"]:
|
||||||
const int64_t ldb,
|
c_type += "*"
|
||||||
double* const C,
|
|
||||||
const int64_t ldc );
|
if d["inout"] == "out":
|
||||||
#+end_src
|
c_type += " const"
|
||||||
|
|
||||||
|
# Only inputs are const
|
||||||
|
if d["inout"] == "in":
|
||||||
|
const = "const "
|
||||||
|
else:
|
||||||
|
const = ""
|
||||||
|
|
||||||
|
results += [ f" {const}{c_type} {name}" ]
|
||||||
|
|
||||||
|
results=',\n'.join(results)
|
||||||
|
template = f"""{rettyp} {fname} (\n{results} ); """
|
||||||
|
return template
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
*** Generates a C interface to the Fortran function
|
*** Generates a C interface to the Fortran function
|
||||||
|
|
||||||
@ -255,7 +268,54 @@ results='\n'.join(results)
|
|||||||
return results
|
return results
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
|
#+NAME: generate_private_f_interface
|
||||||
|
#+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval fh_private_func) :comments org :exports none"
|
||||||
|
<<c_of_f>>
|
||||||
|
<<f_of_c>>
|
||||||
|
<<parse_table>>
|
||||||
|
d = parse_table(table)
|
||||||
|
|
||||||
|
args = ", ".join([ x["name"] for x in d ])
|
||||||
|
|
||||||
|
rettyp_c = ctypeid_d[rettyp.lower()]
|
||||||
|
|
||||||
|
results = [ f"interface"
|
||||||
|
, f" {rettyp_c} function {fname} &"
|
||||||
|
, f" ({args}) &"
|
||||||
|
, " bind(C)"
|
||||||
|
, " use, intrinsic :: iso_c_binding"
|
||||||
|
, " import"
|
||||||
|
, " implicit none"
|
||||||
|
, ""
|
||||||
|
]
|
||||||
|
|
||||||
|
for d in parse_table(table):
|
||||||
|
f_type = f_of_c_d[d["c_type"]]
|
||||||
|
inout = "intent("+d["inout"]+")"
|
||||||
|
name = d["name"]
|
||||||
|
|
||||||
|
# Input scalars are passed by value
|
||||||
|
if d["rank"] == 0 and d["inout"] == "in":
|
||||||
|
value = ", value"
|
||||||
|
else:
|
||||||
|
value = " "
|
||||||
|
|
||||||
|
# Append dimensions to the name
|
||||||
|
if d["rank"] == 0:
|
||||||
|
dims = ""
|
||||||
|
else:
|
||||||
|
d["dims"].reverse()
|
||||||
|
dims = "(" + ",".join(d["dims"]) + ")"
|
||||||
|
|
||||||
|
results += [ f" {f_type:20}, {inout:12}{value} :: {name}{dims}" ]
|
||||||
|
|
||||||
|
results += [ ""
|
||||||
|
, f" end function {fname}"
|
||||||
|
, f"end interface"
|
||||||
|
]
|
||||||
|
results='\n'.join(results)
|
||||||
|
return results
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
** Creating provide functions
|
** Creating provide functions
|
||||||
|
|
||||||
@ -421,3 +481,4 @@ return msg
|
|||||||
return QMCKL_SUCCESS;
|
return QMCKL_SUCCESS;
|
||||||
}
|
}
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user