how to get Doxygen to work with Fortran interface statements? - fortran

I am working on free software project CCR, which allows climate and other Earth science users to add additional compression methods to netCDF. See https://github.com/ccr/ccr.
I have a Fortran file, and Doxygen is giving me the following warnings:
/home/ed/noaa/ccr/fsrc/ccr.F90:19: warning: Member nc_def_var_bzip2(ncid, varid, level) (function) of class ccr::nc_def_var_bzip2 is not documented.
/home/ed/noaa/ccr/fsrc/ccr.F90:36: warning: Member nc_def_var_lz4(ncid, varid, level) (function) of class ccr::nc_def_var_lz4 is not documented.
/home/ed/noaa/ccr/fsrc/ccr.F90:27: warning: Member nc_inq_var_bzip2(ncid, varid, bzip2p, levelp) (function) of class ccr::nc_inq_var_bzip2 is not documented.
/home/ed/noaa/ccr/fsrc/ccr.F90:44: warning: Member nc_inq_var_lz4(ncid, varid, lz4p, levelp) (function) of class ccr::nc_inq_var_lz4 is not documented.
But I have documented these functions. The line numbers doxygen is complaining about are part of interface statements:
module ccr
!> Interface to initialization function.
interface
function nc_initialize_ccr() bind(c)
use iso_c_binding
end function nc_initialize_ccr
end interface
!> Interface to C function to set BZIP2 compression.
interface
function nc_def_var_bzip2(ncid, varid, level) bind(c)
use iso_c_binding
integer(C_INT), value :: ncid, varid, level
end function nc_def_var_bzip2
end interface
!> Interface to C function to inquire about BZIP2 compression.
interface
function nc_inq_var_bzip2(ncid, varid, bzip2p, levelp) bind(c)
use iso_c_binding
integer(C_INT), value :: ncid, varid
integer(C_INT), intent(inout):: bzip2p, levelp
end function nc_inq_var_bzip2
end interface
!> Interface to C function to set LZ4 compression.
interface
function nc_def_var_lz4(ncid, varid, level) bind(c)
use iso_c_binding
integer(C_INT), value :: ncid, varid, level
end function nc_def_var_lz4
end interface
!> Interface to C function to inquire about LZ4 compression.
interface
function nc_inq_var_lz4(ncid, varid, lz4p, levelp) bind(c)
use iso_c_binding
integer(C_INT), value :: ncid, varid
integer(C_INT), intent(inout):: lz4p, levelp
end function nc_inq_var_lz4
end interface
How do I get Doxygen to see the documentation of the interfaces?

The answer is to use the #fn tag, and specify the entire function signature, after module_name::fn_name::. Here's an example from another project:
interface
!> #fn bacio_module::baciol::baciol(mode, start, newpos, size, no, nactual, fdes, fname, datary)
!> Do a bacio operation.
!>
!> #param mode
!> #param start
!> #param newpos
!> #param size
!> #param no
!> #param nactual
!> #param fdes
!> #param fname
!> #param datary
!>
!> #author Ed Hartnett #date 21-10-18
integer function baciol(mode, start, newpos, size, no, nactual, &
fdes, fname, datary) bind(C)
use, intrinsic :: iso_c_binding
integer(c_int), value, intent(in) :: mode
integer(c_long), value, intent(in) :: start, newpos
integer(c_int), value, intent(in) :: size
integer(c_long), value, intent(in) :: no
integer(c_long), intent(inout) :: nactual
integer(c_int), intent(inout) :: fdes
character(kind=C_char), intent(in) :: fname(*)
character(kind=C_char), intent(in) :: datary(*)
end function baciol
end interface

Related

Fortran Wrapper calling C functions

I have a C function that uses structures. I developed a Fortran Wrapper which calls the C function. Both libraries are built successfully. I have passed the variables form the PSCAD model and run the case. The PSCAD model is throwing the error.
Error Message:
Type Id Component Namespace Description
dll_df FORTRA~1.LIB(dlltestx.obj) : error LNK2019: unresolved external symbol _test_cfun referenced in function _AUX_CFUN
C-Code:
// This is an example of an exported variable
typedef struct _goose_c
{
int in1;
float in2;
}goose_c;
__declspec(dllexport) void test_cfunc(goose_c *V, double *out1)
{
//*out1 = (*V).in1 + (*V).in2;
*out1 = V->in1 + V->in2;
}
Fortran Wrapper Code:
SUBROUTINE AUX_CFUN(ip1, ip2, out1)
use, intrinsic :: iso_c_binding
implicit none
integer, intent(in) :: ip1
real, intent(in) :: ip2
real, intent(out) :: out1
type, bind(C) :: goose_t
integer(c_int) :: in1
real(c_double) :: in2
end type goose_t
type(goose_t) :: goose_f
! Fortran 90 interface to a C procedure
INTERFACE
SUBROUTINE TEST_CFUN (goose_f,out1) bind (C)
use iso_c_binding
import :: goose_t
type(goose_t), intent (in) :: goose_f
real(c_double), intent (out) :: out1
END SUBROUTINE TEST_CFUN
END INTERFACE
goose_f%in1 = ip1
goose_f%in2 = ip2
! call of the C procedure
CALL TEST_CFUN(goose_f,out1)
RETURN
END SUBROUTINE AUX_CFUN
The bind (C) clause in the interface should be completed with the exact (including the correct case) C name of the function you want to interface; so in your example it should read bind (C, name='test_cfunc'). The Fortran name associated to the C function (TEST_CFUN in your example) can be in principle different, it's up to you to decide whether this is a good idea or not, and it is used in your fortran program with the usual fortran rules, so it is case-insensitive.

Fortran POINTER passed to C by ISO_C_BINDING with INTENT(IN) [duplicate]

I am writing an iso_c_binding in Fortran to call a C-function with the below prototype
int zmat_run(
const size_t inputsize,
unsigned char *inputstr,
size_t *outputsize,
unsigned char **outputbuf,
const int zipid,
int *ret,
const int iscompress
);
My question is how do I declare unsigned char **outputbuf, a pointer that is used inside the c-function to allocate output buffer, in this interface?
Also, what data type I should be using in Fortran as the real parameter to pass to this outputbuf parameter? should it be allocatable? (if it is allocated inside the c-function)?
I currently drafted this module, but haven't tested it (I doubt it will work).
module zmatlib
use iso_c_binding, only: c_char, c_size_t, c_ptr, C_NULL_CHAR
interface
integer(c_int) function zmat_run(inputsize, inputbuf, outputsize, outputbuf, zipid, ret, level) bind(C, name="zmat_run")
use iso_c_binding
integer(c_size_t), value :: inputsize
integer(c_int), value :: zipid, level
integer(c_size_t), intent(out) :: outputsize
integer(c_int), intent(out) :: ret
character(kind=c_char), intent(in) :: inputbuf(*)
character pointer(c_ptr),intent(out) :: outputbuf
end function zmat_run
end interface
end module
Try type (C_PTR), intent (out). Then you will need to use Fortran function c_f_pointer to associate the C pointer with a Fortran pointer. Probably of type C_CHAR.

Fortran C-interoperable submodule procedure with bind(C) reports error when compiled by gfortran

Consider the following Fortran module Foo_mod and its submodule Foo_smod,
module CallbackInterface_mod
abstract interface
function getLogFunc4C_proc(ndim,Point) result(logFunc) bind(C)
use, intrinsic :: iso_c_binding, only : c_int32_t, c_double, c_int
integer(c_int32_t), intent(in) :: ndim
real(c_double), intent(in) :: Point(ndim)
real(c_double) :: logFunc
end function getLogFunc4C_proc
end interface
end module CallbackInterface_mod
!***********************************************************************************************************************************
!***********************************************************************************************************************************
module Foo_mod
interface
module subroutine runFoo4C(ndim, getLogFuncFromC, inputString, inputStringLen) bind(C, name="runFoo")
use, intrinsic :: iso_c_binding, only: c_int32_t, c_char, c_funptr, c_f_procpointer, c_size_t
use CallbackInterface_mod, only: getLogFunc4C_proc
implicit none
integer(c_int32_t) , intent(in) :: ndim
character(len=1, kind=c_char), dimension(*), intent(in) :: inputString
integer(c_size_t) , intent(in) :: inputStringLen
type(c_funptr), intent(in), value :: getLogFuncFromC
end subroutine runFoo4C
end interface
contains
subroutine runFoo(ndim, getLogFunc, string)
use CallbackInterface_mod, only: getLogFunc4C_proc
use, intrinsic :: iso_fortran_env, only: RK => real64
implicit none
integer :: ndim
procedure(getLogFunc4C_proc) :: getLogFunc
character(*), intent(in) :: string
real(RK) :: Point(ndim)
character(:), allocatable :: mystring
Point = [1._RK,1._RK]
write(*,*) "Hi again, this is a call from inside runFoo!"
write(*,*) "getLogFunc(2,[1,1]) = ", getLogFunc(ndim,Point)
write(*,*) "string = ", string
end subroutine
end module Foo_mod
!***********************************************************************************************************************************
!***********************************************************************************************************************************
submodule (Foo_mod) Foo_smod
contains
module subroutine runFoo4C(ndim, getLogFuncFromC, InputString, inputStringLen) bind(C, name="runFoo")
use, intrinsic :: iso_c_binding, only: c_double, c_int32_t, c_char, c_funptr, c_f_procpointer, c_size_t
use CallbackInterface_mod, only: getLogFunc4C_proc
implicit none
integer(c_int32_t) , intent(in) :: ndim
character(len=1, kind=c_char), dimension(*), intent(in) :: InputString
integer(c_size_t) , intent(in) :: inputStringLen
type(c_funptr), intent(in), value :: getLogFuncFromC
procedure(getLogFunc4C_proc), pointer :: getLogFunc
real(c_double) :: Point(ndim)
character(:), allocatable :: inputString4tran
integer :: i
write(*,*) "InputString: ", InputString(1:inputStringLen)
allocate( character(len=inputStringLen) :: inputString4tran )
do i=1,inputStringLen
inputString4tran(i:i) = InputString(i)
end do
write(*,*) "inputString4tran: ", inputString4tran
! associate the input C procedure pointer to a Fortran procedure pointer
call c_f_procpointer(cptr=getLogFuncFromC, fptr=getLogFunc)
Point = [1._c_double, 1._c_double]
write(*,*) "getLogFunc(ndim=2, [1._c_double, 1._c_double]): ", getLogFunc( ndim, Point )
call runFoo(ndim, getLogFunc, inputString4tran)
end subroutine runFoo4C
end submodule Foo_smod
Now, this code seems like a perfectly sound Fortran module to me, and indeed it does compile and link successfully to C programs via Intel Fortran Compiler 2018, on both Windows and Linux, and runs correctly. However, when compiled by gfortran 7.3.0, it gives the following error:
gfortran -c ../Foo_mod.f90
../Foo_mod.f90:54:18:
submodule (Foo_mod) Foo_smod
1
Error: BIND(C) attribute at (1) can only be used for variables or common blocks
The problem can be resolved if I remove the bind(c) attribute from the interface of the interoperable subroutine runFoo4C() in module Foo_mod, like the following,
...
module subroutine runFoo4C(ndim, getLogFuncFromC, inputString, inputStringLen) ! bind(C, name="runFoo")
...
However, the Intel Fortran compiler would then complain about the incompatibility of the subroutine's interface in module Foo_mod and the implementation of the subroutine in submodule Foo_smod. This seems to me more like a bug in GFORTRAN, than programming mistake. But your comments are appreciated before I go on to report it.
It is quite clear to me that this is a gfortran bug related to submodules. As that's a fairly recent feature addition, it's not unexpected that there may be bugs here and there.
I will comment that when asking a question such as this here, you are strongly encouraged to provide a Minimal, Complete and Verifiable Example Since you don't show the module that the submodule goes with, we can't verify the issue ourselves without unnecessary extra work.

How can I use dlmopen in Fortran?

I want to load the same .so file twice as separate instances. Based on the example, I have created the app with two dlopen commands.
However, I was facing some issues and I understood that dlmopen should be used if I am using multiple instances of a same .so. However, I don't know how to pass the arguments. Can someone help me how to do this in GFortran?
My code is as below,
program example
use :: iso_c_binding
implicit none
integer(c_int), parameter :: rtld_lazy=1 ! value extracte from the C header file
integer(c_int), parameter :: rtld_now=2 ! value extracte from the C header file
!
! interface to linux API
interface
function dlopen(filename,mode) bind(c,name="dlopen")
! void *dlopen(const char *filename, int mode);
use iso_c_binding
implicit none
type(c_ptr) :: dlopen
character(c_char), intent(in) :: filename(*)
integer(c_int), value :: mode
end function
function dlsym(handle,name) bind(c,name="dlsym")
! void *dlsym(void *handle, const char *name);
use iso_c_binding
implicit none
type(c_funptr) :: dlsym
type(c_ptr), value :: handle
character(c_char), intent(in) :: name(*)
end function
function dlclose(handle) bind(c,name="dlclose")
! int dlclose(void *handle);
use iso_c_binding
implicit none
integer(c_int) :: dlclose
type(c_ptr), value :: handle
end function
end interface
! Define interface of call-back routine.
abstract interface
subroutine called_proc (i, i2) bind(c)
use, intrinsic :: iso_c_binding
integer(c_int), intent(in) :: i
integer(c_int), intent(out) :: i2
end subroutine called_proc
end interface
! testing the dynamic loading
integer i, i2
type(c_funptr) :: proc_addr
type(c_ptr) :: handle1, handle2
character(256) :: pName, lName
procedure(called_proc), bind(c), pointer :: proc
!
i = 15
handle1=dlopen("./test.so"//c_null_char, RTLD_LAZY)
if (.not. c_associated(handle1))then
print*, 'Unable to load DLL ./test.so - First time'
stop
end if
handle2=dlopen("./test.so"//c_null_char, RTLD_LAZY)
if (.not. c_associated(handle2))then
print*, 'Unable to load DLL ./test.so - Second time'
stop
end if
! If I can use dlmopen() I dont know how to pass the arguments
proc_addr=dlsym(handle, "t_times2"//c_null_char)
if (.not. c_associated(proc_addr))then
write(*,*) 'Unable to load the procedure t_times2'
stop
end if
call c_f_procpointer( proc_addr, proc )
call proc(i,i2)
write(*,*) "t_times2, i2=", i2
!
proc_addr=dlsym( handle, "t_square"//c_null_char )
if ( .not. c_associated(proc_addr) )then
write(*,*)'Unable to load the procedure t_square'
stop
end if
call c_f_procpointer(proc_addr, proc)
call proc(i,i2)
write(*,*) "t_square, i2=", i2
contains
end program example
Update:
Based on the suggestion from Vladmir, I tried below but I get Unable to load DLL ./test.so - Third time,
function dlmopen(lmid_t,filename,mode) bind(c,name="dlmopen")
! void *dlopen(const char *filename, int mode);
use iso_c_binding
implicit none
type(c_ptr) :: dlopen
integer(c_long), value :: lmid_t
character(c_char), intent(in) :: filename(*)
integer(c_int), value :: mode
end function
handle3=dlmopen(1,"./test.so"//c_null_char, RTLD_LAZY)
if (.not. c_associated(handle3))then
print*, 'Unable to load DLL ./test.so - Third time'
stop
end if
This is the base that you can start from, it is a modification of your code and because of the #define macros it requires the cpp flags. You can change the defines to a normal parameter declaration if you want, but just copying the macros from the header is easier.
use iso_c_binding
implicit none
! from dlfcn.h
# define LM_ID_BASE 0 /* Initial namespace. */
# define LM_ID_NEWLM -1 /* For dlmopen: request new namespace. */
integer(c_long) :: dlist = LM_ID_NEWLM
integer(c_int), parameter :: rtld_lazy=1 ! value extracte from the C header file
integer(c_int), parameter :: rtld_now=2 ! value extracte from the C header file
type(c_ptr) :: handle3
interface
function dlmopen(lmid_t,filename,mode) bind(c,name="dlmopen")
! void *dlmopen (Lmid_t lmid, const char *filename, int flags);
use iso_c_binding
implicit none
type(c_ptr) :: dlmopen
integer(c_long), value :: lmid_t
character(c_char), intent(in) :: filename(*)
integer(c_int), value :: mode
end function
end interface
handle3=dlmopen(dlist,"test.so"//c_null_char, RTLD_LAZY)
if (.not. c_associated(handle3))then
print*, 'Unable to load DLL ./test.so - Third time'
stop
end if
end
According to the manual, there are two principal values that you can pass as dlist, either LM_ID_BASE or LM_ID_NEWLM. Their values are defined in the header dlfcn.h that is located ammong other standard C and POSIX headers (/usr/include/ or similar). You should not just pass 1, but one of these two values which happen to be 0 and -1 on my computer.

Binding C++ and Fortran

I want to combine C++ and Fortran together. My Fortran code will use a C++ function and C++ function changes variables of Fortran and sends them back. The C++ function is built with other C++ codes, e.g. the C++ function will use some sub-function in other .cpp file. I make the Fortran code with ifort and I added that C++ function as one object file, test.o in my Fortran makefile. I also put every needed C++ .o file(support test.o) in makefile. It shows the error
#6633, "The type of the actual argument differs from the type of the dummy argument".
Here is the code.
Fortran code
use, intrinsic :: ISO_C_BINDING, only: C_INT, C_DOUBLE
implicit double precision(a-h,o-z),integer(i-n)
Interface
integer (C_INT) function SolveBIE_(x, y, aa, m) BIND(C, NAME='SolveBIE_')
use, intrinsic :: ISO_C_BINDING
implicit none
type (C_PTR), value :: x
type (C_PTR), value :: y
type (C_PTR), value :: aa
integer (C_INT), value :: m
end function SolveBIE_
end Interface
integer (C_INT) :: m
real (C_DOUBLE), ALLOCATABLE, DIMENSION(:,:), target :: x
real (C_DOUBLE), ALLOCATABLE, DIMENSION(:,:), target :: y
real (C_DOUBLE), ALLOCATABLE, DIMENSION(:,:), target :: aa
ALLOCATE(x(0:MAXLEN,MAXINTERFACES))
ALLOCATE(y(0:MAXLEN,MAXINTERFACES))
ALLOCATE(aa(0:MAXLEN,MAXINTERFACES))
My Fortran code run
mm = SolveBIE_(x(1,1),y(1,1),aa(1,1),m)
Using the C++ code and where the error is from, on x, y, aa
I use x(1,1) instead of x, because if using x, then there is another error
#6634,"the shape matching rules of actual arguments and dummy arguments have been violated"`
I don't understand why it should be x(1,1). Why is this working, not x?
My C++ code
#ifdef __cplusplus
extern "C" {
#endif
int solveBIE_(double *ini_bdry_x, double *ini_bdry_y, double *ini_bdry_um, int *fM)
{
double(*bdry_node)[2] = new double[M1][2];
for (int k = 0; k < M; k++) {
bdry_node[k+1][0] = ini_bdry_x[k+1];
bdry_node[k+1][1] = ini_bdry_y[k+1];
bdry_theta[k+1] = Atan(ini_bdry_x[k+1], ini_bdry_y[k+1]);}
... some functions in other .cpp file
The way your interface is written, you have to construct a C_PTR to array x and pass that as the first argument:
use, intrinsic :: ISO_C_BINDING, only: C_INT, C_DOUBLE, C_PTR, C_LOC
! ...
type(C_PTR) PTRx
! ...
PTRx = C_LOC(x(LBOUND(x,1),LBOUND(x,2)))
! ...
mm = solveBIE_(PTRx, PTRy, PTRaa, m)
As shown above, you would have to fix the next two arguments as well. But you need to rewrite the interface for argument fM because as matters stand, Fortran will pass an integer by value whereas C++ is expecting a pointer. Given that, I would rewrite the interface completely, using the names given for the arguments in the C++ function and passing everything by reference. Names for dummy arguments are potentially visible in Fortran, so it's useful for them to be meaningful. In the following I assume that fM points to a scalar in the callee:
Interface
function SolveBIE_(ini_bdry_x, ini_bdry_y, ini_bdry_um, fM) &
BIND(C, NAME='SolveBIE_')
import
implicit none
integer(C_INT) SolveBIE_
real(C_DOUBLE) :: ini_bdry_x(*)
real(C_DOUBLE) :: ini_bdry_y(*)
real(C_DOUBLE) :: ini_bdry_um(*)
integer (C_INT) :: fM
end function SolveBIE_
end Interface
Then later on you can invoke it more or less normally as
mm = SolveBIE_(x,y,aa,m)
Note that x(1,1) was wrong because LBOUND(x,1) = 0, not 1!