Fortran – 从子例程返回一个匿名函数

2023年2月24日 348次阅读

我试图从子程序推广函数调用.所以我的想法是这样的

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

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

我意识到这有点模糊,但我不确定这是否可行.

谢谢,

约翰

编辑1/31/14 7:57 AM

对于我措辞的模糊方式,我感到很遗憾.我正在想类似于@haraldki所做的事情,但我希望我可以在MainSubroutine1和MainSubroutine2中定义一个匿名函数,并将该定义传递给主代码.

这是因为myFun依赖于不同的拉伸分布(Gaussian和Fermi-Dirac),我不希望有一个只调用一个常量抛出函数的函数.

这可能吗？

再次感谢你.

约翰

最佳答案 你问的答案很简单：不,你不能返回一个匿名函数.这是因为正如@VladimirF在评论中所说,Fortran中没有匿名函数.正如评论所说的那样,程序指针是完全可以接受的.

随后进行了大规模推测,这有望成为避免匿名功能要求的一种方式.

我推断你想做点什么

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

不过,这都是猜测.

点赞