Store a "pointer to function" in Fortran?

Starting from so-called "Fortran 2003" (ISO/IEC 1539-2004) procedure pointers is a part of the Fortran language. It's definitely of the major new features of Fortran language.

Usage example from Fortran Wiki.


Stefano, you mentioned strategy design pattern. In Fortran 2003 you can use pure OOP way to implement it (without procedure pointers). Offhand example:

strategies.f90

module strategies

  implicit none

  private

  public :: strategies_transportation_strategy, &
            strategies_by_taxi_strategy, &
            strategies_by_bus_strategy

  type, abstract :: strategies_transportation_strategy
  contains
    procedure(transportation_strategy_go), deferred :: go
  end type strategies_transportation_strategy

  type, extends(strategies_transportation_strategy) :: strategies_by_taxi_strategy
  contains
    procedure :: go => strategies_by_taxi_strategy_go
  end type strategies_by_taxi_strategy

  type, extends(strategies_transportation_strategy) :: strategies_by_bus_strategy
  contains
    procedure :: go => strategies_by_bus_strategy_go
  end type strategies_by_bus_strategy

  abstract interface
    subroutine transportation_strategy_go(this)
      import strategies_transportation_strategy
      class(strategies_transportation_strategy), intent(in) :: this
    end subroutine transportation_strategy_go
  end interface

  contains

    subroutine strategies_by_taxi_strategy_go(this)
      class(strategies_by_taxi_strategy), intent(in) :: this

      print *, "We are using taxi."

    end subroutine strategies_by_taxi_strategy_go

    subroutine strategies_by_bus_strategy_go(this)
      class(strategies_by_bus_strategy), intent(in) :: this

      print *, "We are using public transport."

    end subroutine strategies_by_bus_strategy_go

end module strategies

vehicles.f90

module vehicles

  use strategies

  implicit none

  private

  public :: vehicles_vehicle, &
            vehicles_taxi, &
            vehicles_bus

  type, abstract :: vehicles_vehicle
    private
    class(strategies_transportation_strategy), allocatable :: transportation_strategy
  contains
    procedure :: set_transportation_strategy => vehicle_set_transportation_strategy
    procedure :: go => vehicle_go
  end type vehicles_vehicle

  type, extends(vehicles_vehicle) :: vehicles_taxi
  contains
    procedure :: init => taxi_init
  end type vehicles_taxi

  type, extends(vehicles_vehicle) :: vehicles_bus
  contains
    procedure :: init => bus_init
  end type vehicles_bus

  contains

    subroutine vehicle_go(this)
      class(vehicles_vehicle), intent(in) :: this

      call this%transportation_strategy%go()

    end subroutine vehicle_go

    subroutine vehicle_set_transportation_strategy(this, new_transportation_strategy)
      class(vehicles_vehicle), intent(inout) :: this
      class(strategies_transportation_strategy), intent(in) :: new_transportation_strategy

      if (allocated(this%transportation_strategy)) then
        deallocate (this%transportation_strategy)
      end if

      allocate (this%transportation_strategy, source=new_transportation_strategy)

    end subroutine vehicle_set_transportation_strategy

    subroutine taxi_init(this)
      class(vehicles_taxi), intent(out) :: this

      type(strategies_by_taxi_strategy) :: by_taxi_strategy

      call this%set_transportation_strategy(by_taxi_strategy)

    end subroutine taxi_init

    subroutine bus_init(this)
      class(vehicles_bus), intent(out) :: this

      type(strategies_by_bus_strategy) :: by_bus_strategy

      call this%set_transportation_strategy(by_bus_strategy)

    end subroutine bus_init

end module vehicles

main.f90

program main

  use vehicles

  implicit none

  type(vehicles_taxi) :: taxi
  type(vehicles_bus) :: bus

  call taxi%init()
  call bus%init()

  call taxi%go()
  call bus%go()

end program main

At least works using gfortran 4.6 (20100925).


The following codes demonstrate how to use procedure pointers:

module my_mod
  implicit none
contains
  subroutine sub1()
    write(*,*) 'the first suboutine is being used'
  end subroutine sub1

  subroutine sub2()
    write(*,*) 'the second subroutine is being used'
  end subroutine sub2

end module my_mod

program procTest
  use my_mod
  implicit none                                             
  integer :: n
  procedure(sub1), pointer:: funPointer => NULL()
  write(*,'(A)') "Please enter your option"
  read(*,*) n                                                                  
  select case( n )
  case( 1 )
     funPointer => sub1
  case( 2 )
     funPointer => sub2
  case DEFAULT
     funPointer => sub1
  end select
  call funPointer()
end program procTest