diff --git a/fortran/micm.F90 b/fortran/micm.F90 index 23e0e190..80c76c41 100644 --- a/fortran/micm.F90 +++ b/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,7 +215,7 @@ 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) @@ -223,7 +223,7 @@ function constructor(config_path, solver_type, num_grid_cells, error) result( t 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) diff --git a/fortran/test/unit/util.F90 b/fortran/test/unit/util.F90 index fd4320a2..0fa09513 100644 --- a/fortran/test/unit/util.F90 +++ b/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 diff --git a/fortran/util.F90 b/fortran/util.F90 index 788e599d..780a3d2c 100644 --- a/fortran/util.F90 +++ b/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 ) diff --git a/src/tuvx/tuvx_util.F90 b/src/tuvx/tuvx_util.F90 index 8718f2f1..ad6b6ebb 100644 --- a/src/tuvx/tuvx_util.F90 +++ b/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