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)
contains
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)
interface
!! 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
contains
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
exit
endif
enddo
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
contains
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 ...
contains
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

## Comments

No comments yet

You need to be logged in to comment.