Процедура связана с типом в качестве аргументов

Question

Я хочу пройти процедуры, связанные с типом (как внешняя функция) в другую функцию следующим образом:

module mod1
   implicit none

   type type1
      real :: a
      contains
      procedure,pass :: f
   end type

contains

   real function f(y,e)
      class(type1), intent(in) :: y
      real,intent(in) :: e
      f=y%a+e
   end function

end module

program test

   use mod1
   type(type1) :: t

   t%a=3e0
   write(*,*) s(t%f)

contains

   real function s(g)
      real,external :: g
      s=g(5e0)+2e0
   end function

end program

.

GFORTRAN производит дает эту ошибку:

       write(*,*) s(t%f)
                       1
Error: Expected argument list at (1)

.

Но что я могу сделать:

program test

   t%a=3e0
   write(*,*) s(k)

contains

   real function s(g)
      real,external :: g
      s=g(5e0)+2e0
   end function

   real function k(e)
      real,intent(in) :: e
      k=3e0+e
   end function

end program

.

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

Редактировать:

лучший пример, который (надеюсь) показывает сложность:

module mod2
   implicit none
contains

   real function s(g)
       interface
        real function g(x)
          real, intent(in) :: x
        end function
      end interface

      s=g(5e0)+2e0
   end function
end module

module mod1
   use mod2

   type type1
      real :: a
      contains
      procedure,pass :: f
      procedure,pass :: h
   end type

contains

   real function f(y,e)
      class(type1), intent(in) :: y
      real,intent(in) :: e
      f=y%a+e
   end function

   real function h(y)
      class(type1), intent(inout) :: y
      h=s(y%f)
   end function
end module

program test

use mod1
   type(type1) :: t

   t%a=3e0
   write(*,*) t%h
end program

.

Редактировать II: ОК, обертки все еще работают в сочетании с указателем:

module mod2
   implicit none
contains

   real function s(g)
       interface
        real function g(x)
          real, intent(in) :: x
        end function
      end interface

      s=g(5e0)+2e0
   end function
end module 

module mod1 
   use mod2

   type type1
      real :: a
      contains
      procedure,pass :: f
      procedure,pass :: h
   end type

   class(type1),pointer :: help_w

contains

   real function f(y,e)
      class(type1), intent(in) :: y
      real,intent(in) :: e
      f=y%a+e
   end function

   real function h(y)
      class(type1), intent(inout),target :: y
      help_w => y
      h=s(wrap) 
   end function

   function wrap(x)
      real,intent(in) :: x
      wrap=help_w%f(x)
   end function 
end module

program test

use mod1
   type(type1) :: t

   t%a=3e0
   write(*,*) t%h()
end program

.

Это, безусловно, не красивое решение, но, по крайней мере, он работает.

Answer 1

Вы можете написать обертку.Это самая простая версия.Требуется прохождение внутренней функции в качестве фиктивного аргумента (F2008), но вы могли бы объявить обертку в модуле тоже, если генеракодицетагкод может быть там.

Примечание Я изменил декларацию аргумента процедуры в t к чему более современно - интерфейсный блок.

program test
   use mod1
   type(type1) :: t

   t%a=3e0
   write(*,*) s(wrap)

contains

   real function s(g)
      interface
        real function g(x)
          real, intent(in) :: x
        end function
      end interface

      s=g(5e0)+2e0
   end function

   function wrap(x)
     real, intent(in) :: x
     wrap = t%f(x)
   end function

end program

.

Причина вашей ошибки хорошо описана в ответах на связанный вопрос, вы не можете пройти процедуры, связанные с типом, как вы пытались.