Related
This question already has answers here:
Passing external function of multiple variables as a function of one variable in Fortran
(2 answers)
Fortran minimization of a function with additional arguments
(2 answers)
Function with more arguments and integration
(1 answer)
Passing additional arguments in Newton’s method in Fortran
(2 answers)
Closed 1 year ago.
I have a function to compute Gaussian quadrature of a function $f(x)$ over the region $x \in [a,b]$. Here, $f(x)$ takes only one argument. I would want to know what a good practice would be to use gaussquad with a function which might take more arguments, for example getlaser below.
Laser is a derived type, and calling gaussquad(mylaser%getlaser, a, b) obviously does not work.
double precision function gaussquad(f, a, b) result(I)
implicit none
double precision :: f
double precision, intent(in) :: a, b
I = 2.d0*f(b-a)
end function
double precision function getlaser(this, t)
implicit none
class(Laser), intent(in) :: this
double precision, intent(in) :: t
getlaser = dsin(this%omega*t)
end function getlaser
The getlaser procedure has a user-defined dummy argument this which makes it impossible to define a general integration module.
In the following I will explain how to implement such a general integration module assuming standard data types.
One option would be to define an optional parameter array in gaussquad which can be passed through to the procedure f.
Following is a possible implementation for the integration module
! integ.f90
module integ_m
implicit none
private
public gaussquad
abstract interface
real function finter(x, p)
real, intent(in) :: x
real, optional, intent(in) :: p(:)
end function
end interface
contains
function gaussquad(f, a, b, p) result(int)
!! compute integral: int_a^b f(x; p) dx
procedure(finter) :: f
!! function to integrate
real, intent(in) :: a, b
!! integration bounds
real, optional, intent(in) :: p(:)
!! parameter array
real :: int
!! integral value
int = (b-a)*f(0.5*(a+b), p=p)
end function
end module
One would use it like in this program
! main.f90
program main
use integ_m, only: gaussquad
implicit none
print *, 'integrate x^2', gaussquad(parabola, 0.0, 1.0 )
print *, 'integrate laser (sin)', gaussquad(getlaser, 0.0, 1.0, [10.0])
contains
real function parabola(x, p)
real, intent(in) :: x
real, optional, intent(in) :: p(:)
if (present(p)) error stop "function doesnt use parameters"
parabola = x*x
end function
real function getlaser(t, p)
real, intent(in) :: t
real, optional, intent(in) :: p(:)
getlaser = sin(p(1)*t)
end function
end program
Compilation and running yields
$ gfortran -g -Wall -fcheck=all integ.f90 main.f90 && ./a.out
integrate x^2 0.250000000
integrate laser (sin) -0.958924294
Let us say I have the following abstract interface to a double precision function of single argument
module abstract
abstract interface
function dp_func (x)
double precision, intent(in) :: x
double precision :: dp_func
end function dp_func
end interface
end module abstract
In a different module I define two functions, a simple one g of the type dp_func and a more complicated one f
module fns
contains
double precision function f(a,b,x)
double precision, intent(in)::a,b,x
f=(a-b)*x
end function f
double precision function g(x)
double precision, intent(in)::x
g=x**2
end function g
end module fns
Now a pointer to g can be created as follows
program main
use abstract,fns
procedure(dp_func), pointer :: p
double precision::x=1.0D0, myA=1.D2, myB=1.D1, y
p => g
y=p(x)
end program main
But how one can create a pointer to f(myA,myB,x), i.e., to f at fixed values of a and b, which can be regarded as a function of just 1 parameter, that is, of the dp_func type?
At the end result I want to be able to write something like
p=>f(myA, myB, )
y=p(x)
Comments below suggest that function closure is not a part of fortran standard and that a wrapper function would be a possible solution to it. However, the wrapper must be initialized and this introduces some chances that end user may forget to call the initializer. How one can do it in a clean and transparent way?
EDIT
After posting this question and googling with "closure and fortran", I found this example
which I present in picture form to emphasize the highlighting. This was presented in an online course. But I doubt such implicit parameter setting is a good programming practice. In fact, dangling variables like z in this example are perfect sources of errors!
You can use internal functions to wrap your functions, e.g.
program main
use abstract
use fns
implicit none
procedure(dp_func), pointer :: p
double precision :: x, myA, myB, y
x = 1.0D0
myA = 1.D2
myB = 1.D1
p => g
y=p(x)
p => f2
y = p(x) ! Calls f(1.D2, 1.D1, x)
myA = 1.D3
myB = 1.D2
y = p(x) ! Calls f(1.D3, 1.D2, x)
contains
double precision function f2(x)
double precision, intent(in) :: x
write(*,*) myA, myB
f2 = f(myA,myB,x)
end function
end program main
An internal function in a given scope can use variables from that scope, so they can act like closures.
The implicit use of myA and myB in the internal function f2 may well be a source of programming error, but, provided the scope of f2 is still in scope, this behaviour is identical to lambda functions in other languages, for example the equivalent python lambda:
f2 = lambda x: f(myA,myB,x)
As pointed out by #vladimirF, once the scope of f2 drops out of scope (e.g. if a pointer to f2 is stored and the procedure where f2 is declared returns) any pointers to f2 will become invalid. This can be seen in this code:
module bad
use abstract
use fns
implicit none
contains
function bad_pointer() result(output)
procedure(dp_func), pointer :: output
double precision :: myA,myB
myA = 1.D2
myB = 1.D1
output => f2
contains
double precision function f2(x)
double precision, intent(in) :: x
write(*,*) myA, myB
f2 = f(myA,myB,x)
end function
end function
end module
program main
use abstract
use fns
use bad
implicit none
procedure(dp_func), pointer :: p
double precision :: y,x
p => bad_pointer()
x = 1.D0
y = p(x)
end program
N.B. the above code may well run fine for this simple case, but it's relying on undefined behaviour so shouldn't be used.
You stated the following:
"...However, the wrapper must be initialized and this introduces some chances that end user may forget to call the initializer. How one can do it in a clean and transparent way?..."
The following might be a solution.
It still needs to be initialized but will throw errors if the user hasn't done so.
I defined a type closure which handles the function pointers.
! file closure.f90
module closure_m
implicit none
type closure
private
procedure(f1), pointer, nopass :: f1ptr => null()
procedure(f3), pointer, nopass :: f3ptr => null()
real :: a, b
contains
generic :: init => closure_init_f1, closure_init_f3
!! this way by calling obj%init one can call either of the two closure_init_fX procedures
procedure :: exec => closure_exec
procedure :: closure_init_f1, closure_init_f3
end type
abstract interface
real function f1(x)
real, intent(in) :: x
end function
real function f3(a, b, x)
real, intent(in) :: a, b, x
end function
end interface
contains
subroutine closure_init_f1(this, f)
class(closure), intent(out) :: this
procedure(f1) :: f
this%f1ptr => f
this%f3ptr => null()
end subroutine
subroutine closure_init_f3(this, f, a, b)
class(closure), intent(out) :: this
procedure(f3) :: f
real, intent(in) :: a, b
this%f1ptr => null()
this%f3ptr => f
this%a = a
this%b = b
end subroutine
real function closure_exec(this, x) result(y)
class(closure), intent(in) :: this
real, intent(in) :: x
if (associated(this%f1ptr)) then
y = this%f1ptr(x)
else if (associated(this%f3ptr)) then
y = this%f3ptr(this%a, this%b, x)
else
error stop "Initialize the object (call init) before computing values (call exec)!"
end if
end function
end module
Concerning the lines class(closure), intent(out) :: this:
This is the standard way of writing initializers for Fortran types.
Note that it is class instead of type which makes this polymorphic as is needed for type-bound procedures.
I slightly adjusted your functions module (changed data types)
! file fns.f90
module fns_m
contains
real function f(a, b, x)
real, intent(in) :: a, b, x
f = (a-b)*x
end function
real function g(x)
real, intent(in) :: x
g = x**2
end function
end module
An example program
! file a.f90
program main
use closure_m
use fns_m
implicit none
type(closure) :: c1, c2
call c1%init(g)
print *, c1%exec(2.0)
call c1%init(f, 1.0, 2.0)
print *, c1%exec(2.0)
call c2%init(f, 1.0, -2.0)
print *, c2%exec(3.0)
end program
Example output
$ gfortran closure.f90 fns.f90 a.f90 && ./a.out
4.00000000
-2.00000000
9.00000000
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 am trying to write a procedure which takes in a predefined function procedure and performs the gaussian quadrature integration over some domain. I would like to integrate not only individual functions (say f(x)) but also products of 2 and 3 functions (f(x)*g(x))
I have successfully written the procedure which performs the Gaussian integration and have tested it to work with predefined function procedures. However, it does not work when I pass as input a product of two procedures. When I pass int = integral(S*phi,E_min,E_max,1) (see below for the integral procedure) the error that I get is Function ‘s’ requires an argument list
To solve this I attempted to write a procedure which takes in 3 function procedures and outputs the product of them. The way I have done that is the following
real(dp) function prod(func1,func2,func3)
interface
function func1(E,on)
use f90_kind
real(dp),intent(in)::E
logical,intent(in)::on
real(dp)::func1
end function func1
function func2(E,on)
use f90_kind
real(dp),intent(in)::E
logical,intent(in)::on
real(dp)::func2
end function func2
function func3(E,on)
use f90_kind
real(dp),intent(in)::E
logical,intent(in)::on
real(dp)::func3
end function func3
end interface
prod = func1(E,on) * func2(E,on) * func3(E,on)
end function prod
Which results in Type mismatch in argument ‘e’ at (1); passed REAL(4) to REAL(8). And this is where I get stuck. How do I make my integration procedure function take in as input any product of two or more predefined function procedures?
Here is the Gaussian integration function procedure
real(dp) function integral(func,a,b,int_pts)
interface
function func(E,on)
use f90_kind
real(dp), intent(in) :: E
logical,intent(in) :: on
real(dp) :: func
end function func
end interface
real(dp),intent(in) :: a,b
integer, intent(in) :: int_pts
integer :: idx1, idx2
real(dp) :: dx,F1,F2,S,I,up_lim,low_lim
logical :: on
real(dp),allocatable,dimension(:) :: point,weight
integer, parameter :: nqp = 7
allocate(point(nqp))
allocate(weight(nqp))
call legendre_set(point,weight)
dx = (b-a)/int_pts
I = 0.0_dp
on = .false.
do idx1 = 1,int_pts
low_lim = a + (idx1-1)*dx
up_lim = a + idx1*dx
F1 = (up_lim - low_lim)/2.0_dp
F2 = (up_lim + low_lim)/2.0_dp
S = 0.0_dp
do idx2 = 1,nqp
S = S + weight(idx2) * func(F1*point(idx2)+F2,on)
!print *,"idx2 is",idx2,"func is",func(F1*point(idx2)+F2,on)
enddo
I = I + S * F1
!print *,"Sum is",S
enddo
integral = I
end function integral
which works fine when I call it with integral(S,E_min,E_max,1), where S is one such predefined function.
Thanks
"When I pass int = integral(S*phi,E_min,E_max,1) (see below for the integral procedure) the error that I get is Function ‘s’ requires an argument list"
You cannot multiply a function, only a function result. Also, there are no lambda expressions in Fortran. You have to construct the actual function you want to integrate and pass it to the integration procedure.
You can (but don't have to) do it as an internal function.
int = integral(new_function,E_min,E_max,1)
contains
function new_function(E,on)
real(dp), intent(in) :: E
logical,intent(in) :: on
real(dp) :: new_function
new_function = S(E, on) *phi
end ...
See the related Fortran minimization of a function with additional arguments Passing external function of multiple variables as a function of one variable in Fortran
I am attempting to pass a generic 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 through the 2008 Standard section on generic interfaces and I cannot find such restriction. I also cannot think of a reason why the compiler would not be able to resolve the generic interface at compile-time. My gut is telling me that this should be doable, but I may not have the right approach. Do you know of a standard-compliant way to do this?
No, this is not allowed. Actually, you cannot even pass generic INTRINSIC functions as dummy arguments.
A standard compliant way is to use the right specific functions directly. With INTRINSIC functions you sometimes must write a wrapper for the right kind, when the specific doesn't have a standard name.
For example:
call integrate(derf,0.,1.)
contains
function derf(x)
real(dbl) :: derf
real(dbl), intent(in) :: x
derf = erf(x)
end function
end
is necessary if you want to pass the double precision real (or any other) version of erf() because there is no specific function available.
The Fortran standard doesn't allow one to pass generic procedures as arguments. In order to pass intrinsic functions/subroutines one must resort to user-defined 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
yields
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