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

在不同的模块中，我定义了两个函数，一个简单的 g 类型的 dp_func 和一个更复杂的 f

module fns

 contains
 double precision function f(a,b,x)
   double precision,intent(in)::a,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)和f的固定值处创建一个指向a的指针，即指向b，这可以看作是一个函数1 个参数，即 dp_func 类型？最后，我希望能够写出类似

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

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

编辑在发布这个问题并使用“closure and 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,x)
  end function
end program main

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

在内部函数 myA 中隐式使用 myB 和 f2 很可能是编程错误的来源，但是，前提是 f2 的作用域仍在范围，此行为与其他语言中的 lambda 函数相同，例如等效的 python lambda：

f2 = lambda x: f(myA,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,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),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,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

关于 class(closure),intent(out) :: this 行：这是为 Fortran 类型编写初始值设定项的标准方法。请注意，它是 class 而不是 type，这使得 this 具有类型绑定过程所需的多态性。

我稍微调整了你的函数模块（改变了数据类型）

! file fns.f90
module fns_m
contains
  real function f(a,x)
    real,x
    f = (a-b)*x
  end function

 real function g(x)
    real,intent(in) :: x
    g = x**2
 end function
end module

示例程序

! 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,-2.0)
  print *,c2%exec(3.0)
end program

示例输出

$ gfortran closure.f90 fns.f90 a.f90 && ./a.out
   4.00000000    
  -2.00000000    
   9.00000000

fortran function-pointers