如何解决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
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。