Passing and modifying real, integer, logical and strings data from python to Fortran using ctypes

I am passing real, integer, logical, and string data from python to Fortran and trying to retrieve the modified variable from Fortran. However, the logical data is not modified and string data is truncated. Here the python and Fortran scripts:

python

import numpy as np
from ctypes import CDLL, c_int, c_double, byref, POINTER, c_char, c_bool, c_char_p, c_wchar_p

fAPI = CDLL('./c32_or_64bit_while_calling_using_ctypes.so') 

dim = 4
X = np.array([0.,0.,0.,0.], dtype=float)
istrue = True
charactervalue = b'helloDear'
print('py: dim',dim)
print('py: X', X)
print('py: istrue:', istrue)
print('py: charactervalue:', charactervalue)

fAPI.logical_character_real_array(X.ctypes.data_as(POINTER(c_double)), byref(c_int(dim)), byref(c_bool(istrue)), byref(c_char_p(charactervalue))) 


print('\n\n----after calling fAPI.realarray: ...\n')
print('py dim: {}'.format(dim))
print('py X:')
print('   ',X)
print('py: istrue: {}'.format(istrue))   # ...???? wrong 
print('py: charactervalue: {}'.format(charactervalue))  ## truncated ..???

Fortran


module c32_or_64bit_while_calling_using_ctypes
    
    use iso_c_binding, only: c_int, c_double, c_bool, c_char, c_f_pointer, c_ptr !, c_null_char
    implicit none
    public

    contains
    
SUBROUTINE logical_character_real_array(arr, dim, istrue, charactervalue) bind(c, name='logical_character_real_array')
        implicit none
        INTEGER(c_int), intent(in) :: dim
        !
        logical(c_bool), intent(inout) :: istrue 
        type(c_ptr), intent(inout) :: charactervalue
        character(len=20), pointer :: fcharactervalue
        real(c_double), intent(inout) :: arr(dim)
        !
        integer  :: i

        print*, ''
        print*, ''
        arr = [(2.0*i,i=1,dim)]  

        istrue = .False.

        PRINT*, 'fortran: ', arr
        print*, 'fortran: istrue: ', istrue
        
        call c_f_pointer(charactervalue, fcharactervalue ) !, [??])
        fcharactervalue = 'a'//trim(fcharactervalue)

        print*, 'fortran: charactervalue: ', charactervalue !, trim(charactervalue)
        print*, 'fortran: fcharactervalue: ', trim(fcharactervalue) !fcharactervalue !, trim(fcharactervalue)
    END


end module c32_or_64bit_while_calling_using_ctypes

output


y: dim 4
py: X [0. 0. 0. 0.]
py: istrue: True
py: charactervalue: b'helloDear'
 
 
 fortran:    2.0000000000000000        4.0000000000000000        6.0000000000000000        8.0000000000000000     
 fortran: istrue:  F
 fortran: charactervalue:       140636405924976
 fortran: fcharactervalue: ahelloDear


----after calling fAPI.realarray: ...

py dim: 4
py X:
    [2. 4. 6. 8.]
py: istrue: True     #---------WRONG HERE .... MUST BE 'False'
py: charactervalue: b'ahelloDea'         # WRONG--------MUST be 'ahelloDear'

So Question: how to get the correct value of istrue and charactervalue variables from the Fortran side?

I’m not sure, but here is what I would try:

For the logical, define it as a size=1 array on the Python side, instead of a scalar

For the characters, there is fundamental difference between C et Fortran: in Fortran character(20) is somehow a type in itself, not an array of 20 characters as in C. So, I would define the dummy argument like this:
character(kind=c_char,len=1), intent(inout) :: charactervalue(20)

Then, the transformation on this array is:

charactervalue(2:20) = charactervalue(1:19)
charactervalue(1) = 'a'

alternatively you may use a temporary character(20) variable:

character(len=20) :: tmp
do i = 1, 20
   tmp(i:i) =  charactervalue(i)
end do
tmp = 'a'//trim(tmp)
charactervalue(:) = [(tmp(i:i), i=1, 20)]

To get values in python to register the change in Fortran, you need to pass them not with byref(), but with pointer().

edit: nah, i’m probably wrong…
edit2: typically you can pass a logical like:

# convert from python to ctypes
c_istrue = c_bool( istrue )
# call you function
lib.function_name( byref(c_istrue) )
# then read value from c_istrue back into python
istrue = c_istrue.value

For character strings you have a few different options, but keep in mind that strings in C are generally null-terminated. So either you need to infer the length in your Fortran program, pass a string of fixed-length (set in advance), or pass the length as an additional argument.

You also need to consider carefully whether you are trying to pass a value or a reference. Currently, the C prototype of your function would look like this (see “Working with C pointers” in the GCC documentation):

void logical_character_real_array(double *arr, 
                                  int *dim, 
                                  bool *istrue, 
                                  void **charactervalue)

I think it would be more natural like this:

void logical_character_real_array(double *arr, 
                                  int dim, 
                                  bool *istrue, 
                                  char *charactervalue)

with the corresponding Fortran interface:

subroutine logical_character_real_array(arr, dim, istrue, charactervalue) bind(c)
    integer(c_int), value :: dim
    real(c_double), intent(inout) :: arr(dim)
    logical(c_bool), intent(inout) :: istrue 
    character(kind=c_char), intent(inout) :: charactervalue(*)

Note the character pointer is associated with an array of characters (len=1) on the Fortran side.


There are a few other possibilites to pass a string from C to Fortran. I’ve tried to demonstrate these below:

! libf.f90 --
!      Library demonstrating how to pass string from C to Fortran
!
! We showcase 4 methods:
!   1. passing the string as a pointer to a null-terminated array of characters
!   2. passing the string as a "reference" to an array of characters 
!      (null-terminated)
!   3. passing a string as an array of characters of known length
!   4. passing a string as a C descriptor using the Fortran 2018 
!      enhanced interop features

! void printmsg_c_ptr(char *msg);
subroutine printmsg_c_ptr(msg) bind(c)
   use, intrinsic :: iso_c_binding
   type(c_ptr), value :: msg
   
   interface
      ! The strlen function from the C runtime library
      ! https://en.cppreference.com/w/c/string/byte/strlen
      pure function c_strlen(str) bind(c,name="strlen")
         import c_ptr, c_size_t
         type(c_ptr), value :: str
         integer(c_size_t) :: c_strlen
      end function
   end interface

   character(kind=c_char,len=:), pointer :: pmsg
   character(kind=c_char,len=:), allocatable :: fmsg
   
   ! Creates a pointer to the C character array
   pmsg => p2cstr(msg)
   print *, "In Fortran (reference): ", pmsg

   ! Creates a copy via allocation on assignment
   ! (known to raise warning in gfortran, but technically it is completely legal)
   fmsg = p2cstr(msg)
   print *, "In Fortran (copy): ", fmsg

contains 

   ! Return pointer to C string
   function p2cstr(str) result(p_str)
      type(c_ptr), value :: str
      character(kind=c_char,len=:), pointer :: p_str

      block
         character(kind=c_char,len=c_strlen(str)), pointer :: tmp
         call c_f_pointer(msg, tmp)
         p_str => tmp
         nullify(tmp)
      end block
   
   end function

end subroutine


! void printmsg_c_char(char *msg);
subroutine printmsg_c_char(msg) bind(c)
   use, intrinsic :: iso_c_binding
   character(kind=c_char), intent(in) :: msg(*) ! null-terminated string
   integer :: lmsg

   lmsg = strlen(msg)
   print *, "In Fortran (reference): ", msg(1:lmsg)

contains

   ! If string is not null-terminated, behavior is undefined
   integer function strlen(str)
      character(kind=c_char), intent(in) :: str(*)
      i = 0
      do while (str(i+1) /= c_null_char)
         i = i + 1
      end do
      strlen = i
   end function

end subroutine


! void printmsg_c_char_n(int n, const char msg[n]);
subroutine printmsg_c_char_n(n, msg) bind(c)
   use, intrinsic :: iso_c_binding
   integer(c_int), value :: n
   character(kind=c_char), intent(in) :: msg(n)
   print *, "In Fortran (reference): ", msg
end subroutine


! Requires gfortran 12 or higher
!
! void printmsg_char(CFI_cdesc_t *msg);
subroutine printmsg_char(msg) bind(c)
   use, intrinsic :: iso_c_binding
   character(kind=c_char,len=*), intent(in) :: msg
   print *, "In Fortran (reference): ", msg
end subroutine
// main.c

#include <stdio.h>
#include <string.h>
#include <assert.h>

#include <ISO_Fortran_binding.h>

extern void printmsg_c_ptr(const char *msg);
extern void printmsg_c_char(const char *msg);
extern void printmsg_c_char_n(int n, const char msg[n]);

extern void printmsg_char(CFI_cdesc_t *msg);

int main(void) {

    const char *str = "I'm in the C main!"; // A sample string

    // Use printf to print the string
    printf("In C: %s\n", str);

    printmsg_c_ptr(str);
    printmsg_c_char(str);

    int lstr = strlen(str);
    printmsg_c_char_n(lstr,str);

    // The last approach requires a F2018-compatible compiler
    //  With gfortran, you'll need version 12 or higher

    CFI_CDESC_T(0) str_desc;

    int istat = CFI_establish(
    	(CFI_cdesc_t *) &str_desc, 
    	(void *) str,
    	CFI_attribute_other,
    	CFI_type_char,
    	strlen(str),
    	(CFI_rank_t) 0,
    	NULL /* ignored */);

    assert(istat == CFI_SUCCESS);

    printmsg_char((CFI_cdesc_t *) &str_desc);

    return 0;
}

The output of the C program:

$ ./main
In C: I'm in the C main!
 In Fortran (reference): I'm in the C main!
 In Fortran (copy): I'm in the C main!
 In Fortran (reference): I'm in the C main!
 In Fortran (reference): I'm in the C main!
 In Fortran (reference): I'm in the C main!

Build instructions so you can replicate this:

# Makefile
FC = gfortran-13
CC = gcc-13

FFLAGS=-Wall
CFLAGS=-Wall -std=c99

.PHONY: all clean
all: main

main: main.c libf.so
	$(CC) $(CFLAGS) -o $@ $^ -lgfortran
libf.so: libf.f90
	$(FC) $(FFLAGS) -shared -fPIC -o $@ $<

clean:
	rm -vf *.o *.so *.mod

One more note on Fortran character passing. It is legal to pass a scalar character, as a dummy argument to an array of characters. This is useful, among other things, when you want to pass Fortran strings routines implemented in C:

program character_association
implicit none
character(len=32) :: str   ! a scalar
str = "Greetings from Munich"
call print_as_array(len_trim(str),str)
contains
   subroutine print_as_array(n,str)
     integer, intent(in) :: n
     character(len=1), intent(in) :: str(n)  ! an array
     print *, str
   end subroutine
end program

Python wrappers

When it comes to the wrapping the Fortran routines using the Python ctypes module, I believe it’s good practice to specify the return and argument types. This will help you catch argument errors.

Here’s a wrapper for the example above:

""" 
fwrap.py --
    Wrapper library for the libf Fortran module
"""

import ctypes

# Exported functions
__all__ = ["printmsg"]

libf = ctypes.CDLL("libf.so")

# void printmsg_c_ptr(char *msg);
libf.printmsg_c_ptr.restype = None
libf.printmsg_c_ptr.argtypes = [ctypes.c_char_p]


# void printmsg_c_char(char *msg);
libf.printmsg_c_char.restype = None
libf.printmsg_c_char.argtypes = [ctypes.c_char_p]


# void printmsg_c_char_n(int n, const char msg[n]);
libf.printmsg_c_char_n.restype = None
libf.printmsg_c_char_n.argtypes = [ctypes.c_int, ctypes.c_char_p]


def printmsg(msg):
    """
    Prints a message using the libf Fortran library

    Args:
        msg (bytes): A message encoded as an ASCII sequence of bytes

    Examples:
       >>> printmsg(b'Hello')
       >>> printmsg('Hello'.encode('ascii'))
    """

    # quick return on failure
    if not isinstance(msg,(bytes,bytearray)):
        raise TypeError(
            "msg must be a byte object or bytearray; "
            "received {} instead.".format(type(msg)))

    # call the Fortran routine
    libf.printmsg_c_char(msg)



if __name__ == '__main__':
    
    # Python byte objects and integers can be passed directly.
    # Integers will be passed as the default C int type, with their value
    # masked to fit. Byte objects are passes as pointer to the memory
    # block that contains their data

    print("--- Using raw libf methods ---")

    msg = b'Hello from Python'

    libf.printmsg_c_ptr(msg)
    libf.printmsg_c_char(msg)
    libf.printmsg_c_char_n(len(msg),msg) # integers can be passed directly

    print("\n--- Using wrapper function ---")

    #
    # Examples of using Python wrapper method
    #
    printmsg(msg)

    # A byte object is an immutable byte sequence
    bytestr = "Just an ASCII string".encode('ascii')
    printmsg(bytestr)

    # A Python bytearray is a mutable byte sequence
    byte_array = bytearray(b'Qorld')
    byte_array[0] = 87  # W
    printmsg(b'Hello, ' + byte_array)

    # The built-in string type is Unicode, hence this doesn't work
    try:
        printmsg("Grüße aus München!")
    except TypeError:
        print("Knew that wouldn't work...")

The output is the following:

$ python fwrap.py 
--- Using raw libf methods ---
 In Fortran (reference): Hello from Python
 In Fortran (copy): Hello from Python
 In Fortran (reference): Hello from Python
 In Fortran (reference): Hello from Python

--- Using wrapper function ---
 In Fortran (reference): Hello from Python
 In Fortran (reference): Just an ASCII string
 In Fortran (reference): Hello, World
Knew that wouldn't work...
1 Like

One more note, since you mentioned you’d like to modify strings.

Python strings (<class 'str'>) are immutable and so are byte objects (<class 'bytes'>). When you pass a bytes object, or a ctypes c_char_p handle, you should not attempt to modify the string. Quoting the documentation:

You should be careful, however, not to pass [instances of the pointer types c_char_p, c_wchar_p, and c_void_p ] to functions expecting pointers to mutable memory. If you need mutable memory blocks, ctypes has a create_string_buffer() function which creates these in various ways. The current memory block contents can be accessed (or changed) with the raw property; if you want to access it as NUL terminated string, use the value property:

Once you’ve modified your string, you can use .decode() method to get a Python string back. The default encoding used will be 'utf-8', but since the first page matches the ASCII character set this should work.

So the interop will look like this:

    msg = b'string'    # immutable
    bmsg = ctypes.create_string_buffer(msg)
    # Modify string via Fortran routine
    libf.shift_characters(bmsg)
    msg = bmsg.value  # as bytes object
    s = bmsg.value.decode() # as string
1 Like

I’m not certain, but I think .PHONY needs to be upper case.

Thanks for spotting it. I bet I have other Makefiles with the same error. An internet search show no results on case-insensitivity when it comes to the .PHONY label, but all the examples used uppercase just like you suggest. Variables on the other hand are case-sensitive.

thank you very much @ivanpribec for the detailed explanations. I will follow all these suggestions to understand the interoperability between C and Fortran. :smile: