Add Fortran interface to pluto

pluto/CMakeLists.txt

@@ -63,6 +63,11 @@ if(HAVE_WARNING_AS_ERROR)
   ecbuild_add_cxx_flags("-Werror" NO_FAIL NAME pluto_cxx_warning_as_error QUIET)
 endif()
 
+ecbuild_add_option( FEATURE FORTRAN DESCRIPTION "Fortran API for pluto" )
+if( HAVE_FORTRAN )
+    ecbuild_enable_fortran( REQUIRED MODULE_DIRECTORY ${PROJECT_BINARY_DIR}/module )
+endif()
+
 include("cmake/pluto_hic_macros.cmake")
 
 add_subdirectory(src)

pluto/src/CMakeLists.txt

@@ -97,3 +97,11 @@ ecbuild_add_library( TARGET pluto
 target_compile_features( pluto INTERFACE cxx_std_17 )
 target_compile_options( pluto PUBLIC $<$<COMPILE_LANGUAGE:CUDA>:--extended-lambda>)
 
+
+ecbuild_add_library( TARGET pluto_f 
+  SOURCES
+    pluto_f/pluto_module.F90
+    pluto_f/pluto_module.cc
+  PRIVATE_LIBS pluto
+  PUBLIC_INCLUDES $<BUILD_INTERFACE:${CMAKE_Fortran_MODULE_DIRECTORY}>
+)

pluto/src/pluto_f/pluto_module.cc

@@ -0,0 +1,93 @@
+#include <cstddef>
+#include <string_view>
+
+#include "pluto/pluto.h"
+
+extern "C" {
+void c_pluto_host_set_default_resource_name(const char* name, int name_size) {
+    pluto::host::set_default_resource(std::string_view{name, static_cast<std::size_t>(name_size)});
+}
+void c_pluto_device_set_default_resource_name(const char* name, int name_size) {
+    pluto::device::set_default_resource(std::string_view{name, static_cast<std::size_t>(name_size)});
+}
+void c_pluto_host_set_default_resource_ptr(pluto::memory_resource* memory_resource) {
+    pluto::host::set_default_resource(memory_resource);
+}
+void c_pluto_device_set_default_resource_ptr(pluto::memory_resource* memory_resource) {
+    pluto::device::set_default_resource(memory_resource);
+}
+void c_pluto_scope_push() {
+    pluto::scope::push();
+}
+void c_pluto_scope_pop() {
+    pluto::scope::pop();
+}
+pluto::memory_resource* c_pluto_host_get_default_resource() {
+    return pluto::host::get_default_resource();
+}
+pluto::memory_resource* c_pluto_device_get_default_resource() {
+    return pluto::device::get_default_resource();
+}
+void* c_pluto_memory_resource_allocate(pluto::memory_resource* memory_resource, std::size_t bytes,
+                                       std::size_t alignment) {
+    if (alignment) {
+        return memory_resource->allocate(bytes, alignment);
+    }
+    else {
+        return memory_resource->allocate(bytes);
+    }
+}
+void c_pluto_memory_resource_deallocate(pluto::memory_resource* memory_resource, void* memory, std::size_t bytes,
+                                        std::size_t alignment) {
+    if (alignment) {
+        memory_resource->deallocate(memory, bytes, alignment);
+    }
+    else {
+        memory_resource->deallocate(memory, bytes);
+    }
+}
+std::size_t c_pluto_memory_pool_resource_size(const pluto::memory_resource* memory_resource) {
+    if (auto* pool = dynamic_cast<const pluto::memory_pool_resource*>(memory_resource)) {
+        return pool->size();
+    }
+    return 0;
+}
+std::size_t c_pluto_memory_pool_resource_capacity(const pluto::memory_resource* memory_resource) {
+    if (auto* pool = dynamic_cast<const pluto::memory_pool_resource*>(memory_resource)) {
+        return pool->capacity();
+    }
+    return 0;
+}
+void c_pluto_memory_pool_resource_release(pluto::memory_resource* memory_resource) {
+    if (auto* pool = dynamic_cast<pluto::memory_pool_resource*>(memory_resource)) {
+        return pool->release();
+    }
+}
+void c_pluto_memory_pool_resource_reserve(pluto::memory_resource* memory_resource, std::size_t bytes) {
+    if (auto* pool = dynamic_cast<pluto::memory_pool_resource*>(memory_resource)) {
+        return pool->reserve(bytes);
+    }
+}
+
+pluto::memory_resource* c_pluto_get_registered_resource(const char* name, int name_size) {
+    return pluto::get_registered_resource(std::string_view{name, static_cast<std::size_t>(name_size)});
+}
+pluto::memory_resource* c_pluto_new_delete_resource() {
+    return pluto::new_delete_resource();
+}
+pluto::memory_resource* c_pluto_device_resource() {
+    return pluto::device_resource();
+}
+pluto::memory_pool_resource* c_pluto_pool_resource() {
+    return pluto::pool_resource();
+}
+pluto::memory_pool_resource* c_pluto_pinned_pool_resource() {
+    return pluto::pinned_pool_resource();
+}
+pluto::memory_pool_resource* c_pluto_managed_pool_resource() {
+    return pluto::managed_pool_resource();
+}
+pluto::memory_pool_resource* c_pluto_device_pool_resource() {
+    return pluto::managed_pool_resource();
+}
+}

pluto/tests/CMakeLists.txt

@@ -12,3 +12,10 @@ add_subdirectory(sandbox)
 
 ecbuild_add_test( TARGET pluto_test_memory_pool SOURCES pluto_test_memory_pool.cc LIBS pluto )
 
+if( HAVE_FORTRAN )
+  ecbuild_add_test( TARGET pluto_test_fortran_memory_resource        SOURCES fortran/test_fortran_memory_resource.F90       LIBS pluto_f )
+  ecbuild_add_test( TARGET pluto_test_fortran_allocator              SOURCES fortran/test_fortran_allocator.F90             LIBS pluto_f )
+  ecbuild_add_test( TARGET pluto_test_fortran_memory_pool_resource   SOURCES fortran/test_fortran_memory_pool_resource.F90  LIBS pluto_f )
+  ecbuild_add_test( TARGET pluto_test_fortran_scope                  SOURCES fortran/test_fortran_scope.F90                 LIBS pluto_f )
+endif()
+

pluto/tests/fortran/test_fortran_allocator.F90

@@ -0,0 +1,37 @@
+program pluto_test_fortran_allocator
+
+use pluto_module, only : pluto, pluto_allocator
+use, intrinsic :: iso_c_binding, only : c_float
+
+implicit none
+
+call run_allocate( pluto%host%make_allocator() )
+call pluto%host%set_default_resource("pluto::pinned_resource")
+call run_allocate(pluto%host%make_allocator())
+call run_allocate(pluto%make_allocator(pluto%managed_resource()))
+call run_allocate(pluto%make_allocator("pluto::managed_resource"))
+call run_allocate(pluto%make_allocator("pluto::managed_resource"))
+call pluto%host%set_default_resource("pluto::pinned_resource")
+
+contains
+
+subroutine run_allocate(allocator)
+    implicit none
+    type(pluto_allocator) :: allocator
+    integer, parameter :: wp = c_float
+    real(wp), pointer :: array1d(:), array2d(:,:), array3d(:,:,:), array4d(:,:,:,:)
+
+    call allocator%allocate(array1d, [20])
+    call allocator%deallocate(array1d)
+
+    call allocator%allocate(array2d, [5,6])
+    call allocator%deallocate(array2d)
+
+    call allocator%allocate(array3d, [5,3,6])
+    call allocator%deallocate(array3d)
+
+    call allocator%allocate(array4d, [5,2,3,6])
+    call allocator%deallocate(array4d)
+end subroutine
+
+end program

pluto/tests/fortran/test_fortran_memory_pool_resource.F90

@@ -0,0 +1,60 @@
+program pluto_test_fortran_memory_pool_resource
+
+use pluto_module, only : pluto, pluto_memory_resource, pluto_allocator
+use iso_c_binding
+implicit none
+
+write(0,*) "reserve"
+call reserve_mem()
+write(0,*) "release"
+call release_mem()
+
+write(0,*) "allocate"
+call run_allocate()
+write(0,*) "release"
+call release_mem()
+write(0,*) "reserve"
+call pluto%reserve(pluto%managed_pool_resource(), int(1024*1024*500,c_size_t))
+write(0,*) "allocate"
+call run_allocate()
+
+! following should be a no-op, as new_delete_resource is not a memory_pool_resource
+call pluto%reserve(pluto%new_delete_resource(), int(1024*1024*500,c_size_t))
+call pluto%release(pluto%new_delete_resource())
+
+write(0,*) "end"
+
+contains
+
+subroutine reserve_mem()
+  type(pluto_memory_resource) :: memory_resource
+  memory_resource = pluto%managed_pool_resource()
+  call memory_resource%reserve(int(1024*1024*8,c_size_t))
+
+  ! Or one-liner
+  call pluto%reserve(pluto%managed_pool_resource(), int(1024*1024*257,c_size_t))
+end subroutine
+
+subroutine release_mem()
+  type(pluto_memory_resource) :: memory_resource
+  memory_resource = pluto%managed_pool_resource()
+  call memory_resource%release()
+
+  ! Or one-liner
+  call pluto%release(pluto%managed_pool_resource())
+end subroutine
+
+subroutine run_allocate()
+    implicit none
+    integer :: j
+    integer, parameter :: wp = c_float
+    real(wp), pointer :: array2d(:,:)
+    type(pluto_allocator) :: allocator
+    allocator = pluto%make_allocator(pluto%managed_pool_resource())
+    do j=1,100
+        call allocator%allocate(array2d, shape=[1000*j, 1000])
+        call allocator%deallocate(array2d)
+    enddo
+end subroutine
+
+end program

pluto/tests/fortran/test_fortran_memory_resource.F90

@@ -0,0 +1,35 @@
+
+program pluto_test_fortran_memory_resource
+
+use pluto_module, only : pluto, pluto_memory_resource
+use, intrinsic :: iso_c_binding, only: c_ptr, c_sizeof, c_float, c_f_pointer
+
+implicit none
+
+type(pluto_memory_resource) :: mr
+call run_allocate(pluto%host%get_default_resource())
+call run_allocate(pluto%new_delete_resource())
+call run_allocate(pluto%managed_resource())
+call run_allocate(pluto%pinned_resource())
+call pluto%host%set_default_resource(pluto%managed_resource())
+call run_allocate(pluto%host%get_default_resource())
+call pluto%host%set_default_resource("pluto::pinned_resource")
+call run_allocate(pluto%host%get_default_resource())
+
+contains
+
+subroutine run_allocate(memory_resource)
+    implicit none
+    integer, parameter :: wp = c_float
+    type(pluto_memory_resource) :: memory_resource
+    type(c_ptr) :: mem
+    real(wp), pointer :: array1d(:)
+    real(wp) :: real_value
+    integer :: N = 10
+    call memory_resource%allocate(mem, N*c_sizeof(real_value))
+    call c_f_pointer(mem, array1d, [N])
+    array1d(:) = 5
+    call memory_resource%deallocate(mem, N*c_sizeof(real_value))
+end subroutine
+
+end program

pluto/tests/fortran/test_fortran_scope.F90

@@ -0,0 +1,50 @@
+program pluto_test_fortran_allocator
+
+use pluto_module, only : pluto, pluto_allocator
+use, intrinsic :: iso_c_binding, only : c_float
+
+implicit none
+
+type(pluto_allocator) :: allocator(2)
+
+call run_allocate(pluto%host%make_allocator(), "program -- default")
+
+call pluto%scope%push()
+    call pluto%host%set_default_resource("pluto::pinned_resource")
+
+    allocator(1) = pluto%host%make_allocator()
+    call run_allocate(pluto%host%make_allocator(), "scope 1 -- pinned")
+
+    call pluto%scope%push()
+        call pluto%host%set_default_resource("pluto::managed_resource")
+
+        allocator(2) = pluto%host%make_allocator()
+        call run_allocate(pluto%host%make_allocator(), "scope 2 -- managed")
+
+    call pluto%scope%pop()
+
+    call run_allocate(pluto%host%make_allocator(), "scope 1 -- pinned")
+
+call pluto%scope%pop()
+
+call run_allocate(pluto%host%make_allocator(), "program -- default")
+
+call run_allocate(allocator(1), "allocator(1) -- pinned")
+call run_allocate(allocator(2), "allocator(2) -- managed")
+
+contains
+
+subroutine run_allocate(allocator, message)
+    implicit none
+    type(pluto_allocator) :: allocator
+    character(len=*) :: message
+    integer, parameter :: wp = c_float
+    real(wp), pointer :: array4d(:,:,:,:)
+
+    write(0,*) "run_allocate: ", message
+
+    call allocator%allocate(array4d, [5,2,3,6])
+    call allocator%deallocate(array4d)
+end subroutine
+
+end program