Блог

У меня есть функция (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.

Я немного поиграл со своим исходным кодом перед моим вопросом, чтобы посмотреть, смогу ли я получить его сам, и я думаю, что понял это. Я придумал два способа сделать то, что мне было нужно, первый с использованием функции с внутренней функцией, а второй с подпрограммой, также с внутренней функцией.

Оба они основаны на том факте, что внутренняя функция имеет доступ к «родительским» переменным функции / подпрограммы

Мне все еще интересно, возможно ли это сделать с помощью внешней функции, или единственный способ — использовать внутренние функции.

Если у кого-то есть какие-то данные, я хотел бы услышать об этом.

РЕДАКТИРОВАТЬ: по-видимому, вы также можете вызывать внешние функции из внутренней функции, тем самым просто создавая оболочку вокруг уже известной функции.

 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