Fortran 中的程序指针

Question

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

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,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，这可以看作是一个函数只有 1 个参数，即 dp_func 类型？最后我希望能够写出类似

的东西

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

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

编辑在发布这个问题并使用“closure and fortran”进行谷歌搜索后，我找到了这个例子

我以图片形式呈现，以强调突出显示。这是在在线课程中介绍的。但我怀疑这种隐式参数设置是一种好的编程习惯。事实上，这个例子中像 z 这样的悬垂变量是完美的错误来源！

Answer 1

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

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 的过程 returns) 任何指向 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

N.B。上面的代码可能运行适用于这个简单的案例，但它依赖于未定义的行为，因此不应使用。

Answer 2

您陈述了以下内容： “...但是，必须初始化包装器，这会带来一些最终用户可能会忘记调用初始化器的机会。如何以干净透明的方式做到这一点？.. ."

以下可能是一个解决方案。它仍然需要初始化，但如果用户尚未初始化，则会抛出错误。

我定义了一个处理函数指针的类型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

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

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

! file fns.f90
module fns_m
contains
  real function f(a, b, x)
    real, intent(in) :: a, b, 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, 1.0, -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 中的程序指针

Procedural pointer in fortran

fortran

function-pointers