Type bound procedure as arguments
Asked Answered
A

1

2

I want to pass a type bound procedures (as an external function) to another function as follows:

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 produces gives this error :

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

But what I can do is:

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

I think the problem is related to Passing type bound procedures as arguments, but I don't see at the moment how the answers there can help me.

EDIT:

A better example which (hopefully) shows the difficulty:

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

EDIT II: Ok, the wrappers still work in combination with a pointer:

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

This is certainly not a beautiful solution but at least it works.

Auriculate answered 2/6, 2014 at 18:50 Comment(0)
P
2

You can write a wrapper. This is the most straightforward version. Requires passing internal function as a dummy argument (F2008), but you could declare the wrapper in a module too, if the t can bee there.

Note I changed the declaration of the procedure argument in s to something more modern - the interface block.

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

The reason for your error is well described in the answers to the linked question, you cannot pass type bound procedures the way you tried.

Paean answered 2/6, 2014 at 19:26 Comment(2)
Yes, I see that I oversimplified my example. Sorry! I'll add another version where I don't see how I can define a wrapper in such an easy way, since it isn't declared when I define the calling. Hope this shows the difficulty better.Auriculate
Yeah, with an aditional pointer it again work. So thanks a lot.Auriculate

© 2022 - 2024 — McMap. All rights reserved.