qmckl/tools/lib.org

• Function to get the value of a property.
• Table of function arguments
  • Fortran-C type conversions
  • Parse the table
  • Generates a C header
  • Generates a C interface to the Fortran function
  • Generates a Fortran interface to the C function

Function to get the value of a property.

(setq x (org-property-values key))
(pop x)

Table of function arguments

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[3][lda]	in	Array containing the $m \times 3$ matrix $A$
int64_t	lda	in	Leading dimension of array A
double	B[3][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

Fortran-C type conversions

#+NAME:f_of_c

f_of_c_d = { '' : ''
  , 'qmckl_context' : 'integer (c_int64_t)'
  , 'int32_t'       : 'integer (c_int32_t)'
  , 'int64_t'       : 'integer (c_int64_t)'
  , 'float'         : 'real    (c_float  )'
  , 'double'        : 'real    (c_double )'
  , 'char'          : 'character'
}

#+NAME:c_of_f

ctypeid_d = { '' : ''
  , 'integer'       : 'integer(c_int32_t)' 
  , 'integer*8'     : 'integer(c_int64_t)' 
  , 'real'          : 'real(c_float)'
  , 'real*8'        : 'real(c_double)'
  , 'character'     : 'character(c_char)'
}

Parse the table

Generates a C header

<<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:
     c_type += "*"

 # 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} (
{results} ); """
return template

[] [] (
 );

Generates a C interface to the Fortran function

<<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"{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 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

Generates a Fortran interface to the C function

<<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"
,  "    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 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