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.
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.
Related
I want to pass a procedure pointer between two classes in modern Fortran.
this procedure pointer should
be called from within the second object
access the first ojects' components, without having it as dummy argument.
A clear example is here, imagine doing an object-oriented wrapper of an ODE solver:
module test_funptr
implicit none
public
type, public :: ode_solver
integer :: NEQ = 0
procedure(ode_api), pointer, nopass :: f => null()
contains
procedure :: run
end type ode_solver
type, public :: ode_problem
integer :: NEQ = 10
procedure(ode_api), pointer, nopass :: yprime => null()
contains
procedure :: init
end type ode_problem
abstract interface
subroutine ode_api(NEQ,YDOT)
integer, intent(in) :: NEQ
real(8), intent(inout) :: YDOT(NEQ)
end subroutine ode_api
end interface
contains
! Initialize problem variables
subroutine init(this,NEQ)
class(ode_problem), intent(inout) :: this
integer, intent(in) :: NEQ
! Associate function pointer
this%yprime => problem_api
contains
! nopass ODE solver API
subroutine problem_api(NEQ,YDOT)
integer, intent(in) :: NEQ
real(8), intent(inout) :: YDOT(NEQ)
integer :: i
print *, 'entered problem API with NEQ=',NEQ
forall(i=1:NEQ) YDOT(i) = real(i,8)
end subroutine
end subroutine init
subroutine run(this)
class(ode_solver), intent(inout) :: this
real(8) :: ydot(this%neq)
ydot = 0.0
print *, 'enter solver run with NEQ=',this%NEQ
print *, 'is function associated? ',associated(this%f)
call this%f(this%neq,ydot)
end subroutine run
end module test_funptr
program test
use test_funptr
type(ode_solver) :: solver
type(ode_problem) :: prob
call prob%init(10)
! Associate ode solver
solver%neq = prob%NEQ
solver%f => prob%yprime
call solver%run()
end program test
This program returns with gfortran-10:
enter solver run with NEQ= 10
is function associated? T
Program received signal SIGILL: Illegal instruction.
The procedure seems properly associated, but it can't be called. Am I doing something wrong passing the procedure pointers, or I'm doing something out-of-standard? I'm concerned the contained subroutine may go out of scope, but if so, how can I achieve this behavior?
The tricky part is of course that the function should access data from the other variable instance.
It is illegal to invoke a procedure pointer to an internal procedure, after the host procedure gets out of scope.
The draft of Fortran 2015 N2123 mentions this in NOTE 15.17
NOTE 15.17
An internal procedure cannot be invoked using a procedure
pointer from either Fortran or C after the host instance completes
execution, because the pointer is then undefined. While the host
instance is active, however, if an internal procedure was passed as an
actual argument or is the target of a procedure pointer, it could be
invoked from outside of the host subprogram.
... an example follows
Often, internal procedures are implemented using trampolines. That is, a piece of executable code placed on the stack, that enables accessing the local scope and calls the procedure itself. The pointer is then a pointer to the trampoline. Once the host function gets out of scope, the pointer to the stack is invalid.
As pointed out, internal (contained) procedures are not the way to go, as they cannot be targets to procedure pointers. Hopefully this will be catched by the compilers.
I've figured out an elegant way to accomplish the aim to pass an interfaced procedure between two classes this way:
class 1 needs to call that function: it must contain a pointer to class 2
The nopass function should be inside this class, as an internal procedure (this way, it'll never go out of scope)
This class must contain a (polymorphic) pointer to the instantiated object from class 2
class 2 contains the actual implementation, it should instantiate an abstract type that contains the same interfaced function, but with the derived type as dummy argument
Here I'm providing an implementation that works:
module odes
implicit none
type, abstract, public :: ode_problem
integer :: NEQ
contains
procedure(ode_api), deferred :: fun
end type ode_problem
type, public :: ode_solver
integer :: NEQ
class(ode_problem), pointer :: problem => null()
contains
procedure :: init
procedure :: run
end type ode_solver
abstract interface
subroutine ode_api(this,YDOT)
import ode_problem
class(ode_problem), intent(inout) :: this
real(8), intent(out) :: YDOT(this%NEQ)
end subroutine ode_api
end interface
contains
! Associate problem to ODE solver
subroutine init(this,my_problem)
class(ode_solver), intent(inout) :: this
class(ode_problem), intent(in), target :: my_problem
this%neq = my_problem%NEQ
this%problem => my_problem
end subroutine init
! call the nopass f77 interface function
subroutine run(this)
class(ode_solver), intent(inout) :: this
real(8) :: YDOT(this%NEQ)
integer :: i
if (.not.associated(this%problem)) stop 'solver not associated to a problem'
! This will be in general passed to another function as an argument
call ode_f77_api(this%NEQ,YDOT)
contains
subroutine ode_f77_api(NEQ,YDOT)
integer, intent(in) :: NEQ
real(8), intent(out) :: YDOT(NEQ)
! This is just a nopass interface to this problem's function that can
! access internal storage
call this%problem%fun(YDOT)
end subroutine ode_f77_api
end subroutine run
end module odes
! Provide an actual implementation
module my_ode_problem
use odes
implicit none
type, public, extends(ode_problem) :: exp_kinetics
real(8) :: k = -0.5d0
contains
procedure :: fun => exp_fun
end type exp_kinetics
contains
subroutine exp_fun(this,YDOT)
class(exp_kinetics), intent(inout) :: this
real(8), intent(out) :: YDOT(this%NEQ)
integer :: i
forall(I=1:this%NEQ) YDOT(i) = this%k*real(i,8)
print 1, this%NEQ,(i,YDOT(i),i=1,this%NEQ)
1 format('test fun! N=',i0,': ',*(/,10x,' ydot(',i0,')=',f5.2,:))
end subroutine exp_fun
end module my_ode_problem
program test_fun_nopass
use odes
use my_ode_problem
implicit none
type(exp_kinetics) :: prob
type(ode_solver) :: ode
prob%NEQ = 10
call ode%init(prob)
call ode%run()
stop 'success!'
end program test_fun_nopass
This program returns:
test fun! N=10:
ydot(1)=-0.50
ydot(2)=-1.00
ydot(3)=-1.50
ydot(4)=-2.00
ydot(5)=-2.50
ydot(6)=-3.00
ydot(7)=-3.50
ydot(8)=-4.00
ydot(9)=-4.50
ydot(10)=-5.00
STOP success!
I have function that returns an array, say
function f(A)
implicit none
real, intent(in) :: A(5)
real, intent(out) :: f(5)
f = A+1
end
My question is, how can I define f in the main program unit? E.g.
program main
implicit none
real :: A(5)
real, dimension(5), external :: f ! does not work
...
end
You need an explicit interface. You can do this in a few ways.
Explicitly in the scoping unit that calls f:
interface
function f(A)
implicit none
real, intent(in) :: A(5)
real :: f(5)
end function
end interface
Place the function in your program host scope as an internal function:
program main
...
contains
function f(A)
implicit none
real, intent(in) :: A(5)
real :: f(5)
f = A+1
end
end program
Place the function in a module:
module A
contains
function f(A)
implicit none
real, intent(in) :: A(5)
real :: f(5)
f = A+1
end
end module
program main
use A
...
end program
Use the explicit interface from a different procedure with the same arguments and return type, kind and rank.
program main
interface
function r5i_r5o(r5)
implicit none
real, intent(in) :: r5(5)
real :: r5i_r5o(5)
end function
end interface
procedure(r5i_r5o) :: f
...
end program
function f(A)
implicit none
real, intent(in) :: A(5)
real :: f(5)
f = A+1
end
The cleanest way of doing this is option #3 using modules. This gives you the benefit of an automatic explicit interface (not needing to do option #1 everywhere you call f) and makes your function available everywhere the module is used rather than limited to a specific scoping unit as in option #2. Option #4 can be handy if you have many procedures with the same argument and return types since one explicit interface can be re-used for all of them.
This shows three different ways to specify function results, and how to use modules to organize your functions:
module so_func
INTEGER, PARAMETER :: MAX_SIZE = 5
TYPE MY_DATA
INTEGER :: SIZE
REAL, DIMENSION(MAX_SIZE) :: DATA
ENDTYPE
contains
FUNCTION f1(A,N) RESULT(X)
implicit none
INTEGER, INTENT(IN) :: N
REAL, INTENT(IN) :: A(N)
REAL :: X(N)
! ....
X = 1.0+A
END FUNCTION f1
TYPE(MY_DATA) FUNCTION f2(A,N)
implicit none
INTEGER, INTENT(IN) :: N
REAL, INTENT(IN) :: A(N)
! ....
f2%SIZE = N
f2%DATA(1:N) = 1.0+A
END FUNCTION f2
FUNCTION f3(A,N)
implicit none
INTEGER, INTENT(IN) :: N
REAL, INTENT(IN) :: A(N)
REAL :: f3(N)
! ....
f3 = 1.0+A
END FUNCTION f3
end module
program SO_RESULT
use so_func
implicit none
integer, parameter :: n=5
REAL :: A(n), y1(n), y3(n)
TYPE(MY_DATA) :: y2
INTEGER :: i
! Variables
A =(/ (i, i=1,n) /)
y1 = f1(A,n)
y2 = f2(A,n)
y3 = f3(A,n)
end program SO_RESULT
I have a Fortran program that compiles without problems, but then gets an error:
Attempt to call a routine with argument number one as a procedure when
a real(kind=2) was required
ROOTS!X_ROOT - in file exercise2base.f90 at line 20 [+0074]
main - in file exercise2base.f90 at line 65 [+00c8]
I don't really know what this means, I thought maybe it means that I pass an argument to some function which is not the right type, but the references that are given don't make sense:
line 20 is end function x_rtsmpl
line 66 is answer=x_root(bb_integral,l1,l2,epsx,epsf,root_type)
so I don't understand what's going on...
I'm using Silverfrost with Plato IDE.
module roots
implicit none
character(20) :: root_type
contains
function x_rtsmpl(f,x1,x2,epsx,epsf) result(x_root)
implicit none
real(2) :: x_root
real(2), intent(IN) :: x1,x2,epsx,epsf
interface
function f(x)
implicit none
real(2), intent(IN) :: x
real(2) :: f
end function f
end interface
real(2) :: xx,fx
x_root=x1
end function x_rtsmpl
function x_root(f,x1,x2,epsx,epsf) result(x_r)
implicit none
real(2) :: x_r
real(2), intent(IN) :: x1,x2,epsx,epsf
interface
function f(x)
implicit none
real(2), intent(IN) :: x
real(2) :: f
end function f
end interface
x_r=x_rtsmpl(f,x1,x2,epsx,epsf)
return
end function x_root
end module roots
module blackbody
implicit none
private
public :: Ibb
contains
function Ibb(lambda)
real(2) , intent (in) :: lambda
real(2) :: Ibb
Ibb=lambda+1._2
return
end function Ibb
end module blackbody
program master
use roots
use blackbody
implicit none
real(2) :: l2,epsx,epsf,answer,l1,epsi,requested
l1=4.d-7
l2=1.d-4
epsx=1.d-2*l1
epsf=1.d-1
epsi=1.d-4
answer=x_root(Ibb,l1,l2,epsx,epsf)
end program master
EDIT: The code is now trimmed all the way down to its basic functions with only declarations and simple "dummy" calculations.
I have a code that looks like
subroutine sub1(f)
interface
function f(x)
(description of f)
end function f
end interface
(do something with f)
end subroutine sub1
subroutine sub2(f)
interface
function f(x)
(description of f)
end function f
end interface
(do something with f)
end subroutine sub2
However, the two subroutines sub1 and sub2 both use identical interfaces for the dummy function f. How do I make these two procedures share the same interface (e.g. using a module)? Do I have to use procedure pointers?
You can define such reusable "function types" as abstract interfaces in modules:
module m
implicit none
abstract interface
function der(x,y) result(yDot)
real, intent(in) :: x, y
real :: yDot
end function
end interface
end module
subroutine integrateEuler(derY,x0,xf,y)
use m
real, intent(in) :: x0, xf
real, intent(inout) :: y
procedure(der) :: derY
! code here
end subroutine
subroutine integrateRKF45(derY,x0,xf,y)
use m
real, intent(in) :: x0, xf
real, intent(inout) :: y
procedure(der) :: derY
! code here
end subroutine
Using function pointers is not necessary, but you can declare them in the same way: procedure(der), pointer :: funPtr => myFun
In Fortran, you can pass a function/subroutine A as an argument to another function/subroutine B, but can you store A for later retrieval and use?
for example, this is allowed in C
int foo(float, char, char) { /*whatever*/};
int (*pointerToFunction)(float, char, char);
pointerToFunction = foo;
In Fortran you can pass a subroutine as an argument
subroutine foo
! whatever
end subroutine foo
subroutine bar(func)
call func
end subroutine bar
program x
call bar(foo)
end program
but how can you store the address of foo in a similar way to C ?
Starting from so-called "Fortran 2003" (ISO/IEC 1539-2004) procedure pointers is a part of the Fortran language. It's definitely of the major new features of Fortran language.
Usage example from Fortran Wiki.
Stefano, you mentioned strategy design pattern. In Fortran 2003 you can use pure OOP way to implement it (without procedure pointers). Offhand example:
strategies.f90
module strategies
implicit none
private
public :: strategies_transportation_strategy, &
strategies_by_taxi_strategy, &
strategies_by_bus_strategy
type, abstract :: strategies_transportation_strategy
contains
procedure(transportation_strategy_go), deferred :: go
end type strategies_transportation_strategy
type, extends(strategies_transportation_strategy) :: strategies_by_taxi_strategy
contains
procedure :: go => strategies_by_taxi_strategy_go
end type strategies_by_taxi_strategy
type, extends(strategies_transportation_strategy) :: strategies_by_bus_strategy
contains
procedure :: go => strategies_by_bus_strategy_go
end type strategies_by_bus_strategy
abstract interface
subroutine transportation_strategy_go(this)
import strategies_transportation_strategy
class(strategies_transportation_strategy), intent(in) :: this
end subroutine transportation_strategy_go
end interface
contains
subroutine strategies_by_taxi_strategy_go(this)
class(strategies_by_taxi_strategy), intent(in) :: this
print *, "We are using taxi."
end subroutine strategies_by_taxi_strategy_go
subroutine strategies_by_bus_strategy_go(this)
class(strategies_by_bus_strategy), intent(in) :: this
print *, "We are using public transport."
end subroutine strategies_by_bus_strategy_go
end module strategies
vehicles.f90
module vehicles
use strategies
implicit none
private
public :: vehicles_vehicle, &
vehicles_taxi, &
vehicles_bus
type, abstract :: vehicles_vehicle
private
class(strategies_transportation_strategy), allocatable :: transportation_strategy
contains
procedure :: set_transportation_strategy => vehicle_set_transportation_strategy
procedure :: go => vehicle_go
end type vehicles_vehicle
type, extends(vehicles_vehicle) :: vehicles_taxi
contains
procedure :: init => taxi_init
end type vehicles_taxi
type, extends(vehicles_vehicle) :: vehicles_bus
contains
procedure :: init => bus_init
end type vehicles_bus
contains
subroutine vehicle_go(this)
class(vehicles_vehicle), intent(in) :: this
call this%transportation_strategy%go()
end subroutine vehicle_go
subroutine vehicle_set_transportation_strategy(this, new_transportation_strategy)
class(vehicles_vehicle), intent(inout) :: this
class(strategies_transportation_strategy), intent(in) :: new_transportation_strategy
if (allocated(this%transportation_strategy)) then
deallocate (this%transportation_strategy)
end if
allocate (this%transportation_strategy, source=new_transportation_strategy)
end subroutine vehicle_set_transportation_strategy
subroutine taxi_init(this)
class(vehicles_taxi), intent(out) :: this
type(strategies_by_taxi_strategy) :: by_taxi_strategy
call this%set_transportation_strategy(by_taxi_strategy)
end subroutine taxi_init
subroutine bus_init(this)
class(vehicles_bus), intent(out) :: this
type(strategies_by_bus_strategy) :: by_bus_strategy
call this%set_transportation_strategy(by_bus_strategy)
end subroutine bus_init
end module vehicles
main.f90
program main
use vehicles
implicit none
type(vehicles_taxi) :: taxi
type(vehicles_bus) :: bus
call taxi%init()
call bus%init()
call taxi%go()
call bus%go()
end program main
At least works using gfortran 4.6 (20100925).
The following codes demonstrate how to use procedure pointers:
module my_mod
implicit none
contains
subroutine sub1()
write(*,*) 'the first suboutine is being used'
end subroutine sub1
subroutine sub2()
write(*,*) 'the second subroutine is being used'
end subroutine sub2
end module my_mod
program procTest
use my_mod
implicit none
integer :: n
procedure(sub1), pointer:: funPointer => NULL()
write(*,'(A)') "Please enter your option"
read(*,*) n
select case( n )
case( 1 )
funPointer => sub1
case( 2 )
funPointer => sub2
case DEFAULT
funPointer => sub1
end select
call funPointer()
end program procTest