mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-07-01 08:56:29 +02:00
262 lines
7.7 KiB
Org Mode
262 lines
7.7 KiB
Org Mode
# -*- mode: org -*-
|
|
|
|
* 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"
|
|
(org-with-point-at org-babel-current-src-block-location
|
|
(org-entry-get nil key t))
|
|
#+end_src
|
|
|
|
|
|
** Table of function arguments
|
|
|
|
#+NAME: test
|
|
| Variable | Type | In/Out | Description |
|
|
|-----------+------------------+--------+-----------------------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~transa~ | ~char~ | in | Array ~A~ is ~'N'~: Normal, ~'T'~: Transposed |
|
|
| ~transb~ | ~char~ | in | Array ~B~ is ~'N'~: Normal, ~'T'~: Transposed |
|
|
| ~m~ | ~int64_t~ | in | Number of points in the first set |
|
|
| ~n~ | ~int64_t~ | in | Number of points in the second set |
|
|
| ~A~ | ~double[][lda]~ | in | Array containing the $m \times 3$ matrix $A$ |
|
|
| ~lda~ | ~int64_t~ | in | Leading dimension of array ~A~ |
|
|
| ~B~ | ~double[][ldb]~ | in | Array containing the $n \times 3$ matrix $B$ |
|
|
| ~ldb~ | ~int64_t~ | in | Leading dimension of array ~B~ |
|
|
| ~C~ | ~double[n][ldc]~ | out | Array containing the $m \times n$ matrix $C$ |
|
|
| ~ldc~ | ~int64_t~ | in | Leading dimension of array ~C~ |
|
|
|
|
|
|
*** Fortran-C type conversions
|
|
|
|
#+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 (c_int64_t)'
|
|
, 'qmckl_exit_code' : 'integer (c_int32_t)'
|
|
, 'bool' : 'logical*8'
|
|
, 'int32_t' : 'integer (c_int32_t)'
|
|
, 'int64_t' : 'integer (c_int64_t)'
|
|
, 'uint32_t' : 'integer (c_int32_t)'
|
|
, 'uint64_t' : 'integer (c_int64_t)'
|
|
, 'float' : 'real (c_float )'
|
|
, 'double' : 'real (c_double )'
|
|
, 'char' : 'character'
|
|
}
|
|
#+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(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)'
|
|
, 'real*8' : 'real(c_double)'
|
|
, 'character' : 'character(c_char)'
|
|
, 'character' : 'character(c_char)'
|
|
}
|
|
#+END_SRC
|
|
|
|
*** Parse the table
|
|
|
|
#+NAME: parse_table
|
|
#+BEGIN_SRC python :results none :noweb yes :exports none
|
|
def parse_table(table):
|
|
result = []
|
|
|
|
for line in [ [x.replace('~','') for x in y] for y in table]:
|
|
d = { "name" : line[0],
|
|
"c_type" : line[1],
|
|
"inout" : line[2].lower(),
|
|
"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"
|
|
|
|
# Find dimensions (replace [] by [*] to get * in Fortran dimensions)
|
|
dims = d["c_type"].replace("[]","[*]").split('[')
|
|
d["rank"] = len(dims) - 1
|
|
if d["rank"] == 0:
|
|
d["dims"] = []
|
|
else:
|
|
d["c_type"] = d["c_type"].split('[')[0].strip()
|
|
d["dims"] = [ x.replace(']','').strip() for x in dims[1:] ]
|
|
|
|
result.append(d)
|
|
|
|
return result
|
|
#+END_SRC
|
|
|
|
*** Generates a C header
|
|
|
|
#+NAME: generate_c_header
|
|
#+BEGIN_SRC python :var table=test :var rettyp="qmckl_exit_code" :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
|
|
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 "
|
|
else:
|
|
const = ""
|
|
|
|
results += [ f" {const}{c_type} {name}" ]
|
|
|
|
results=',\n'.join(results)
|
|
template = f"""{rettyp} {fname} (\n{results} ); """
|
|
return template
|
|
|
|
#+END_SRC
|
|
|
|
#+RESULTS: generate_c_header
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
qmckl_exit_code [] (
|
|
const qmckl_context context,
|
|
const char transa,
|
|
const char transb,
|
|
const int64_t m,
|
|
const int64_t n,
|
|
const double* A,
|
|
const int64_t lda,
|
|
const double* B,
|
|
const int64_t ldb,
|
|
double* const C,
|
|
const int64_t ldc );
|
|
#+end_src
|
|
|
|
|
|
*** Generates a C interface to the Fortran function
|
|
|
|
#+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 ])
|
|
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)"
|
|
, ""
|
|
, " 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
|
|
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 &"
|
|
, f" ({args})"
|
|
, ""
|
|
, f"end function {fname}"
|
|
]
|
|
results='\n'.join(results)
|
|
return results
|
|
#+END_SRC
|
|
|
|
*** 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_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
|
|
|
|
|
|
|