addres fortran memory issues

fortran/micm.F90

@@ -132,8 +132,8 @@ end function get_user_defined_reaction_rates_ordering_c
   end interface
 
   type :: micm_t
-    type(mappings_t) :: species_ordering
-    type(mappings_t) :: user_defined_reaction_rates
+    type(mappings_t), pointer :: species_ordering => null()
+    type(mappings_t), pointer :: user_defined_reaction_rates => null()
     type(c_ptr), private         :: ptr = c_null_ptr
   contains
     ! Solve the chemical system
@@ -215,15 +215,15 @@ function constructor(config_path, solver_type, num_grid_cells, error)  result( t
         return
     end if
 
-    this%species_ordering = mappings_t( get_species_ordering_c(this%ptr, error_c) )
+    this%species_ordering => mappings_t( get_species_ordering_c(this%ptr, error_c) )
     error = error_t(error_c)
     if (.not. error%is_success()) then
         deallocate(this)
         nullify(this)
         return
     end if
 
-    this%user_defined_reaction_rates = &
+    this%user_defined_reaction_rates => &
         mappings_t( get_user_defined_reaction_rates_ordering_c(this%ptr, error_c) )
     error = error_t(error_c)
     if (.not. error%is_success()) then
@@ -438,6 +438,10 @@ subroutine finalize(this)
 
     type(error_t_c)             :: error_c
     type(error_t)               :: error
+
+    if (associated(this%species_ordering)) deallocate(this%species_ordering)
+    if (associated(this%user_defined_reaction_rates)) &
+        deallocate(this%user_defined_reaction_rates)
     call delete_micm_c(this%ptr, error_c)
     this%ptr = c_null_ptr
     error = error_t(error_c)

fortran/test/unit/util.F90

@@ -146,7 +146,7 @@ subroutine test_mapping_t()
     type(mapping_t_c), target :: c_mappings(3)
     type(c_ptr) :: c_mappings_ptr
     type(mapping_t), allocatable :: f_mappings(:)
-    type(mappings_t) :: mappings
+    type(mappings_t), pointer :: mappings
     logical :: found
     type(error_t) :: error
     integer :: index
@@ -216,7 +216,7 @@ subroutine test_mapping_t()
     c_mappings(3)%name_ = create_c_string( "grault" )
 
     c_mappings_ptr = c_loc( c_mappings )
-    f_mappings = copy_mappings( c_mappings_ptr, 3_c_size_t )
+    call copy_mappings( c_mappings_ptr, 3_c_size_t, f_mappings )
     call delete_string_c( c_mappings(1)%name_ )
     call delete_string_c( c_mappings(2)%name_ )
     call delete_string_c( c_mappings(3)%name_ )
@@ -241,7 +241,7 @@ subroutine test_mapping_t()
     ASSERT( .not. found )
 
     ! create mappings object from array
-    mappings = mappings_t( f_mappings )
+    mappings => mappings_t( f_mappings )
     ASSERT_EQ( mappings%size(), 3 )
     ASSERT_EQ( mappings%index( 1 ), 22 )
     ASSERT_EQ( mappings%name( 1 ), "quux" )
@@ -259,6 +259,7 @@ subroutine test_mapping_t()
     ASSERT( error%is_success() )
     index = mappings%index( "foo", error )
     ASSERT( .not. error%is_success() )
+    deallocate( mappings )
 
   end subroutine test_mapping_t
 
@@ -270,8 +271,8 @@ subroutine build_and_check_index_mapping_t(config)
 
     type(mapping_t), pointer :: map
     type(mapping_t), allocatable :: f_map(:)
-    type(mappings_t) :: source_map, target_map
-    type(index_mappings_t) :: index_mappings
+    type(mappings_t), pointer :: source_map, target_map
+    type(index_mappings_t), pointer :: index_mappings
     type(error_t) :: error
     real(dk), allocatable :: source_data(:), target_data(:)
 
@@ -282,17 +283,17 @@ subroutine build_and_check_index_mapping_t(config)
     map => mapping_t( "Test2", 5 )
     f_map( 2 ) = map
     deallocate( map )
-    source_map = mappings_t( f_map )
+    source_map => mappings_t( f_map )
     map => mapping_t( "Test2", 3 )
     f_map( 1 ) = map
     deallocate( map )
     map => mapping_t( "Test3", 1 )
     f_map( 2 ) = map
     deallocate( map )
-    target_map = mappings_t( f_map )
+    target_map => mappings_t( f_map )
     deallocate( f_map )
 
-    index_mappings = index_mappings_t( config, source_map, target_map, error )
+    index_mappings => index_mappings_t( config, source_map, target_map, error )
     ASSERT( error%is_success() )
 
     source_data = (/ 1.0_dk, 2.0_dk, 3.0_dk, 4.0_dk, 5.0_dk /)
@@ -303,6 +304,9 @@ subroutine build_and_check_index_mapping_t(config)
     ASSERT_EQ( target_data( 2 ), 20.0_dk )
     ASSERT_EQ( target_data( 3 ), 2.0_dk )
     ASSERT_EQ( target_data( 4 ), 40.0_dk )
+    deallocate( index_mappings )
+    deallocate( source_map )
+    deallocate( target_map )
 
   end subroutine build_and_check_index_mapping_t
 

fortran/util.F90

@@ -28,16 +28,14 @@ module musica_util
 
   !> String type
   type :: string_t
-  private
     character(len=:), allocatable :: value_
   contains
     procedure :: get_char_array => get_char_array_string_t
     procedure, private, pass(from) :: char_assign_string
     procedure, private, pass(to) :: string_assign_char
-    procedure, private, pass(to) :: string_assign_string
     procedure, private, pass(to) :: string_assign_string_t_c
     generic :: assignment(=) => char_assign_string, string_assign_char, &
-                                string_assign_string, string_assign_string_t_c
+                                string_assign_string_t_c
   end type string_t
 
   interface string_t
@@ -282,19 +280,6 @@ subroutine string_assign_char( to, from )
 
   end subroutine string_assign_char
 
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-  !> Copy a string
-  subroutine string_assign_string( to, from )
-
-    class(string_t), intent(inout) :: to
-    class(string_t), intent(in) :: from
-
-    if (allocated(to%value_)) deallocate(to%value_) 
-    allocate( to%value_, source = from%value_ )
-
-  end subroutine string_assign_string
-
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
   !> Copy a c string to a string_t
@@ -544,22 +529,23 @@ end function mapping_index
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
   !> Copies mappings from a c array to a fortran array
-  function copy_mappings( c_mappings, n_mappings ) result( f_mappings )
+  subroutine copy_mappings( c_mappings, n_mappings, f_mappings )
 
-    type(c_ptr), intent(in) :: c_mappings
-    integer(c_size_t), intent(in) :: n_mappings
-    type(mapping_t), allocatable :: f_mappings(:)
+    type(c_ptr),                  intent(in)    :: c_mappings
+    integer(c_size_t),            intent(in)    :: n_mappings
+    type(mapping_t), allocatable, intent(inout) :: f_mappings(:)
 
     integer :: i
     type(mapping_t_c), pointer :: mappings(:)
 
     call c_f_pointer( c_mappings, mappings, [ n_mappings ] )
+    if ( allocated( f_mappings ) ) deallocate( f_mappings )
     allocate( f_mappings( n_mappings ) )
     do i = 1, n_mappings
       f_mappings(i) = mappings(i)
     end do
 
-  end function copy_mappings
+  end subroutine copy_mappings
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -604,8 +590,9 @@ function mappings_constructor_from_mappings_t_c( c_mappings ) &
       result( mappings )
 
     type(mappings_t_c), intent(in) :: c_mappings
-    type(mappings_t) :: mappings
+    type(mappings_t), pointer :: mappings
 
+    allocate( mappings )
     mappings%mappings_c_ = c_mappings
 
   end function mappings_constructor_from_mappings_t_c
@@ -618,11 +605,12 @@ function mappings_constructor_from_mapping_t_array( mappings ) &
       result( new_mappings )
 
     type(mapping_t), intent(in) :: mappings(:)
-    type(mappings_t) :: new_mappings
+    type(mappings_t), pointer :: new_mappings
 
     integer :: i
     type(mapping_t_c), pointer :: mappings_c(:)
 
+    allocate( new_mappings )
     new_mappings%mappings_c_ = &
         create_mappings_c( int( size( mappings ), c_size_t ) )
     call c_f_pointer( new_mappings%mappings_c_%mappings_, mappings_c, &
@@ -721,10 +709,11 @@ function index_mappings_constructor( configuration, source, target, error ) &
     type(mappings_t),      intent(in)  :: source
     type(mappings_t),      intent(in)  :: target
     type(error_t),         intent(out) :: error
-    type(index_mappings_t)             :: mappings
+    type(index_mappings_t), pointer    :: mappings
 
     type(error_t_c) :: error_c
 
+    allocate( mappings )
     mappings%mappings_c_ = create_index_mappings_c( &
         configuration%configuration_c_, source%mappings_c_, &
         target%mappings_c_, error_c )

src/tuvx/tuvx_util.F90

@@ -9,7 +9,7 @@ module musica_tuvx_util
   private
 
   public :: string_t_c, string_t, error_t_c, error_t, mapping_t_c, mapping_t, &
-            to_c_string, to_f_string, assert, copy_mappings, delete_string_c
+            to_c_string, to_f_string, assert, delete_string_c
 
   !> Wrapper for a c string
   type, bind(c) :: string_t_c
@@ -291,26 +291,6 @@ function mapping_index( this ) result( index )
 
   end function mapping_index
 
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-  !> Copies mappings from a c array to a fortran array
-  function copy_mappings( c_mappings, n_mappings ) result( f_mappings )
-
-    type(c_ptr), intent(in) :: c_mappings
-    integer(c_size_t), intent(in) :: n_mappings
-    type(mapping_t), allocatable :: f_mappings(:)
-
-    integer :: i
-    type(mapping_t_c), pointer :: mappings(:)
-
-    call c_f_pointer( c_mappings, mappings, [ n_mappings ] )
-    allocate( f_mappings( n_mappings ) )
-    do i = 1, n_mappings
-      f_mappings(i) = mappings(i)
-    end do
-
-  end function copy_mappings
-
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
   !> Convert a fortran character array to a c string