A derived type containing a callback function as a member

Help
1

I would like to define a derived type containing a callback function (subroutine) as a member.

For example, problem is a derived type that defines an optimization problem. It contains objective, n, and x0 as the members. I imagine it will be implemented as follows.

type problem                                                                                                                         
       integer :: n                                                                                                                 
       real, allocatable :: x0(:)                                             
       procedure(FUN)  :: objective    ! Should this be a pointer?                         
end type problem

Here, objective is a callback function (subroutine) with the following interface.

abstract interface                                                                                                                    
     subroutine FUN(x, f)                                                                                                              
     implicit none                                                                                                                     
     real, intent(in) :: x(:)                                                                                                     
     real, intent(out) :: f                                                                                                       
     end subroutine FUN                                                                                                                
end interface

Now suppose that I would like to construct an instance of problem. In particular, I would like to set objective to the following subroutine.

subroutine qua(x, f) 
implicit none                                                                                                                     
real, intent(in) :: x(:)                                                                                                     
real, intent(out) :: f  
f = sum(x**2)     
end function

How should this be implemented? Thank you very much.

1 Like
2 
procedure(FUN),pointer,nopass::objective=>NULL()

module test
    implicit none
    type problem
        integer :: n
        real, allocatable :: x0(:)
        procedure(FUN),nopass,pointer:: objective=>NULL()  ! Should this be a pointer?
    end type problem

    abstract interface
    subroutine FUN(x, f)
        implicit none
        real, intent(in)  :: x(:)
        real, intent(out) :: f
    end subroutine FUN
end interface

end module test
program main
    use test
    implicit none
    type(problem)::x
    procedure(fun)::qua
    real::y
    integer::i
    x%n=4
    x%x0=[(i,i=1,x%n)]
    x%objective=>qua
    call x%objective(x%x0,y)
    write(*,*)y
end program main

subroutine qua(x, f)
    implicit none
    real, intent(in) :: x(:)
    real, intent(out) :: f
    f = sum(x**2)
end subroutine qua
2 Likes
3

Note that with the nopass attribute you will have no access to the components of the object.

4

The typical way to do this would be to define an abstract type. For example:

type, abstract :: problem_t
contains
    procedure(objective_i), deferred :: objective
end type

abstract interface
    pure real function objective_i(this, x) result(f)
        import problem_t
        class(problem_t), intent(in) :: this
        real, intent(in) :: x(:)
    end function
end interface

And then implement a concrete type that extends it:

type, extends(problem_t) :: qua_problem_t
    integer :: n
    real, allocatable :: x0(:)
contains
    procedure :: objective
end type

contains

    pure real function objective_i(this, x) result(f)
        import problem_t
        class(problem_t), intent(in) :: this
        real, intent(in) :: x(:)
   
        ! You could also use n and x0 from qua_problem_t here
        f = sum(x**2)
    end function

Alternatively, Fortran actually has some kind of support for closures as well, though it’s not so obvious. Say you have a subroutine like this:

module evaluator
    implicit none

    private
    public evaluate

    abstract interface
        real function func_i(x)
            real, intent(in) :: x
        end function
    end interface

contains

    real function evaluate(func, x) result(f)
        procedure(func_i) :: func
        real, intent(in) :: x

        f = func(x)
    end function
end module

To pass in a function func(x) = a * x where you specify a yourself you can do the following:

program main
    use evaluator, only: evaluate
    implicit none

    real :: a

    a = 2
    write(*,*) 'func(3) = ', evaluate(func, 3.0)

    contains
        real function func(x) result(f)
            real, intent(in) :: x

            f = a * x
        end function
end program main

Notice here that a is defined in main, but accessible inside func due to the use of contains and because it is not pure.

2 Likes
5

Thanks for the code example. The program compiles and runs, giving the same result with gfortran and ifort, even if func is declared pure. A pure function can access a variable such as a but cannot change it. I believe func cannot be declared simple (a feature of Fortran 202x) because it accesses a.

6

You’re indeed right! Accessing the variable is no problem, only modifying it :+1:

7

Thank you @Euler-37 for the code.

What if I hope problem to have an initialization procedure that initializes problem according to a string indicating the problem name and an integer indicating the dimension? In other words, I hope to be able to initialize problem as follows.

type(problem) :: p
! The following should set `p%n` to `4`,  `p%objective` to `qua`, and `p%x0` to `[1, 1, 1, 1]`. 
call p%intialize('qua', 4)

Thank you very much!

8

Thank you @plevold for the code. Your approach is very interesting, although it is a bit more difficult for me to understand compared to @Euler-37 's code. How do you compare the two approaches? Would you mind elaborating a bit on why your approach is more typical? Sorry for this naive question, but I have absolutely no experience in OOP with Fortran. Thank you very much!

9

I don’t know ,may be fortran doesn’t have this eval-like function.
what we can do just call p%init(qua,4),

subroutine init(this,func,num)
    class(problem),intent(inout)::this
    procedure(FUN)::func
    integer,intent(in)::num
    this%objective=>func
    this%n=num
    !....
end subroutine init
10

Thank you @Euler-37 . I tried this implementation, but compilers complain that init is not a member of problem, which agrees with how I understand the situation. Did I overlook something?

11 
module test
    implicit none
    type problem
        integer :: n
        real, allocatable :: x0(:)
        procedure(FUN),nopass,pointer:: objective=>NULL()  
    contains
        procedure,pass::init !this is type bound procedure
    end type problem

    abstract interface
    subroutine FUN(x, f)
        implicit none
        real, intent(in)  :: x(:)
        real, intent(out) :: f
    end subroutine FUN
end interface
contains
    subroutine init(this,func,num)
        class(problem),intent(inout)::this
        procedure(FUN)::func
        integer,intent(in)::num
        this%objective=>func
        this%n=num
        !....
    end subroutine init

end module test
1 Like
12

This is exactly how the test_case_t types are implemented in vegetables (see here). This is how I would recommend implementing such a feature if:

  • There is no other functionality that users of your type will need to provide
  • They do not need to capture the values of variable inside the function at run time (i.e. actual closures, which Fortran doesn’t support, as once the enclosing scope is left, the variable no longer exists)
  • You don’t know ahead of time all the function options your users will want to use

If the first point is not true, you may want to make your type abstract and have users extend it to provide their function. Or, define an abstract type that users must provide an instance of to your type. If the second point is not true, the previous suggestions may prove useful as well. If the last point is not true, it may be simpler to simply have a select case inside the procedure that makes use of the different options, and provide a set of enumerator values as the available options.

Basically, consider the next larger context (i.e. how this code will be used) when deciding what design strategy to employ.

2 Likes
13

Thank @Euler-37 for the code.

In case it is useful to others, I summarize @Euler-37 's approach in the following code. It can be compiled by gfortran, ifort, ifx, nagfor, flang, AOCC flang, and nvfortran. Absoft Pro Fortran 22.0 supports F2003 fairly well, but cannot compile the code. Not surprisingly, the discontinued (F95) compilers g95, Lahey lf95, and sunf95 all fail.

module fun_mod
implicit none
private
public :: FUN

abstract interface
    subroutine FUN(x, f)
    implicit none
    real, intent(in) :: x(:)
    real, intent(out) :: f
    end subroutine FUN
end interface

end module fun_mod


module test_mod

use fun_mod, only : FUN
implicit none
private
public :: PROBLEM

type PROBLEM
    integer :: n
    real, allocatable :: x0(:)
    procedure(FUN), nopass, pointer :: objective => null()
contains
    procedure, pass :: init  ! Type-bound procedure
end type PROBLEM

contains

subroutine init(prob, probname, n)
implicit none
class(PROBLEM), intent(inout) :: prob
character(len=*), intent(in) :: probname
integer, intent(in) :: n
integer :: i
select case (probname)
case ('quad')
    prob % objective => quad
! There can be other cases ...
case default  ! This is an error case. Should have some error-handling code. 
    prob % objective => null()
end select
prob % n = n
!allocate (prob % x0(n))  ! Not needed if the compiler supports the `F03` automatic allocation upon assignment
prob % x0 = [(i, i=1, n)]
end subroutine init

subroutine quad(x, f)
implicit none
real, intent(in) :: x(:)
real, intent(out) :: f
f = sum(x**2)
end subroutine quad

end module test_mod


program main

use test_mod, only : PROBLEM
implicit none

type(PROBLEM) :: p
real :: y

call p % init('quad', 4)
call p % objective(p % x0, y)

write (*, *) y

end program main
1 Like