Fortran polymorphism, functions and allocation

Question

I am quite a beginner in OOP with Fortran and I am trying to write a program with procedures that deal with polymorphic variables as arguments. Although my original code is much more complicated (many procedures, several derived types etc), I could isolate a simple example of my problem, say: I have a procedure that copies a polymorphic variable and slightly modifies this copy.

I was able to successfully write my test program using a subroutine:

MODULE my_module

type :: my_type
    real :: data
endtype my_type

type, extends(my_type) :: my_derived_type
end type my_derived_type

CONTAINS

subroutine sub_copy(old,new) 
implicit none
class(my_type), intent(in) :: old
class(my_type), allocatable, intent(out) :: new
allocate(new, source = old)
new%data = new%data + 1
end subroutine sub_copy

END MODULE my_module

PROGRAM my_prog
use my_module
implicit none
type(my_derived_type) :: x
class(my_type), allocatable :: y

x%data = 1.0
call sub_copy(x,y)
print*,y%data
deallocate(y)

END PROGRAM my_prog

This performs nicely both regarding the expected result and the memory allocation/deallocation.

However, I have been fighting for days trying to make working a Fortran function that would do the same job.

It seems that a function defined in a similar way to the subroutine (see here after) cannot be used simply as

y = fun_copy(x)

and my gfortran compiler (v5.0.0) complains:

Error: Assignment to an allocatable polymorphic variable at (1) is not yet supported

I have read here and there that indeed such assignment is not supported by my compiler. Waiting for that, I have tried to work that around by defining my own assignment operator (=). The following code works:

MODULE my_module

type :: my_type
    real :: data
endtype my_type

type, extends(my_type) :: my_derived_type
end type my_derived_type

interface assignment(=)
  module procedure myassign
end interface

CONTAINS

function fun_copy(old) result(new) 
implicit none
class(my_type), intent(in) :: old
class(my_type), allocatable :: new
allocate(new, source = old)
new%data = new%data + 1
end function fun_copy

subroutine myassign(new,old)
class(my_type), intent(in)  :: old
class(my_type), allocatable, intent(out) :: new
allocate(new, source=old)
end subroutine

END MODULE my_module

PROGRAM my_prog
use my_module
implicit none
type(my_derived_type) :: x
class(my_type), allocatable :: y

x%data = 1.0
y = fun_copy(x)
print*,y%data
deallocate(y)

END PROGRAM my_prog

It works in the sense that indeed, a copy of x is created as y. However, inspecting the memory budget of this simple test program (I use the Instrument software on OS X), it appears that some memory is not deallocated before the end of it. I suspect that the copy function and the assignment subroutine both allocate memory and that I only free one occurrence, leaving one allocated.

As I intend to use such a routine a large number of times in a much more complicated code, I am really concerned about memory allocation/deallocation. Of course, I can use the subroutine version of the program, but if there is a way, I would prefer the function version.

Is there a way to deal with such a problem?

Answer 1

Have you tried using pointers?

    module my_module

        implicit none

        type :: my_type
            real :: data
        contains
            procedure              :: sub_copy
            procedure              :: fun_copy_ptr
            procedure              :: fun_copy_alloc
            procedure, pass (this) :: my_assign
            generic                :: assignment(=) => my_assign
        end type my_type

        type, extends(my_type) :: my_derived_type
        end type my_derived_type

    contains

        subroutine sub_copy(this, new)
            class(my_type), intent (in)               :: this
            class(my_type), allocatable, intent (out) :: new

            allocate(new, source=this)
            new%data = new%data + 1

        end subroutine sub_copy

        function fun_copy_alloc(this) result (new)
            class(my_type), intent(in)  :: this
            class(my_type), allocatable :: new

            allocate(new, source=this)
            new%data = new%data + 1.0

        end function fun_copy_alloc

        function fun_copy_ptr(this) result (new)
            class(my_type), intent(in) :: this
            class(my_type), pointer    :: new

            allocate(new, source=this)
            new%data = new%data + 1.0

        end function fun_copy_ptr

        subroutine my_assign(new, this)
            class(my_type), intent(in)               :: this
            class(my_type), allocatable, intent(out) :: new

            allocate(new, source=this)

        end subroutine

    end module my_module

    program my_prog

        use my_module, only: &
            my_type, &
            my_derived_type

        implicit none
        type(my_derived_type)       :: x
        class(my_type), allocatable :: y
        class(my_type), pointer     :: y_ptr => null()

        x%data = 1.0

        ! Case 1
        call x%sub_copy(y)
        print *, y%data
        deallocate(y)

        ! Case 2
        y_ptr => x%fun_copy_ptr()
        print *, y_ptr%data
        deallocate(y_ptr)

        ! Case 3
        allocate( y, source=x%fun_copy_alloc() )
        print *, y%data
        deallocate(y)

    end program my_prog