Calling fortran subroutine from c++

1

Hereby one subroutine of a larger program.

tysubroutine poutrel(name, arp)
    !DIR$ ATTRIBUTES REFERENCE, STDCALL, DLLEXPORT :: poutrel
    !DIR$ ATTRIBUTES ALIAS: 'poutrel' :: poutrel
    !DIR$ ATTRIBUTES MIXED_STR_LEN_ARG :: poutrel
    !DIR$ ATTRIBUTES NOINLINE :: procedure

    use, intrinsic :: iso_fortran_env, only: error_unit
    implicit none

    ! Calling parameter
    character(len=*), intent(in) :: name  ! Keep as INTENT(IN) since we won't modify it
    real, intent(out) :: arp(26)

    type :: profiel
        character(10) :: name
        real :: A, h, b, tw, tf, r
    end type profiel

    integer, parameter :: NPROF = 90

    type(profiel) :: profielen(NPROF)

    ! The table is generated automatically from poutr.csv and
    ! included using a data statement
    include "profielen.fi"
   

    real :: A = 0.0, h = 0.0, b = 0.0, tw = 0.0, tf = 0.0, r = 0.0
    real :: Iy = 0.0, Avz = 0.0, Wy = 0.0, Wply = 0.0, iry = 0.0
    real :: Iz = 0.0, Wz = 0.0, Wplz = 0.0, irz = 0.0
    real :: Ss = 0.0, IT = 0.0, Iw = 0.0, G = 0.0
    real :: Auf = 0.0, Izuf = 0.0, irzuf = 0.0, Wzuf = 0.0, Wzpluf = 0.0, Sy = 0.0, Syr = 0.0
    real :: Mplyd = 0.0, Mplzd = 0.0, Mplwd = 0.0, Vplzd = 0.0, Vplyd = 0.0
    real, parameter :: pi = 3.1415926535

    character(len=10) :: name_to_find
    integer :: idx

    ! Initialize output array to zeros
    arp = 0.0

    ! Initialize variables
    name_to_find = trim(name)  ! Use a local copy of the input parameter

    ! Debug output
    print *, "Looking for profile: '", trim(name_to_find), "'"

    ! Search for the profile
    idx = findloc(profielen%name, name_to_find, dim=1)

    if (idx == 0) then
        print *, "Invalid input: Profile not found."
        ! Initialize with zeros in case profile not found
        arp = 0.0
        return
    end if

    ! Profile was found
    A  = profielen(idx)%A
    h  = profielen(idx)%h
    b  = profielen(idx)%b
    tw = profielen(idx)%tw
    tf = profielen(idx)%tf
    r  = profielen(idx)%r

   
    ! Shear area
    Avz = A-2*b*tf+(tw+2*r)*tf
    ! Weight per meter
    G = A*8000*1.0e-6  ! Fixed precision issue
    ! Second moment of inertia
    Iy =(1.0/12.0)*(b*h**3.0-(b-tw)*(h-2.0*tf)**3.0)+0.03*r**4.0+0.2146*r**2.0*(h-2.0*tf-0.4468*r)**2.0
    ! Second moment of inertia about z-axis
    Iz = (1.0/12.0)*(2*tf*b**3.0+(h-2*tf)*tw**3.0) + &
         0.03*r**4.0 + 0.2146*r**2.0*(tw-0.4468*r)**2.0
    ! Radius of gyration
    iry = sqrt(Iy/A)
    irz = sqrt(Iz/A)
    ! Tortional constant
    IT = (2.0/3.0)*(b-0.63*tf)*tf**3.0+1.0/3.0*(h-2*tf)*tw**3.0+2*tw/tf*(0.145+0.1*r/tf)  &
    *(((r+tw/2.0)**2.0+(r+tf)**2.0-r**2.0)/(2*r+tf))**4.0
    ! Warping constant
    Iw = ((tf*b**3.0)/24.0)*(h-tf)**2.0
    ! Length of stiff bearing
    Ss = tw+2*tf+(4.0-2.0*sqrt(2.0))*r
    ! Elastic section modulus
    Wy = 2*Iy/h
    Wz = 2*Iz/b
    ! Plastic section modulus
    Wply = (tw*h**2.0)/4.0+(b-tw)*(h-tf)*tf+((4.0-pi)/2.0)*r**2.0*(h-2.0*tf)+((3.0*pi-10.0)/3.0)*r**3.0
    Wplz = (b**2.0*tf)/2.0 + ((h-2.0*tf)/4.0)*tw**2.0+r**3.0*(10.0/3.0-pi)+(2.0-pi/2.0)*tw*r**2.0
    ! Static radius
    Sy = b*tf*((h-tf)/2.0)+(h/2.0-tf)*tw*((h-2.0*tf)/4.0)+((r**2*(4.0-pi))/4.0)*((h-2.0*tf-r)/2.0)
    Syr = Sy - tw*((h/2.0-tf-r)**2)/2.0
    ! Cross sectional values top flange top flange + 1/5 web)
    Auf = b*tf + ((h - 2*tf)/5)*tw
    Izuf = Iz/2.0
    irzuf = sqrt(Izuf/Auf)
    Wzuf = Wz /2.0
    Wzpluf = Wplz/2.0
    ! Output (indexed for easier reference)
    arp( 1) = A
    arp( 2) = h
    arp( 3) = b
    arp( 4) = tw
    arp( 5) = tf
    arp( 6) = r
    arp( 7) = Avz
    arp( 8) = G
    arp( 9) = Iy
    arp(10) = Iz
    arp(11) = iry
    arp(12) = irz
    arp(13) = IT
    arp(14) = Iw
    arp(15) = Ss
    arp(16) = Wy
    arp(17) = Wz
    arp(18) = Wply
    arp(19) = Wplz
    arp(20) = Auf
    arp(21) = Izuf
    arp(22) = irzuf
    arp(23) = Wzuf
    arp(24) = Wzpluf
    arp(25) = Sy
    arp(26) = Syr

end subroutine poutrel

After trying several methods to create a GUI, I finally opted for Qt.
I have to call this subroutines from a C++ program.
All goes well until there is string involved.
I tried with:

subroutine poutrel_c(name_c, arp) bind(C, name="poutrel_c")
    !DEC$ ATTRIBUTES DLLEXPORT :: poutrel_c
    use, intrinsic :: iso_c_binding
    implicit none
    
    ! C-compatible parameters
    character(kind=c_char), intent(in) :: name_c(*)
    real(c_float), intent(out) :: arp(26)
    
    ! Local variables - match your original subroutine signature
    character(len=10) :: name_fortran
    real :: arp_real(26)  ! Use regular real, not c_float
    integer :: i, name_len
    
    ! Convert C string to Fortran string
    name_len = 0
    do i = 1, 10
        if (name_c(i) == c_null_char) exit
        name_fortran(i:i) = name_c(i)
        name_len = i
    end do
    
    ! Pad with spaces if needed
    if (name_len < 10) then
        name_fortran(name_len+1:10) = ' '
    end if
    
    ! Call your original function
    call poutrel(name_fortran, arp_real)
    
    ! Convert back to C-compatible format
    arp = arp_real
    
end subroutine poutrel_c

Still no working.
A liitle help from my friends would be greatly appreciated.

Roger

2

The C standard library provides the function strlen to determine the length of the null-terminated string:

subroutine poutrel_c(name_c, arp) bind(C, name="poutrel_c")
    !DEC$ ATTRIBUTES DLLEXPORT :: poutrel_c
    use, intrinsic :: iso_c_binding
    implicit none
    
    ! C-compatible parameters
    character(kind=c_char), intent(in) :: name_c(*)
    real(c_float), intent(out) :: arp(26)
    
    ! Local variables - match your original subroutine signature
    character(len=10) :: name_fortran
    real :: arp_real(26)  ! Use regular real, not c_float

    ! Helper function from C standard library (i.e. libc)
    interface
        function c_strlen(str) bind(c,name="strlen")
            import c_char, c_size_t
            character(kind=c_char), intent(in) :: str(*)
            integer(c_size_t) :: c_strlen
        end function
    end interface

    ! Convert to Fortran string
    name_fortran = name_c(1:c_strlen(name_c))
    
    ! Call your original function
    call poutrel(name_fortran, arp_real)
    
    ! Convert back to C-compatible format
    arp = arp_real
    
end subroutine poutrel_c

Assuming you aren’t using any compiler options to change the default width of reals or characters, you could potentially skip the conversions and use something like:

! ...

integer :: namelen

namelen = c_strlen(name_c)
associate(name_f => name_c(1:namelen))
   call poutrel(name_f, arp)
end associate

Assuming the routine has an explicit interface, the compiler should warn you about any type incompatibility between between real and real(c_float). In the most popular Fortran implementations these match.

(As a side note, I hope the !DIR$ ATTRIBUTES MIXED_STR_LEN_ARG :: poutrel directive does not cause any compiler confusion, when poutrel is invoked from the wrapper.)

1 Like
3

An alternative would be

namelen = index(name_c,c_null_char) - 1

If the character kinds don’t match, then I think the compiler will warn at compile time that the arguments to index() are the wrong kind. I’ve never used a compiler where they don’t match, so I can’t test that possibility. Is there a consensus among fortran programmers which statement is best?

2 Likes
4

In this case, since name_c is an array of individual characters, findloc is the way to go:

program cstring
  use iso_c_binding
  implicit none

  character(kind=c_char), allocatable :: c_string(:)
  character(:), allocatable :: string

  c_string = ['h', 'e', 'l', 'l', 'o', ' ', 'w', 'o', 'r', 'l', 'd', '!', c_null_char]
  print *, 'size (c_string) =', size (c_string)
  string = c_f_string (c_string)
  print *, 'len (string) =', len (string)
  print *, '>', string, '<'

contains

  function c_f_string (c_str) result (res)
    character(kind=c_char) :: c_str(:)
    character(:), allocatable :: res

    integer :: c_str_l

    c_str_l = findloc (c_str, c_null_char, dim=1) - 1
    res = transfer (c_str(:c_str_l), res(:c_str_l))

  end function

end
1 Like
5

Ah, I overlooked that detail. Within the fortran code, one can rely on storage sequence association to switch freely between character strings and character arrays during argument association. Does that work still when the array is of kind c_char? Maybe so in practice, but not necessarily according to the standard?

6

Admittedly, my example using transfer to move the bytes does depend on storage association (with a non-default kind) and isn’t doing any explicit kind conversion (from kind=c_char to default character). In practice, it works though. :slightly_smiling_face: