Advanced Procedure Features

Recursive functions must use a result variable.

14.1 Optional & keyword arguments

subroutine greet(name, greeting, times)
  character(len=*), intent(in) :: name
  character(len=*), intent(in), optional :: greeting
  integer, intent(in), optional :: times
  character(len=:), allocatable :: g
  integer :: n, i
  g = "Hello"; if (present(greeting)) g = greeting
  n = 1;       if (present(times)) n = times
  do i = 1, n
    print *, g, ", ", name, "!"
  end do
end subroutine greet

call greet("Ann")
call greet("Ann", times=3)                 ! keyword argument skips 'greeting'
call greet(greeting="Hi", name="Bob")      ! any order with keywords

14.2 Recursive procedures

Recursive functions must use a result variable.

recursive function factorial(n) result(f)      ! 'recursive' optional by default in F2018
  integer, intent(in) :: n
  integer :: f
  if (n <= 1) then
    f = 1
  else
    f = n * factorial(n - 1)
  end if
end function factorial

14.3 Pure & elemental procedures

impure elemental allows side effects (e.g., printing) while still being elemental.

pure function square(x) result(y)          ! no side effects: required in do concurrent, forall, specification exprs
  real, intent(in) :: x
  real :: y
  y = x * x
end function square

elemental function clamp(x, lo, hi) result(y)   ! works on scalars and arrays of any shape
  real, intent(in) :: x, lo, hi
  real :: y
  y = max(lo, min(hi, x))
end function clamp

print *, clamp([-1.0, 0.5, 2.0], 0.0, 1.0)    ! [0.0, 0.5, 1.0]

14.4 Procedure arguments (callbacks)

Procedure pointers: procedure(func), pointer :: fp => null(); fp => g; print *, fp(1.0_dp).

module integrate_mod
  implicit none
  integer, parameter :: dp = kind(1.0d0)
  abstract interface
    pure function func(x) result(y)
      import :: dp
      real(dp), intent(in) :: x
      real(dp) :: y
    end function func
  end interface
contains
  function trapezoid(f, a, b, n) result(s)
    procedure(func) :: f
    real(dp), intent(in) :: a, b
    integer, intent(in) :: n
    real(dp) :: s, h
    integer :: i
    h = (b - a) / n
    s = 0.5_dp * (f(a) + f(b))
    do i = 1, n - 1
      s = s + f(a + i * h)
    end do
    s = s * h
  end function trapezoid

  pure function g(x) result(y)
    real(dp), intent(in) :: x
    real(dp) :: y
    y = exp(-x**2)
  end function g
end module integrate_mod

! print *, trapezoid(g, 0.0_dp, 1.0_dp, 1000)

14.5 Internal procedures & host association

subroutine solve(n)
  integer, intent(in) :: n
  real :: work(n)
  call fill()
contains
  subroutine fill()
    work = 1.0                 ! accesses the host's variable 'work'
  end subroutine fill
end subroutine solve

14.6 SAVE and local variable lifetime

Variables initialized in their declaration are implicitly saved.

subroutine counter()
  integer, save :: calls = 0          ! persists between calls
  calls = calls + 1
  print *, "called", calls, "times"
end subroutine counter

14.7 Result arrays & allocatable function results

function linspace(a, b, n) result(x)
  real, intent(in) :: a, b
  integer, intent(in) :: n
  real, allocatable :: x(:)
  integer :: i
  allocate(x(n))
  x = [(a + (b - a) * (i - 1) / real(n - 1), i = 1, n)]
end function linspace