I've written a set of subroutines and compiled them into a library. These subroutines are based on some defined function(x,y). At the moment this is buried inside the library routine - however what I'd like is to be able to pass any function(x,y) into this library - is this possible? Thanks guys!
module ExampleFuncs
implicit none
abstract interface
function func (z)
real :: func
real, intent (in) :: z
end function func
end interface
contains
subroutine EvalFunc (aFunc_ptr, x)
procedure (func), pointer :: aFunc_ptr
real, intent (in) :: x
write (*, *) "answer:", aFunc_ptr (x)
end subroutine EvalFunc
function f1 (x)
real :: f1
real, intent (in) :: x
f1 = 2.0 * x
end function f1
function f2 (x)
real :: f2
real, intent (in) :: x
f2 = 3.0 * x**2
end function f2
end module ExampleFuncs
program Func_to_Sub
use ExampleFuncs
implicit none
procedure (func), pointer :: f_ptr => null ()
f_ptr => f1
call EvalFunc (f_ptr, 2.0)
f_ptr => f2
call EvalFunc (f_ptr, 2.0)
stop
end program Func_to_Sub
Related
I am trying to create a generic function in Fortran based on the value to be returned, that is, depending on if the output of the function is to be assigned to a single precision real or to a double precision real. The code is:
MODULE kk_M
USE ISO_FORTRAN_ENV
IMPLICIT NONE
INTEGER, PARAMETER :: sp = REAL32
INTEGER, PARAMETER :: dp = REAL64
INTERFACE use_func
MODULE PROCEDURE use_sp_func
MODULE PROCEDURE use_dp_func
END INTERFACE use_func
INTERFACE use_sub
MODULE PROCEDURE use_sp_sub
MODULE PROCEDURE use_dp_sub
END INTERFACE use_sub
CONTAINS
FUNCTION use_sp_func() RESULT(res)
REAL(KIND=sp) :: res
res = 5._sp
END FUNCTION use_sp_func
FUNCTION use_dp_func() RESULT(res)
REAL(KIND=dp) :: res
res = 5._dp
END FUNCTION use_dp_func
SUBROUTINE use_sp_sub(res)
REAL(KIND=sp), INTENT(OUT) :: res
res = 5._sp
END SUBROUTINE use_sp_sub
SUBROUTINE use_dp_sub(res)
REAL(KIND=dp), INTENT(OUT) :: res
res = 5._dp
END SUBROUTINE use_dp_sub
END MODULE kk_M
PROGRAM kk
USE kk_M
IMPLICIT NONE
REAL(KIND=sp) :: num_sp
REAL(KIND=dp) :: num_dp
num_sp = use_func()
WRITE(*,*) num_sp
num_dp = use_func()
WRITE(*,*) num_dp
CALL use_sub(num_sp)
WRITE(*,*) num_sp
CALL use_sub(num_dp)
WRITE(*,*) num_dp
END PROGRAM kk
With the generic subroutines the code compiles and works, but when I add the generic functions it does not compile. I get the following error message with gfortran:
kk.f90:22:3:
FUNCTION use_sp_func() RESULT(res)
1
kk.f90:27:3:
FUNCTION use_dp_func() RESULT(res)
2
Error: Ambiguous interfaces in generic interface 'use_func' for ‘use_sp_func’ at (1) and ‘use_dp_func’ at (2)
kk.f90:46:7:
USE kk_M
1
Fatal Error: Can't open module file ‘kk_m.mod’ for reading at (1): No existe el archivo o el directorio
compilation terminated.
It looks like the compiler cannot distinguish between both functions based on the value to be returned. Is there some way to achieve this?
You cannot distinguish specific functions in a generic interface by their return value. There is no way how the compiler can see what return value type is to be used. A Fortran expression is always evaluated without the surrounding context. Fortran generic disambiguation is based by TKR (type, kind, rank) resolution only using the procedure arguments, not using the return value.
When you have
use_func()
there is no way for the compiler to know which of those two functions should be called. Even when it is used directly in an assignment
x = use_func()
it is evaluated separately. In general, function calls can appear in various complicated expressions. E.g. use_func(use_func()) + use_func(), which one would be which?
This is the reason why several intrinsic functions have another argument that specifies the return type. For example, the transfer() function has a second argument that specifies which type should be returned. Otherwise the compiler would not be able to find out.
Following the advice by Vladimir F, I had a look at the transfer intrisic function and added a mold parameter to my functions to set the return type.
If any input argument to the functions were real they could be used to set the return type as High Performace Mark stated, but since this is not my case I finally used the mold variable.
Now it compiles and work. The code is:
MODULE kk_M
USE ISO_FORTRAN_ENV
IMPLICIT NONE
INTEGER, PARAMETER :: sp = REAL32
INTEGER, PARAMETER :: dp = REAL64
INTERFACE use_func
MODULE PROCEDURE use_sp_func
MODULE PROCEDURE use_dp_func
END INTERFACE use_func
INTERFACE use_sub
MODULE PROCEDURE use_sp_sub
MODULE PROCEDURE use_dp_sub
END INTERFACE use_sub
CONTAINS
FUNCTION use_sp_func(mold) RESULT(res)
REAL(KIND=sp),INTENT(IN) :: mold
REAL(KIND=sp) :: res
IF (.FALSE.) res = mold !To avoid compilation warning about unused variable
res = 5._sp
END FUNCTION use_sp_func
FUNCTION use_dp_func(mold) RESULT(res)
REAL(KIND=dp),INTENT(IN) :: mold
REAL(KIND=dp) :: res
IF (.FALSE.) res = mold !To avoid compilation warning about unused variable
res = 5._dp
END FUNCTION use_dp_func
SUBROUTINE use_sp_sub(res)
REAL(KIND=sp), INTENT(OUT) :: res
res = 5._sp
END SUBROUTINE use_sp_sub
SUBROUTINE use_dp_sub(res)
REAL(KIND=dp), INTENT(OUT) :: res
res = 5._dp
END SUBROUTINE use_dp_sub
END MODULE kk_M
PROGRAM kk
USE kk_M
IMPLICIT NONE
REAL(KIND=sp) :: num_sp
REAL(KIND=dp) :: num_dp
num_sp = use_func(1._sp)
WRITE(*,*) num_sp
num_dp = use_func(1._dp)
WRITE(*,*) num_dp
CALL use_sub(num_sp)
WRITE(*,*) num_sp
CALL use_sub(num_dp)
WRITE(*,*) num_dp
END PROGRAM kk
I'm using Fortran and gfortran 4.7.2. I'm pretty new to Fortran and searched intensively for a solution to my problem. The program I want to use has many functions, which should be aliased based on the given conditions correctly. For that I want to use pointer.
The main program creates pointer based on the interface in the module func_interface. Based on which function I want to alias, I wrote a subroutine which should change the pointer to desired function. Nevertheless I receive a 'Memory Access Error' when trying to run the program - obviously because I didn't understand the pointers in Fortran or how to pass them to a subroutine in order to change them inside the subroutine correctly.
Has somebody an idea how to change the program in order to use it this way? The program is as below.
MODULE func_interface
ABSTRACT INTERFACE
FUNCTION func(z)
DOUBLE PRECISION func
DOUBLE PRECISION, INTENT (IN) :: z
END FUNCTION func
END INTERFACE
END MODULE func_interface
SUBROUTINE assign_pointer(i, func_ptr)
USE func_interface
IMPLICIT NONE
PROCEDURE (func), POINTER, INTENT(INOUT) :: func_ptr => NULL ()
INTEGER, INTENT (IN) :: i
DOUBLE PRECISION f1, f2
EXTERNAL f1, f2
SELECT CASE ( i )
CASE ( 1 )
func_ptr => f1
RETURN
CASE ( 2 )
func_ptr => f2
RETURN
END SELECT
END SUBROUTINE assign_pointer
DOUBLE PRECISION FUNCTION f1(x)
IMPLICIT NONE
DOUBLE PRECISION, INTENT(IN) :: x
f1 = 2*x
END FUNCTION f1
DOUBLE PRECISION FUNCTION f2(x)
IMPLICIT NONE
DOUBLE PRECISION, INTENT(IN) :: x
f2 = 4*x
END FUNCTION f2
PROGRAM pointer_test
USE func_interface
IMPLICIT NONE
DOUBLE PRECISION f1, f2
EXTERNAL f1, f2
PROCEDURE (func), POINTER :: func_ptr => NULL ()
CALL assign_pointer( 1, func_ptr )
WRITE(*, '(1PE12.4)') func_ptr(5.2D1)
END PROGRAM pointer_test
Error Message :
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
Backtrace for this error:
#0 0x7F32AFB92667
#1 0x7F32AFB92C34
#2 0x7F32AF14F19F
#3 0x4007CE in assign_pointer_
#4 0x40085B in MAIN__ at pointer_test.f90:0
Speicherzugriffsfehler
The answer by innoSPG gives the essential aspects of the solution: extend what the module includes to make an explicit interface available in the main program for the subroutine assign_pointer. I'll give a little more detail and address a difficulty suggested in a comment.
First, look at the (simplified) subroutine definition:
subroutine assign_pointer(i, func_ptr)
use func_interface ! func is given in here
procedure(func), pointer, intent(inout) :: func_ptr
integer, intent(in) :: i
end subroutine assign_pointer
The dummy argument func_ptr of this subroutine has the pointer attribute. As given elsewhere such an attribute requires an explicit interface in a scope referencing the subroutine. That other answer shows how that can be arranged (and there are many other questions and answer around that to be found).
The subroutine and functions are external procedures and do not automatically have an explicit interface available.
You then asked
Although I thought that using USE func_interface is explicitly defining the pointer.. what is the mistake in this thought?
The module func_interface contains the abstract interface func. This abstract interface is used in the declaration of the procedure pointers. However, it's the subroutine assign_pointer, as noted above, which is problematic. One can see that the dummy argument
procedure(), pointer, intent(inout) :: func_ptr
(which has implicit interface) is wholly independent of the module, but still there is a requirement for the subroutine's interface to be explicit in a calling scope.
So, the abstract interface is only one small part of the way to get this program to work.
And even that abstract interface may be unnecessary. Depending on how f1 and f2 are to be made available we may be able to write the module as:
module full_mod
contains
function f1(..)
end function f1
function f2(..)
end function f2
subroutine assign_pointer(i, func_ptr)
procedure(f1), pointer, intent(inout) :: func_ptr
integer, intent(in) :: i
! f1 and f2 available from the host module
end subroutine assign_pointer
end module
use full_mod
implicit none
procedure(f1), pointer :: func_ptr => NULL()
...
end
That is, f1 and f2 may themselves be used to give the interface of a procedure pointer, when those functions are in scope.
And a final note: the dummy argument func_ptr may not have explicit initialization. A line such as
procedure(func), pointer, intent(inout) :: func_ptr => NULL()
is trying to do exactly that. It is trying to say that func_ptr is initially disassociated. As can be seen in my code lump above the => NULL() should be removed. Either standard pointer assignment should be used
procedure(func), pointer, intent(inout) :: func_ptr
func_ptr => NULL()
or we can note that the explicit initialization in the main program
procedure(func), pointer :: func_ptr => NULL()
is allowed and as the dummy argument has the intent(inout) attribute it retains that not-associated status on entry to the subroutine.
The comments from francescalus and Vladimir are what you need. Below I suggest a simple reorganization of your code where I put all the functions in the existing module. I also commented the external statements because they become useless with functions in a module.
You will find the following comment on many fortran question on S.O. but it is worth putting it here again. When starting new project, you should stick to modern programming techniques. It is better to put procedures in module instead of using the external. That will automatically build the interface for you and do some checking at compile time.
Now if you are going to use some functions that exist already and you are not modifying them, you need to supply explicit interface.
Thank to francescalus comment, I modify the call to the selected function in the main program, to call only if it is initialized. To avoid that, the default case can be processed in the procedure assign_pointer.
MODULE func_interface
ABSTRACT INTERFACE
FUNCTION func(z)
DOUBLE PRECISION func
DOUBLE PRECISION, INTENT (IN) :: z
END FUNCTION func
END INTERFACE
CONTAINS
SUBROUTINE assign_pointer(i, func_ptr)
! USE func_interface
IMPLICIT NONE
PROCEDURE (func), POINTER, INTENT(INOUT) :: func_ptr => NULL ()
INTEGER, INTENT (IN) :: i
!DOUBLE PRECISION f1, f2
!EXTERNAL f1, f2
SELECT CASE ( i )
CASE ( 1 )
func_ptr => f1
RETURN
CASE ( 2 )
func_ptr => f2
RETURN
END SELECT
END SUBROUTINE assign_pointer
DOUBLE PRECISION FUNCTION f1(x)
IMPLICIT NONE
DOUBLE PRECISION, INTENT(IN) :: x
f1 = 2*x
END FUNCTION f1
DOUBLE PRECISION FUNCTION f2(x)
IMPLICIT NONE
DOUBLE PRECISION, INTENT(IN) :: x
f2 = 4*x
END FUNCTION f2
END MODULE func_interface
PROGRAM pointer_test
USE func_interface
IMPLICIT NONE
!DOUBLE PRECISION f1, f2
!EXTERNAL f1, f2
PROCEDURE (func), POINTER :: func_ptr => NULL ()
CALL assign_pointer( 1, func_ptr )
IF(associated(func_ptr))then
WRITE(*, '(1PE12.4)') func_ptr(5.2D1)
ELSE
! manage the cas
END IF
END PROGRAM pointer_test
I am trying to generalize a function call from a subroutine. So my idea is something like this
if (case1) then
call MainSubroutine1(myFun)
elseif (case2)
call MainSubroutine2(myFun)
end if
do i = 1,4
data = myFun(i)
end do
I realize this is kind of vague but I am not sure if this is possible.
Thank you,
John
edit 1/31/14 7:57 AM
I am sorry for the vague way I phrased this. I was thinking something similar to what #haraldki did but I was hoping that I could define an anonymous function within MainSubroutine1 and MainSubroutine2 and transfer that definition out to the main code.
This is because myFun depends on different stretched distribution (Gaussian and Fermi-Dirac) and I don't want to have a function that only calls a function with a constant thrown it.
Is this possible?
Thank you again.
John
The answer to you question simply is: no, you can't return an anonymous function. This is because, as #VladimirF says in the comments, there are no anonymous functions in Fortran. As the comments say, though, procedure pointers are quite passable.
Massive speculation follows which is hopefully useful as a way of avoiding the anonymous function requirement.
I infer that you would like to do something like
subroutine MainSubroutine1(fptr)
procedure(func), pointer, intent(out) :: fptr
! Calculate parameterization for your "anonymous" function
fptr => anon_parameterized
contains
real function anon_parameterized(i)
integer, intent(in) :: i
! Use the parameterization
anon_parameterized = ...
end function
end subroutine
and you don't want to do
subroutine MainSubroutine1(fptr)
procedure(func), pointer, intent(out) :: fptr
fptr => Gaussian
end subroutine
real function Gaussian(i)
integer, intent(in) :: i
! Calculate parameterization
Gaussian = Gaussian_parameterized(i, ...)
contains
function Gaussian_parameterized(i, ...)
integer, intent(in) :: i
!... other intent(in) parameters
end function
end subroutine
Note that these aren't internal, as passing pointers to things internal elsewhere is not well implemented (as an F2008 feature) yet, and is tricky. Passing a pointer to an internal procedure to get host association scares me.
If my inference is correct, then there is the possibility of using module variables to store the parameterization, again allowing the final "parameterized" call to be not internal to MainSubroutine1.
However, you may want to avoid module variables in which case you may consider passing passing the parameterization along with the function call:
procedure(func), pointer :: myFun => null()
if (case1) then
call MainSubroutine1(myFun)
else if (case2)
call MainSubroutine2(myFun)
end if
if (.not.associated(myFun)) STOP ":("
data = myFun(1, par1, par2)
Ah, but you don't know for certain what parameters the non-parameterized function myFun requires, so your interface is all broken. Isn't it?
Which then leads to polymorphism.
module dists
type, abstract :: par_type
end type par_type
type, extends(par_type) :: par_gaussian
real :: mu=5.2, sigma=1.2
end type par_gaussian
type, extends(par_type) :: par_fermi_dirac
real :: eps=11.1, mu=4.5
end type par_fermi_dirac
abstract interface
real function func(i, pars)
import par_type
integer, intent(in) :: i
class(par_type), intent(in) :: pars
end function func
end interface
contains
real function gaussian(i, pars)
integer, intent(in) :: i
class(par_type), intent(in) :: pars
select type (pars)
class is (par_gaussian)
print*, "Gaussian", pars%mu, pars%sigma
gaussian = pars%mu+pars%sigma
end select
end function gaussian
real function fermi_dirac(i, pars)
integer, intent(in) :: i
class(par_type), intent(in) :: pars
select type (pars)
class is (par_fermi_dirac)
print*, "Fermi-Dirac", pars%eps, pars%mu
fermi_dirac = pars%eps+pars%mu
end select
end function fermi_dirac
subroutine sub1(fptr, pars)
procedure(func), pointer, intent(out) :: fptr
class(par_type), intent(out), allocatable :: pars
fptr => gaussian
allocate(par_gaussian :: pars)
end subroutine sub1
subroutine sub2(fptr, pars)
procedure(func), pointer, intent(out) :: fptr
class(par_type), intent(out), allocatable :: pars
fptr => fermi_dirac
allocate(par_fermi_dirac :: pars)
end subroutine sub2
end module dists
program prog
use dists
implicit none
class(par_type), allocatable :: pars
procedure(func), pointer :: myfun
call sub1(myfun, pars)
print*, myfun(i, pars)
call sub2(myfun, pars)
print*, myfun(i, pars)
end program prog
That's all speculation, though.
I guess I could easily use some help here, since I'm messing around with some fortran 2003 but can't seem to understand how to do things really.
The fact is that I need to write a fortran code that declares, inside a module, a new data type
that has as one of its members a pointer to a real function. Something like
module new_mod
type my_type
real*8 :: a, b
(here something that declares a real*8 function), pointer :: ptr
end type my_type
end module_new
module funcs
real*8 function function1(x)
real*8 :: x
function1 = x*x
end function function1
real*8 function function2(x)
real*8 :: x
function2 = x*x
end function function2
end module funcs
then in the main program I would like to have something like
program my_prog
use module_new
use module_funcs
implicit none
real*8 :: y, z
type(my_type) :: atom
...
atom%ptr => function1
y = atom%ptr(x)
...
atom%ptr => function2
z = atom%ptr(x)
end program my_prog
while
so the main idea is that module_new contains a type that has a pointer to a real
function. This pointer in th eobjects of the new type I must be able to point to different functions in the main program.
I have seen one can do similar things with abstract interfaces and such, but honestly, I'm in a mess here. If someone could help, I'll appreciate that.
Cheers...
Well, that is not really the type of question you would send to stackoverflow, but actually your code needs only a "slight improvement" (by appropriate definition of slight) to work:
module accuracy
implicit none
integer, parameter :: dp = kind(1.0d0)
end module accuracy
module typedef
use accuracy
implicit none
type :: mytype
real(dp) :: aa, bb
procedure(myinterface), pointer, nopass :: myfunc
end type mytype
abstract interface
function myinterface(xx)
import :: dp
real(dp), intent(in) :: xx
real(dp) :: myinterface
end function myinterface
end interface
end module typedef
module funcs
use accuracy
implicit none
contains
function func1(xx)
real(dp), intent(in) :: xx
real(dp) :: func1
func1 = xx
end function func1
function func2(xx)
real(dp), intent(in) :: xx
real(dp) :: func2
func2 = 2.0_dp * xx
end function func2
end module funcs
program test
use accuracy
use typedef
use funcs
implicit none
real(dp) :: xx
type(mytype) :: atom
xx = 12.0_dp
atom%myfunc => func1
print *, atom%myfunc(xx)
atom%myfunc => func2
print *, atom%myfunc(xx)
end program test
There are several things to be worth to mentioned:
You should use one global parameter for your accuracy (see module accuracy) and forget about real*8.
Your procedure pointer in your derived type needs an interface, which is provided within the following abstract interface block (see 'abstract interfaces' in a good F2003 book).
You need the nopass option for the procedure pointer in the derived type as otherwise Fortran will assume that the first parameter passed to the function/subroutine is the derived type itself (see 'type bound procedures' in a good F2003 book).
Finally, although rather obvious: You should definitely read a book about the Fortran 2003 features if you are serious about using them in a production code.
I'm trying to use a procedure pointer (new feature in Fortran 2003) to point to an elemental function but it does not work. I really need the function to be ELEMENTAL and need a pointer to it. Is it truly impossible to point to an elemental function in Fortran?
module elemfunc
implicit none
contains
elemental function fun111(x) result(y)
real*8, intent(in) :: x
real*8 :: y
y = x**2+1
end function fun111
end module elemfunc
program testptr
use elemfunc
implicit none
interface
elemental function func (z)
real*8 :: func
real*8, intent (in) :: z
end function func
end interface
procedure (func), pointer :: ptr
ptr => fun111
print *, ptr( (/1.0d0,2.0d0/) )
end program testptr
Error message:
main.f90:12.7:ptr=>fun111
1
Nonintrinstic elemental procedure pointer 'func111' is invalid in procedure pointer assignment at (1)
In paragraph 7.4.2 Pointer Assignment of the fortran 2003 standard it is explicitly stated that this is not allowed:
C728 (R742) The proc-target shall not be a nonintrinsic elemental procedure
(This constraint is still there in the fortran 2008 standard, so it hasn't been relaxed.)
I had this exact same issue and did not even realize it was an issue until I compiled with gfortran. Unfortunately, it is also forbidden to have dummy procedure arguments to elemental procedures. It is, however, still possible to achieve the functionality you want, though it is a bit kludgy.
What you can legally do is have an elemental function call a pure function. Depending on your needs, the elemental function can be type bound or not.
Option one
Put the procedure pointer and function inside a module:
module A
implicit none
procedure(func_IF), pointer :: ptr => null()
abstract interface
pure function func_IF(x)
real, intent(in) :: x
real :: func_IF
end function
end interface
contains
! Non type bound elemental
elemental function myfun1(x) result(r)
real, intent(in) :: x
real :: r
if(associated(ptr)) r = ptr(x)
end function
end module
Option two
Put both pointer and function inside a derived type:
module B
implicit none
type :: foo
procedure(func_IF), nopass, pointer :: ptr => null()
contains
procedure, pass :: myfun2
end type
abstract interface
pure function func_IF(x)
real, intent(in) :: x
real :: func_IF
end function
end interface
contains
! Type bound elemental
elemental function myfun2(this, x) result(r)
class(foo), intent(in) :: this
real, intent(in) :: x
real :: r
if(associated(this%ptr)) r = this%ptr(x)
end function
end module
A small test program:
program main
use A
use B
implicit none
type(foo) :: myfoo
myfoo%ptr => bar
ptr => bar
print*, myfun1([10., 20.])
print*, myfoo%myfun2([10., 20.])
contains
! Demo pure function with interface func_IF
pure function bar(x)
real, intent(in) :: x
real :: bar
bar = x**2
end function
end