fortranfunction-pointersderived-types

Nopass procedure pointer passed between derived types causes Segmentation fault


I want to pass a procedure pointer between two classes in modern Fortran. this procedure pointer should

  1. be called from within the second object
  2. access the first ojects' components, without having it as dummy argument.

A clear example is here, imagine doing an object-oriented wrapper of an ODE solver:

module test_funptr
    implicit none
    public

    type, public :: ode_solver
        integer :: NEQ = 0
        procedure(ode_api), pointer, nopass :: f => null()
    contains
        procedure :: run
    end type ode_solver

    type, public :: ode_problem
        integer :: NEQ = 10
        procedure(ode_api), pointer, nopass :: yprime => null()
    contains
        procedure :: init
    end type ode_problem

    abstract interface
        subroutine ode_api(NEQ,YDOT)
            integer, intent(in) :: NEQ
            real(8), intent(inout) :: YDOT(NEQ)
        end subroutine ode_api
    end interface
contains
    ! Initialize problem variables
    subroutine init(this,NEQ)
        class(ode_problem), intent(inout) :: this
        integer, intent(in) :: NEQ

        ! Associate function pointer
        this%yprime => problem_api
    contains
        ! nopass ODE solver API
        subroutine problem_api(NEQ,YDOT)
            integer, intent(in) :: NEQ
            real(8), intent(inout) :: YDOT(NEQ)

            integer :: i

            print *, 'entered problem API with NEQ=',NEQ
            forall(i=1:NEQ) YDOT(i) = real(i,8)
        end subroutine
    end subroutine init

    subroutine run(this)
        class(ode_solver), intent(inout) :: this

        real(8) :: ydot(this%neq)

        ydot = 0.0

        print *, 'enter solver run with NEQ=',this%NEQ
        print *, 'is function associated? ',associated(this%f)

        call this%f(this%neq,ydot)
    end subroutine run
end module test_funptr

program test
    use test_funptr

    type(ode_solver) :: solver
    type(ode_problem) :: prob

    call prob%init(10)

    ! Associate ode solver
    solver%neq = prob%NEQ
    solver%f => prob%yprime

    call solver%run()
end program test

This program returns with gfortran-10:

 enter solver run with NEQ=          10
 is function associated?  T

Program received signal SIGILL: Illegal instruction.

The procedure seems properly associated, but it can't be called. Am I doing something wrong passing the procedure pointers, or I'm doing something out-of-standard? I'm concerned the contained subroutine may go out of scope, but if so, how can I achieve this behavior?

The tricky part is of course that the function should access data from the other variable instance.


Solution

  • As pointed out, internal (contained) procedures are not the way to go, as they cannot be targets to procedure pointers. Hopefully this will be catched by the compilers.

    I've figured out an elegant way to accomplish the aim to pass an interfaced procedure between two classes this way:

    1. class 1 needs to call that function: it must contain a pointer to class 2
    1. class 2 contains the actual implementation, it should instantiate an abstract type that contains the same interfaced function, but with the derived type as dummy argument

    Here I'm providing an implementation that works:

    module odes 
        implicit none
    
        type, abstract, public :: ode_problem
               integer :: NEQ
           contains
               procedure(ode_api), deferred :: fun
        end type ode_problem
    
        type, public :: ode_solver
             integer :: NEQ
             class(ode_problem), pointer :: problem => null()
             contains
                 procedure :: init
                 procedure :: run
        end type ode_solver
    
        abstract interface
           subroutine ode_api(this,YDOT)
               import ode_problem
               class(ode_problem), intent(inout) :: this
               real(8), intent(out) :: YDOT(this%NEQ)
           end subroutine ode_api
        end interface
    
        contains
    
        ! Associate problem to ODE solver
        subroutine init(this,my_problem)
            class(ode_solver), intent(inout) :: this
            class(ode_problem), intent(in), target :: my_problem
    
            this%neq = my_problem%NEQ
            this%problem => my_problem
    
        end subroutine init
    
        ! call the nopass f77 interface function
        subroutine run(this)
           class(ode_solver), intent(inout) :: this
           real(8) :: YDOT(this%NEQ)
           integer :: i 
    
           if (.not.associated(this%problem)) stop 'solver not associated to a problem'
    
           ! This will be in general passed to another function as an argument 
           call ode_f77_api(this%NEQ,YDOT)
    
           contains
    
             subroutine ode_f77_api(NEQ,YDOT)
                 integer, intent(in) :: NEQ
                 real(8), intent(out) :: YDOT(NEQ)
    
                 ! This is just a nopass interface to this problem's function that can
                 ! access internal storage
                 call this%problem%fun(YDOT)
             end subroutine ode_f77_api
    
        end subroutine run    
    
    end module odes
    
    ! Provide an actual implementation
    module my_ode_problem
       use odes
       implicit none
    
            type, public, extends(ode_problem) :: exp_kinetics
                real(8) :: k = -0.5d0
                contains
                   procedure :: fun => exp_fun
            end type exp_kinetics
    
       contains
    
            subroutine exp_fun(this,YDOT) 
                class(exp_kinetics), intent(inout) :: this
                real(8), intent(out) :: YDOT(this%NEQ)
                integer :: i
    
                forall(I=1:this%NEQ) YDOT(i) = this%k*real(i,8)
                print 1, this%NEQ,(i,YDOT(i),i=1,this%NEQ)
    
                1 format('test fun! N=',i0,': ',*(/,10x,' ydot(',i0,')=',f5.2,:))
    
            end subroutine exp_fun
    
    end module my_ode_problem
    
    program test_fun_nopass
            use odes
            use my_ode_problem
            implicit none
    
            type(exp_kinetics) :: prob
            type(ode_solver) :: ode
    
            prob%NEQ = 10
            call ode%init(prob)
    
            call ode%run()
    
            stop 'success!'
    end program test_fun_nopass          
    

    This program returns:

    test fun! N=10: 
               ydot(1)=-0.50
               ydot(2)=-1.00
               ydot(3)=-1.50
               ydot(4)=-2.00
               ydot(5)=-2.50
               ydot(6)=-3.00
               ydot(7)=-3.50
               ydot(8)=-4.00
               ydot(9)=-4.50
               ydot(10)=-5.00
    STOP success!