Fortran - Return an anonymous function from subroutine

Question

I am trying to generalize a function call from a subroutine. So my idea is something like this

if (case1) then
   call MainSubroutine1(myFun)
elseif (case2)
   call MainSubroutine2(myFun)
end if

do i = 1,4
   data = myFun(i)
end do

I realize this is kind of vague but I am not sure if this is possible.

Thank you,

John

---

edit 1/31/14 7:57 AM

---

I am sorry for the vague way I phrased this. I was thinking something similar to what @haraldki did but I was hoping that I could define an anonymous function within MainSubroutine1 and MainSubroutine2 and transfer that definition out to the main code.

This is because myFun depends on different stretched distribution (Gaussian and Fermi-Dirac) and I don't want to have a function that only calls a function with a constant thrown it.

Is this possible?

Thank you again.

John

Answer 1

The answer to you question simply is: no, you can't return an anonymous function. This is because, as @VladimirF says in the comments, there are no anonymous functions in Fortran. As the comments say, though, procedure pointers are quite passable.

Massive speculation follows which is hopefully useful as a way of avoiding the anonymous function requirement.

I infer that you would like to do something like

subroutine MainSubroutine1(fptr)
  procedure(func), pointer, intent(out) :: fptr
  ! Calculate parameterization for your "anonymous" function
  fptr => anon_parameterized

 contains
   real function anon_parameterized(i)
     integer, intent(in) :: i
     ! Use the parameterization
     anon_parameterized = ...
   end function
end subroutine

and you don't want to do

subroutine MainSubroutine1(fptr)
  procedure(func), pointer, intent(out) :: fptr
  fptr => Gaussian
end subroutine

real function Gaussian(i)
  integer, intent(in) :: i
  ! Calculate parameterization
  Gaussian = Gaussian_parameterized(i, ...)

 contains
   function Gaussian_parameterized(i, ...)
     integer, intent(in) :: i
     !... other intent(in) parameters
   end function
end subroutine

Note that these aren't internal, as passing pointers to things internal elsewhere is not well implemented (as an F2008 feature) yet, and is tricky. Passing a pointer to an internal procedure to get host association scares me.

If my inference is correct, then there is the possibility of using module variables to store the parameterization, again allowing the final "parameterized" call to be not internal to MainSubroutine1.

However, you may want to avoid module variables in which case you may consider passing passing the parameterization along with the function call:

procedure(func), pointer :: myFun => null()

if (case1) then
  call MainSubroutine1(myFun)
else if (case2)
  call MainSubroutine2(myFun)
end if
if (.not.associated(myFun)) STOP ":("

data = myFun(1, par1, par2)

Ah, but you don't know for certain what parameters the non-parameterized function myFun requires, so your interface is all broken. Isn't it?

Which then leads to polymorphism.

module dists

  type, abstract :: par_type
  end type par_type

  type, extends(par_type) :: par_gaussian
     real :: mu=5.2, sigma=1.2
  end type par_gaussian

  type, extends(par_type) :: par_fermi_dirac
     real :: eps=11.1, mu=4.5
  end type par_fermi_dirac

  abstract interface
     real function func(i, pars)
       import par_type
       integer, intent(in) :: i
       class(par_type), intent(in) :: pars
     end function func
  end interface

contains

  real function gaussian(i, pars)
    integer, intent(in) :: i
    class(par_type), intent(in) :: pars

    select type (pars)
    class is (par_gaussian)
       print*, "Gaussian", pars%mu, pars%sigma
       gaussian = pars%mu+pars%sigma
    end select
  end function gaussian

  real function fermi_dirac(i, pars)
    integer, intent(in) :: i
    class(par_type), intent(in) :: pars

    select type (pars)
    class is (par_fermi_dirac)
       print*, "Fermi-Dirac", pars%eps, pars%mu
       fermi_dirac = pars%eps+pars%mu
    end select
  end function fermi_dirac

  subroutine sub1(fptr, pars)
    procedure(func), pointer, intent(out) :: fptr
    class(par_type), intent(out), allocatable :: pars

    fptr => gaussian
    allocate(par_gaussian :: pars)

  end subroutine sub1

  subroutine sub2(fptr, pars)
    procedure(func), pointer, intent(out) :: fptr
    class(par_type), intent(out), allocatable :: pars

    fptr => fermi_dirac
    allocate(par_fermi_dirac :: pars)

  end subroutine sub2

end module dists

program prog

  use dists
  implicit none

  class(par_type), allocatable :: pars
  procedure(func), pointer :: myfun

  call sub1(myfun, pars)
  print*, myfun(i, pars)

  call sub2(myfun, pars)
  print*, myfun(i, pars)

end program prog

That's all speculation, though.