Passing a general function procedure as an actual argument

Question

I am trying to pass a general procedure as an actual argument to a function:

module mymod implicit none interface func module procedure :: func1 module procedure :: func2 endinterface func contains real function func1(x) real,intent(in) :: x func1 = 2*x endfunction func1 real function func2(x,y) real,intent(in) :: x real,intent(in) :: y func2 = 2*x + 3*y endfunction func2 real function func3(func,x,y) interface real function func(x,y) real,intent(in) :: x real,intent(in) :: y endfunction func endinterface real,intent(in) :: x real,intent(in) :: y func3 = func(x,y) endfunction func3 endmodule mymod program myprogram use mymod implicit none write(*,*)func3(func,2.,3.) endprogram myprogram 

gfortran 6.2.0 notes that I cannot do this:

 test.f90:43:16: write(*,*)func3(func,2.,3.) 1 Error: GENERIC procedure 'func' is not allowed as an actual argument at (1) 

Similarly, with ifort 17:

 test.f90(39): error #8164: A generic interface name shall not be used as an actual argument. [FUNC] write(*,*)func3(func,2.,3.) ----------------^ test.f90(39): error #6637: When a dummy argument is a function, the corresponding actual argument must also be a function. [FUNC] write(*,*)func3(func,2.,3.) ----------------^ compilation aborted for test.f90 (code 1) 

I am reading the Standard 2008 section on common interfaces, and I cannot find such a restriction. I also cannot think of why the compiler will not be able to resolve the common interface at compile time. My gut tells me that this should be doable, but I may not have the right approach. Do you know a standard way to do this?

Answer 1

No, it is forbidden. In fact, you cannot even pass general INTRINSIC functions as dummy arguments.

The standard way is to use direct specific functions directly. With INTRINSIC functions, you sometimes have to write a shell for the type you want, when a particular one does not have a standard name.

For instance:

  call integrate(derf,0.,1.) contains function derf(x) real(dbl) :: derf real(dbl), intent(in) :: x derf = erf(x) end function end 

necessary if you want to pass the real (or any other) double-precision version of erf() , because there is no specific function.

Answer 2

The Fortran standard does not allow passing general procedures as arguments. To pass internal functions / routines, you need to resort to custom wrapper procedures.

 module mymod ! Explicit typing only implicit none ! Declare procedure interface interface function my_func(x, y) result (return_value) real, intent(in) :: x, y real :: return_value end function my_func end interface contains function func1(x) result (return_value) real,intent(in) :: x real :: return_value return_value = 2*x end function func1 function func2(x, y) result (return_value) real, intent(in) :: x, y real :: return_value return_value = 2*x + 3*y end function func2 function func3(user_defined_func, x, y) result (return_value) procedure(my_func) :: user_defined_func real, intent(in) :: x, y real :: return_value return_value = user_defined_func(x,y) end function func3 end module mymod program main use ISO_Fortran_env, only: & stdout => OUTPUT_UNIT, & compiler_version, & compiler_options use mymod ! Explicit typing only implicit none write (stdout, *) func3(func2, 2.0, 3.0) write (stdout, *) func3(foo, 2.0, 3.0) write (stdout, *) func3(my_atan2, 2.0, 3.0) print '(/4a/)', & ' This file was compiled using ', compiler_version(), & ' using the options ', compiler_options() contains ! A user defined function function foo(x, y) result (return_value) real, intent(in) :: x, y real :: return_value return_value = 42 end function foo ! A wrapper function to invoke the intrinsic atan2 function my_atan2(x, y) result (return_value) real, intent(in) :: x, y real :: return_value return_value = atan2(x,y) end function my_atan2 end program main 

gives

 gfortran -std=f2008ts -o main.exe mymod.f90 main.f90 ./main.exe 13.0000000 42.0000000 0.588002622 This file was compiled using GCC version 6.1.1 20160802 using the options -mtune=generic -march=x86-64 -std=f2008ts