I want to pass a procedure pointer between two classes in modern Fortran. this procedure pointer should
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 contain
ed 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.
As pointed out, internal (contain
ed) 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:
nopass
function should be inside this class, as an internal procedure (this way, it'll never go out of scope)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!