fortran语言中的过程指针

假设我有一个单参数双精度函数的抽象接口

module abstract

  abstract interface
     function dp_func (x)
       double precision, intent(in) :: x
       double precision :: dp_func
     end function dp_func
  end interface

end module abstract

在另一个模块中，我定义了两个函数，一个是

dp_func

类型的简单函数

g

，另一个是更复杂的函数

f

module fns

 contains
 double precision function f(a,b,x)
   double precision, intent(in)::a,b,x
   f=(a-b)*x 
 end function f

 double precision function g(x)
   double precision, intent(in)::x
   g=x**2 
 end function g
end module fns

现在可以按如下方式创建指向

g

的指针

program main
use abstract,fns
procedure(dp_func), pointer :: p
double precision::x=1.0D0, myA=1.D2, myB=1.D1, y
p => g
y=p(x)
end program main

但是，如何创建指向

f（myA，myB，x）

的指针，即在

a

和

b

的固定值下指向

f

，这可以被视为只有一个参数的函数，即

dp_func

类型的函数？ 最终，我希望能够写出类似这样的东西

p=>f(myA, myB, )
y=p(x)

下面的评论表明，这不是fortran标准的一部分，而包装函数可能是解决这一问题的一种方案。但是，包装器必须初始化，这会导致最终用户可能忘记调用初始值设定项。如何以干净透明的方式做到这一点

编辑 在发布了这个问题并在谷歌上搜索了“closure和fortran”之后，我发现了这个例子

---

我以图片的形式呈现，以强调突出显示。这是在一个在线课程中介绍的。但我怀疑这种隐式参数设置是一种好的编程实践。事实上，在本例中，像

z

这样的悬空变量是错误的完美来源

您可以使用内部函数包装您的函数，例如

program main
  use abstract
  use fns
  implicit none
  
  procedure(dp_func), pointer :: p
  double precision :: x, myA, myB, y
  
  x = 1.0D0
  myA = 1.D2
  myB = 1.D1
  
  p => g
  y=p(x)
  
  p => f2
  y = p(x) ! Calls f(1.D2, 1.D1, x)
  
  myA = 1.D3
  myB = 1.D2
  
  y = p(x) ! Calls f(1.D3, 1.D2, x)
contains
  double precision function f2(x)
    double precision, intent(in) :: x
    write(*,*) myA, myB
    f2 = f(myA,myB,x)
  end function
end program main

给定范围内的内部函数可以使用该范围内的变量，因此它们可以像闭包一样工作

在内部函数

f2

中隐式使用

myA

和

myB

很可能是编程错误的根源，但是，如果

f2

的范围仍然在范围内，则此行为与其他语言中的

lambda

函数相同，例如等效的python lambda：

f2=lambda x:f（myA，myB，x）

正如@vladimirF所指出的，一旦

f2

的范围超出范围（例如，如果存储了指向

f2

的指针，并且声明了

f2

的过程返回），则指向

f2

的任何指针都将无效。这可以在以下代码中看到：

module bad
  use abstract
  use fns
  implicit none
contains

function bad_pointer() result(output)
  procedure(dp_func), pointer :: output
  
  double precision :: myA,myB
  
  myA = 1.D2
  myB = 1.D1
  
  output => f2
contains
  double precision function f2(x)
    double precision, intent(in) :: x
    write(*,*) myA, myB
    f2 = f(myA,myB,x)
  end function
end function

end module

program main
  use abstract
  use fns
  use bad
  implicit none
  
  procedure(dp_func), pointer :: p
  double precision :: y,x
  
  p => bad_pointer()
  x = 1.D0
  y = p(x)
end program

注意：对于这种简单的情况，上述代码可能运行良好，但它依赖于未定义的行为，因此不应使用。

您声明了以下内容： “…然而，包装器必须初始化，这可能会导致最终用户忘记调用初始值设定项。如何以干净透明的方式完成此操作？”

以下可能是一个解决方案。 它仍然需要初始化，但如果用户没有这样做，它将抛出错误

我定义了一个类型

closure

，它处理函数指针

! file closure.f90
module closure_m
  implicit none

  type closure
    private
    procedure(f1), pointer, nopass :: f1ptr => null()
    procedure(f3), pointer, nopass :: f3ptr => null()
    real :: a, b
  contains
    generic   :: init => closure_init_f1, closure_init_f3
      !! this way by calling obj%init one can call either of the two closure_init_fX procedures
    procedure :: exec => closure_exec
    procedure :: closure_init_f1, closure_init_f3
  end type

  abstract interface
    real function f1(x)
      real, intent(in) :: x
    end function

    real function f3(a, b, x)
      real, intent(in) :: a, b, x
    end function
  end interface

contains

  subroutine closure_init_f1(this, f)
    class(closure), intent(out) :: this
    procedure(f1)               :: f

    this%f1ptr => f
    this%f3ptr => null()
  end subroutine

  subroutine closure_init_f3(this, f, a, b)
    class(closure), intent(out) :: this
    procedure(f3)               :: f
    real,           intent(in)  :: a, b

    this%f1ptr => null()
    this%f3ptr => f
    this%a     =  a
    this%b     =  b
  end subroutine

  real function closure_exec(this, x) result(y)
    class(closure), intent(in) :: this
    real,           intent(in) :: x

    if      (associated(this%f1ptr)) then
      y = this%f1ptr(x)
    else if (associated(this%f3ptr)) then
      y = this%f3ptr(this%a, this%b, x)
    else
      error stop "Initialize the object (call init) before computing values (call exec)!"
    end if
  end function

end module

关于行

类（闭包），意图（out）：：此

： 这是为Fortran类型编写初始值设定项的标准方法。 注意，它是

class

而不是

type

，这使得

这个

多态性成为类型绑定过程所需要的

我稍微调整了您的功能模块（更改了数据类型）

示例程序

! file a.f90
program main
  use closure_m
  use fns_m

  implicit none

  type(closure) :: c1, c2

  call c1%init(g)
  print *, c1%exec(2.0)

  call c1%init(f, 1.0, 2.0)
  print *, c1%exec(2.0)

  call c2%init(f, 1.0, -2.0)
  print *, c2%exec(3.0)
end program

示例输出

$gfortran closure.f90 fns.f90 a.f90&&./a.out
4
-2.00000000    
9

Fortran没有闭包，但如果您能举例说明如何使用此

f

，那么我们可以给出适当方法的具体示例。@francescalus感谢您的快速反馈。在我不想修改的完全不同的模块中，有一个子例程只接受

dp_func

指针作为参数。我想提供这样一个指针，但同时要灵活选择

a

和

b

，也就是说，

a

和

b

在编译时是未知的。你可以用过程指针扩展（和类似）的思想。@francescalus是的，这是我通常使用的解决方案。我认为在新的fortran标准中增加了一些新特性，可以实现闭包。我不喜欢这样的想法：1）编写包装器，2）为包装器编写初始值设定项，3）用户在调用包装器之前忘记初始化。所以本质上我的问题是如何向最终用户指示必须调用初始值设定项。Fortran没有闭包。时期可以创建函子对象。这种方法与问题本身中突出显示（并被拒绝）的方法有何不同？@francescalus我在对问题进行编辑之前就开始写这个答案。关于真正的闭包，最重要的一点是它是一个可以存储、传递等的第一类对象。如果将指针传递给父作用域不再存在的内部函数，则上下文将无效，它不会存储在指针中，不像真正的闭包。@VladimirF啊，谢谢，我不知道这一点。我应该在我自己的代码中检查这一点。你能提供一个

f2

不在范围内的小例子吗？谢谢你，杰克。我注意到了你的答案，我喜欢你的方法。但我会等待一点接受，因为我很想知道是否有更多的人提出了不同的解决方案。至于您的解决方案，您能否简要解释一下类（closure）、意图（out）的含义：this和

generic:：init=>closure\u init\u f1、closure\u init\u f3

。还有一点，在主程序中定义

类型（闭包）：：c

，可以定义，比如说，

c1

和

c2

，它们包含相同的函数，但存储不同的上下文变量吗？@yarchik我编辑了答案，并试图包含您评论中的问题。如果仍然无法解释，请随时再次发表评论。

! file a.f90
program main
  use closure_m
  use fns_m

  implicit none

  type(closure) :: c1, c2

  call c1%init(g)
  print *, c1%exec(2.0)

  call c1%init(f, 1.0, 2.0)
  print *, c1%exec(2.0)

  call c2%init(f, 1.0, -2.0)
  print *, c2%exec(3.0)
end program