Fortran - 从子程序返回一个匿名函数

Question

我试图概括子程序中的函数调用。所以我的想法是这样的

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

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

我意识到这有点模糊，但我不确定这是否可能。

谢谢，

约翰

---

编辑 2014 年 1 月 31 日上午 7:57

---

我很抱歉我措辞含糊。我正在考虑类似于@haraldki 所做的事情，但我希望我可以在 MainSubroutine1 和 MainSubroutine2 中定义一个匿名函数并将该定义转移到主代码中。

这是因为 myFun 依赖于不同的拉伸分布（高斯和费米-狄拉克），我不希望有一个函数只调用一个抛出常量的函数。

这可能吗？

再次感谢您。

约翰

Answer 1

您的问题的答案很简单：不，您不能返回匿名函数。这是因为，正如@VladimirF 在 cmets 中所说，Fortran 中没有匿名函数。不过，正如 cmets 所说，过程指针是可以通过的。

接下来的大量猜测有望作为避免匿名函数要求的一种有用方式。

我推断你想做类似的事情

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

你不想这样做

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

请注意，这些不是内部的，因为将指针传递给其他地方的内部事物还没有很好地实现（作为 F2008 功能），而且很棘手。传递指向内部过程的指针以获取主机关联让我感到害怕。

如果我的推断是正确的，那么就有可能使用模块变量来存储参数化，再次允许最终的“参数化”调用不在MainSubroutine1 内部。

但是，您可能希望避免使用模块变量，在这种情况下，您可以考虑将参数化与函数调用一起传递：

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)

啊，但是你不确定非参数化函数myFun需要什么参数，所以你的界面都坏了。不是吗？

这会导致多态性。

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

不过，这都是猜测。