Modern Fortran - ProkopHapala/FireCore GitHub Wiki

Pass function as argument to other function

Module with generic function acepting another function as argument

module functional_mod2
  implicit none
  private
  public :: apply_function
contains
  function apply_function(f_ptr, x) result(y)
    real(8), intent(in) :: x
    real(8) :: y
    procedure(real(8) :: f_ptr) :: f_ptr       ! Procedure pointer as an argument
    y = f_ptr(x)  ! Call the function pointer
  end function apply_function
end module functional_mod2

Program using that generic function

program test_functional_pointer
  use functional_mod2
  implicit none
  real(8) :: x, result
  procedure(real(8) :: func_ptr), pointer :: f_ptr  ! Declare procedure pointer
  x = 2.0
  f_ptr => sine_function                  ! Point to a specific function (in this case sine_function)
  result = apply_function(f_ptr, x)       ! Apply the function using the procedure pointer
  print *, "Result from procedure pointer function: ", result
contains
  function sine_function(x) result(y)
    real(8), intent(in) :: x
    real(8) :: y
    y = sin(x)
  end function sine_function
end program test_functional_pointer

Named abstract Interface for a function in a module

Define named interface in module mod_interfaces.f90

module interface_mod
  implicit none
  abstract interface
    function func_real_real(x) result(y)
      real(8), intent(in) :: x   ! Input
      real(8) :: y               ! Output
    end function func_real_real
  end interface
end module interface_mod

use the interface in module mod_functional.f90

module functional_mod
  use interface_mod        ! Reuse the named interface
  implicit none
  public :: apply_function
contains
  function apply_function(f_ptr, x) result(y)
    real(8), intent(in) :: x
    real(8) :: y
    procedure(func_real_real) :: f_ptr        ! Use the named interface for the procedure pointer
    y = f_ptr(x)  ! Call the passed function
  end function apply_function
end module functional_mod

use both modules interface_mod and functional_mod in a program test_program.f90

program test_functional_pointer
  use functional_mod
  implicit none
  real(8) :: x, result
  procedure(func_real_real), pointer :: f_ptr     ! Use the named interface
  x = 2.0
  f_ptr => sine_function   ! Point to a specific function (in this case sine_function)
  result = apply_function(f_ptr, x)   ! Apply the function using the procedure pointer
  print *, "Result from procedure pointer function: ", result
contains
  function sine_function(x) result(y)
    real(8), intent(in) :: x
    real(8) :: y
    y = sin(x)
  end function sine_function
end program test_functional_pointer

compile like this

rm test_program mod_interfaces.o mod_functional.o
gfortran -c mod_interfaces.f90
gfortran -c mod_functional.f90
gfortran -o test_program mod_interfaces.o mod_functional.o test_program.f90
./test_program

Derived Class

Module which defines the base class and derived class

module shape_mod
  implicit none
  type, abstract :: Shape                   ! Define the abstract base class (type)
  contains
    procedure :: area => area_base          ! A deferred procedure for calculating area
  end type Shape
contains
  pure real(8) function area_base(this)     ! Base class area procedure (abstract, must be overridden)
    class(Shape), intent(in) :: this
    print *, "This is the base class method; should be overridden!"
    area_base = 0.0
  end function area_base
end module shape_mod

module circle_mod
  use shape_mod  ! Import the base class module
  implicit none
  type, extends(Shape) :: Circle             ! Define the derived class 'Circle' extending from Shape
    real(8) :: radius  ! Attribute specific to Circle
  contains
    procedure :: area => area_circle         ! Override the area procedure for Circle
  end type Circle
contains
  pure real(8) function area_circle(this)   ! Circle's overridden area function
    class(Circle), intent(in) :: this
    area_circle = 3.14159 * this%radius**2
  end function area_circle
end module circle_mod

program test_shapes
  use shape_mod                    ! Use the base class module
  use circle_mod                   ! Use the derived class module
  implicit none
  type(Circle) :: my_circle
  my_circle%radius = 2.0           ! Initialize the Circle object
  call compute_area(my_circle)     ! Call the polymorphic subroutine
contains
  subroutine compute_area(obj)           ! Subroutine to compute and print area (polymorphic argument)
    class(Shape), intent(in) :: obj      ! Accept any derived type of Shape
    real(8) :: result
    result = obj%area()                  ! Polymorphic dispatch: will call the correct `area` method
    print *, "The area is: ", result
  end subroutine compute_area
end program test_shapes