1
0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-11-19 20:42:50 +01:00
qmckl/tools/lib.org

260 lines
7.3 KiB
Org Mode
Raw Normal View History

# -*- mode: org -*-
2021-04-09 11:26:04 +02:00
* Library of org-mode functions :noexport:
** Defines the name of the current file
#+NAME: filename
#+begin_src elisp :tangle no
(file-name-nondirectory (substring buffer-file-name 0 -4))
#+end_src
** Function to get the value of a property.
#+NAME: get_value
#+begin_src elisp :var key="Type"
(setq x (org-property-values key))
(pop x)
2021-04-09 11:26:04 +02:00
#+end_src
2021-04-09 11:26:04 +02:00
#+RESULTS: get_value
2021-04-09 11:26:04 +02:00
** Table of function arguments
2021-03-30 14:51:23 +02:00
2021-04-09 11:26:04 +02:00
#+NAME: test
2021-06-22 23:33:09 +02:00
| ~qmckl_context~ | ~context~ | in | Global state |
| ~char~ | ~transa~ | in | Array ~A~ is ~'N'~: Normal, ~'T'~: Transposed |
| ~char~ | ~transb~ | in | Array ~B~ is ~'N'~: Normal, ~'T'~: Transposed |
| ~int64_t~ | ~m~ | in | Number of points in the first set |
| ~int64_t~ | ~n~ | in | Number of points in the second set |
| ~double~ | ~A[][lda]~ | in | Array containing the $m \times 3$ matrix $A$ |
| ~int64_t~ | ~lda~ | in | Leading dimension of array ~A~ |
| ~double~ | ~B[][ldb]~ | in | Array containing the $n \times 3$ matrix $B$ |
| ~int64_t~ | ~ldb~ | in | Leading dimension of array ~B~ |
| ~double~ | ~C[n][ldc]~ | out | Array containing the $m \times n$ matrix $C$ |
| ~int64_t~ | ~ldc~ | in | Leading dimension of array ~C~ |
2021-03-30 14:51:23 +02:00
2021-04-09 11:26:04 +02:00
*** Fortran-C type conversions
2021-04-09 11:26:04 +02:00
#+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 = { '' : ''
2021-04-16 00:57:08 +02:00
, 'qmckl_context' : 'integer (c_int64_t)'
, 'qmckl_exit_code' : 'integer (c_int32_t)'
2021-03-30 14:51:23 +02:00
, 'int32_t' : 'integer (c_int32_t)'
, 'int64_t' : 'integer (c_int64_t)'
, 'float' : 'real (c_float )'
, 'double' : 'real (c_double )'
, 'char' : 'character'
}
2021-04-09 11:26:04 +02:00
#+END_SRC
2021-03-30 14:51:23 +02:00
2021-04-09 11:26:04 +02:00
#+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 = { '' : ''
2021-04-16 00:57:08 +02:00
, 'qmckl_context' : 'integer(c_int64_t)'
, 'qmckl_exit_code' : 'integer(c_int32_t)'
2021-03-30 14:51:23 +02:00
, 'integer' : 'integer(c_int32_t)'
, 'integer*8' : 'integer(c_int64_t)'
, 'real' : 'real(c_float)'
, 'real*8' : 'real(c_double)'
, 'character' : 'character(c_char)'
}
2021-04-09 11:26:04 +02:00
#+END_SRC
2021-03-30 14:51:23 +02:00
2021-04-09 11:26:04 +02:00
*** Parse the table
2021-04-09 11:26:04 +02:00
#+NAME: parse_table
#+BEGIN_SRC python :results none :noweb yes :exports none
def parse_table(table):
result = []
2021-06-22 23:33:09 +02:00
for line in [ [x.replace('~','') for x in y] for y in table]:
d = { "c_type" : line[0],
"inout" : line[2].lower(),
"name" : line[1],
"comment" : line[3] }
# Handle inout
if d["inout"] in ["input", "in"]:
d["inout"] == "in"
elif d["inout"] in ["output", "out"]:
d["inout"] == "out"
elif d["inout"] in ["input/output", "inout"]:
d["inout"] == "inout"
2021-04-17 12:35:52 +02:00
# Find dimensions (replace [] by [*] to get * in Fortran dimensions)
dims = d["name"].replace("[]","[*]").split('[')
d["rank"] = len(dims) - 1
if d["rank"] == 0:
d["dims"] = []
else:
d["name"] = d["name"].split('[')[0].strip()
d["dims"] = [ x.replace(']','').strip() for x in dims[1:] ]
2021-03-30 14:51:23 +02:00
result.append(d)
return result
2021-04-09 11:26:04 +02:00
#+END_SRC
2021-04-09 11:26:04 +02:00
*** Generates a C header
2021-04-09 11:26:04 +02:00
#+NAME: generate_c_header
2021-06-22 23:33:09 +02:00
#+BEGIN_SRC python :var table=test :var rettyp=[] :var fname=[] :results drawer :noweb yes :wrap "src c :tangle (eval h_func) :comments org"
<<parse_table>>
results = []
for d in parse_table(table):
name = d["name"]
c_type = d["c_type"]
# Add star for arrays
2021-04-16 00:57:08 +02:00
if d["rank"] > 0 or d["inout"] in ["out", "inout"]:
c_type += "*"
2021-04-16 00:57:08 +02:00
if d["inout"] == "out":
c_type += " const"
# Only inputs are const
if d["inout"] == "in":
2021-04-16 00:57:08 +02:00
const = "const "
else:
2021-04-16 00:57:08 +02:00
const = ""
results += [ f" {const}{c_type} {name}" ]
results=',\n'.join(results)
2021-06-23 11:38:38 +02:00
template = f"""{rettyp} {fname} (\n{results} ); """
return template
2021-04-09 11:26:04 +02:00
#+END_SRC
2021-04-09 11:26:04 +02:00
*** Generates a C interface to the Fortran function
2021-04-09 11:26:04 +02:00
#+NAME: generate_c_interface
#+BEGIN_SRC python :var table=[] :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none"
<<c_of_f>>
<<f_of_c>>
<<parse_table>>
d = parse_table(table)
args = ", ".join([ x["name"] for x in d ])
2021-06-22 23:33:09 +02:00
if len(args) > 100:
args = args.replace(",",""", &
""")
rettyp_c = ctypeid_d[rettyp.lower()]
results = [ f"{rettyp_c} function {fname} &"
, f" ({args}) &"
, " bind(C) result(info)"
2021-03-30 14:51:23 +02:00
, ""
, " use, intrinsic :: iso_c_binding"
, " 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
2021-04-16 00:57:08 +02:00
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" {rettyp_c}, external :: {fname}_f"
, f" info = {fname}_f &"
2021-03-30 14:51:23 +02:00
, f" ({args})"
, ""
, f"end function {fname}"
]
results='\n'.join(results)
return results
2021-04-09 11:26:04 +02:00
#+END_SRC
2021-06-22 23:33:09 +02:00
#+RESULTS: generate_c_interface
#+begin_src f90 :tangle (eval f) :comments org :exports none
integer(c_int32_t) function [] &
() &
bind(C) result(info)
use, intrinsic :: iso_c_binding
implicit none
integer(c_int32_t), external :: []_f
info = []_f &
()
end function []
#+end_src
2021-04-09 11:26:04 +02:00
*** Generates a Fortran interface to the C function
2021-04-09 11:26:04 +02:00
#+NAME: generate_f_interface
2021-04-16 00:57:08 +02:00
#+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>>
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"
2021-03-30 14:51:23 +02:00
, " 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
2021-04-16 00:57:08 +02:00
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
2021-04-09 11:26:04 +02:00
#+END_SRC
2021-04-16 00:57:08 +02:00
#+RESULTS: generate_f_interface
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
2021-04-09 11:26:04 +02:00
#+end_src
2021-04-16 00:57:08 +02:00
2021-07-06 09:27:14 +02:00