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!

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.