使用指针来参数化函数

Posted 2021-04-16

我有一个函数（y = f（x，a）= x ^ a），它有两个输入参数。我想将f（x，a）减少到f（x），使f内置于其中。

目前，我可以使用下面提供的模块和程序示例创建指向函数的指针。我想要做的是以某种方式使用参数初始化指针，以便不使用2个参数调用函数，而是只使用一个。

我需要参数化函数调用，以便以后在其他例程中使用（例如集成，区分等）

这是否可以使用抽象接口，函数，子例程和指针的某种组合？

module example
  implicit none

  abstract interface
    pure function fun1(x) result(y)
      real, intent(in):: x
      real:: y
    end function fun1

    pure function fun2(x, a) result(y)
      real, intent(in):: x, a
      real:: y
    end function fun2
  end interface

contains

  pure function myfun(xx, aa) result(yy)
    real, intent(in):: xx, aa
    real:: yy
    yy = xx**aa
    return
  end function myfun

end module example


program test_ptr
  use example, only: fun1, fun2, myfun
  implicit none

  real:: x, a, y
  procedure(fun2), pointer :: ptr => null()

  x = 2.0
  a = 1.5

  ptr => myfun
  y = ptr(x, a)

  write(*,*) x, '^', a, ' = ', y

end program test_ptr

答案

编辑：我以为我搞清楚了，但是在第一次调用函数后指针被销毁了。多次调用指针会导致Seg Fault。

在我的问题之前，我正在玩我的来源，看看我是否能够自己得到它，我想我已经弄明白了。我想出了两种方法来做我需要的东西，第一种是使用带内部函数的函数，第二种是使用子程序，也有内部函数。

它们都依赖于内部函数可以访问“父”函数/子例程的变量这一事实

我仍然想知道是否可以使用外部函数执行此操作，或者唯一的方法是使用内部函数。

如果有人有一些意见，我很乐意听到。

编辑：显然你也可以从内部函数调用外部函数，从而只是创建一个已知函数的包装器。

module example
  implicit none

  abstract interface
    pure function fun1(x) result(y)
      real, intent(in):: x
      real:: y
    end function fun1

    pure function fun2(x, a) result(y)
      real, intent(in):: x, a
      real:: y
    end function fun2
  end interface

contains

  pure function myfun(xx, aa) result(yy)
    real, intent(in):: xx, aa
    real:: yy
    yy = xx**aa
    return
  end function myfun

  pure function set_ptr(aa) result(ptr)
    real, intent(in):: aa
    procedure(fun1), pointer :: ptr
    ptr => localfun
    return
  contains
    pure function localfun(xx) result(yy)
      real, intent(in):: xx
      real:: yy
      yy = xx**aa
    end function localfun
  end function set_ptr

  pure subroutine mysub(aa, ptr)
    real, intent(in):: aa
    procedure(fun1), intent(out), pointer :: ptr
    ptr => localfun
    return
  contains
    pure function localfun(xx) result(yy)
      real, intent(in):: xx
      real:: yy
      yy = xx**aa
    end function localfun
  end subroutine mysub

  pure function set_ptr2(aa) result(ptr)
    real, intent(in):: aa
    procedure(fun1), pointer :: ptr
    ptr => myfun_wrapper
    return
  contains
    pure function myfun_wrapper(xx) result(yy)
      real, intent(in):: xx
      real:: yy
      yy = myfun(xx, aa)
    end function myfun_wrapper
  end function set_ptr2

end module example



program test_ptr
  use example, only: fun1, fun2, myfun, mysub, set_ptr, set_ptr2
  implicit none

  real:: x, a, y
  procedure(fun2), pointer :: ptr1 => null()
  procedure(fun1), pointer :: ptr2 => null()
  procedure(fun1), pointer :: ptr3 => null()
  procedure(fun1), pointer :: ptr4 => null()

  x = 2.0
  a = 1.5

  ptr1 => myfun
  y = ptr1(x, a)
  write(*,*) x, '^', a, ' = ', y

  ptr2 = set_ptr(a)
  y = ptr2(x)
  write(*,*) x, '^', a, ' = ', y

  call mysub(a, ptr3)
  y = ptr3(x)
  write(*,*) x, '^', a, ' = ', y

  ptr4 = set_ptr2(a)
  y = ptr4(x)
  write(*,*) x, '^', a, ' = ', y

*** The next line will result in an error ***
  y = ptr4(x)
  write(*,*) x, '^', a, ' = ', y

end program test_ptr