Fortran closures

While trying to implement the Lancsoz method (to find the spectral range of a linear operation), I had to pass a procedure with some arguments bound to it (to keep things general).

However, I read that Fortran has no closures, nor have I encountered something like Python's functools.partial (or javascript's .bind), nor **kwargs. So I got stuck for a little while, but some kind people at Stack Overflow came to the rescue as usual. It seems that something like a closure is possible in Fortran 2008 after all! (the earlier source refers to an older version).

So do you want to use Fortran closures, or bind argument to a function/subroutine, or access data from a parent scope? This is how to do closures in Fortran. It is not the same as argument binding, but can act as a replacement (js's bind or python's partial bind the values at bind time, whereas this just makes a reference to variables in the parent's scope available to a nested subroutine).

Like everything that is not mathematics, it takes a bit of code to do in Fortran, so I thought I'd share a demo. Some info is in the !!comments!

System Message: WARNING/2 (<string>, line 9)

Cannot analyze code. Pygments package not found.

.. code-block:: fortran

      module external_mod
          !! This is the external code that can't be changed
          !! and the routine that you actually want to iterate with.
          integer, parameter:: dp=kind(0.d0)
          subroutine external_sr(x, a, b)
              real(dp), intent( in) ::  x
              integer, intent(in) :: a
              integer, intent(out) :: b
              b = nint(a - x)
          end subroutine external_sr
      end module external_mod

      module smallify_mod
          integer, parameter:: dp=kind(0.d0)
              !! The interface that subroutines should satisfy to be smallified.
              !! Note that `external_sr` does not but `external_sr_wrapper` does.
              subroutine mat_apply_iface(matdim, invec, outvec)
                  integer, intent(in) :: matdim
                  REAL(kind=8), dimension(matdim), intent( in) ::  invec
                  REAL(kind=8), dimension(matdim), intent(out) :: outvec
              end subroutine mat_apply_iface
          end interface
          subroutine smallify(target_sr, min_out)
              procedure(mat_apply_iface) :: target_sr
              real(dp), intent(out) :: min_out
              integer, parameter :: matdim = 3
              real(dp), dimension(matdim) :: invec, outvec
              integer :: k
              min_out = -1
              do k = 0, 100
                  invec(:) = k
                  call target_sr(matdim, invec, outvec)
                  if (sum(outvec) .lt. 0.0d0) then
                      min_out = k
          end subroutine smallify
      end module smallify_mod

      module any_mod
          !! This is just any module, no special function.
          use smallify_mod, only: smallify
          use external_mod, only: dp, external_sr
          subroutine any_subroutine()
              !! This could be any subroutine that has access to
              !! all the variables that `external_sr` needs.
              implicit none
              real(dp) :: minimum
              integer :: ext_param, ext_out
              !! ... other code here ...
              ext_param = 4
              call smallify(external_sr_wrapper, minimum)
              !! ext_out will also be set at this point
              write(*, '(1x,a,es24.16e3)') 'found minimum at ', minimum
              !! ... other code here ...
              subroutine external_sr_wrapper(matdim, invec, outvec)
                  !! Wrapper function that calls the potential (satisfies mat_apply_iface).
                  !! (It just does some random extra operations as examples of type coercion).
                  integer, intent(in) :: matdim
                  real(dp), dimension(matdim), intent( in) ::  invec
                  real(dp), dimension(matdim), intent(out) :: outvec
                  outvec = invec
                  call external_sr(invec(1), a=ext_param, b=ext_out)
                  outvec(1) = matdim * ext_out
              end subroutine external_sr_wrapper
          end subroutine any_subroutine
      end module any_mod

      program demo
          use any_mod, only: any_subroutine
          call any_subroutine()
      end program demo


No comments yet

You need to be logged in to comment.