如果您需要一个线程安全的解决方案和/或再次从 C 中释放空间的可能性,下面的示例将完成这项工作:
#include <stdio.h>
void test_mem_alloc(float ** array, void **wrapper);
void free_wrapper(void **wrapper);
int main()
{
float *array;
void *wrapper;
/* Allocates space in Fortran. */
test_mem_alloc(&array, &wrapper);
printf( "Values are: %f %f\n", array [0], array [1]);
/* Deallocates space allocated in Fortran */
free_wrapper(&wrapper);
return 0;
}
在 Fortran 方面,您有一个通用的包装器 type CWrapper
,它可以携带任何类型的派生类型。后者包含您想要传递的数据。该CWrapper
类型接受任意有效负载,您总是会free_wrapper()
从 C 调用例程来释放内存。
module memalloc
use, intrinsic :: iso_c_binding
implicit none
type :: CWrapper
class(*), allocatable :: data
end type CWrapper
type :: CfloatArray
real(c_float), allocatable :: array(:)
end type CfloatArray
contains
subroutine test_mem_alloc(c_array_ptr, wrapper_ptr)&
& bind(C, name="test_mem_alloc")
type (c_ptr), intent (out) :: c_array_ptr
type(c_ptr), intent(out) :: wrapper_ptr
type(CWrapper), pointer :: wrapper
allocate(wrapper)
allocate(CfloatArray :: wrapper%data)
select type (data => wrapper%data)
type is (CfloatArray)
allocate(data%array(2))
data%array(:) = [2.5_c_float, 4.4_c_float]
c_array_ptr = c_loc(data%array)
end select
wrapper_ptr = c_loc(wrapper)
end subroutine test_mem_alloc
subroutine free_cwrapper(wrapper_ptr) bind(C, name='free_wrapper')
type(c_ptr), intent(inout) :: wrapper_ptr
type(CWrapper), pointer :: wrapper
call c_f_pointer(wrapper_ptr, wrapper)
deallocate(wrapper)
end subroutine free_cwrapper
end module memalloc