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
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
This question already has an answer here:
Module calling an external procedure with implicit interface
(1 answer)
Closed 5 years ago.
I am completely new to Fortran 90 and I am trying to understand how to pass an array to a function. I looked on the web and I could not find any clear and simple enough example, so I decided to post here.
I would like the function be able to work on an array of any length (the length of the array should not be one of the parameters of the functions).
I tried to write a simple example of a function that returns the sum of the elements of an array:
function mysum(arr)
implicit none
real, dimension(:), intent(in) :: arr
real :: mysum
integer :: i,arrsize
arrsize = size(arr)
mysum=0.0
do i=1,arrsize
mysum=mysum+arr(i)
enddo
end function mysum
program test
implicit none
real, dimension(4) :: a
real :: mysum,a_sum
call random_number(a)
print *,a
a_sum=mysum(a)
print *,a_sum
end program
When I try to compile, I get the following error:
array_test.f90:17.14:
real mysum,a_sum
1
Error: Procedure 'mysum' at (1) with assumed-shape dummy argument 'arr' must have an explicit interface
What is the problem with my program?
Assumed shape dummy arguments (those with (:)) require explicit interface to the procedure to be available at the call site. That means the calling code must know how exactly the subroutine header looks like. See also Module calling an external procedure with implicit interface
That explicit interface can be provided in several ways
1.
preferred - a module procedure
module procedures
implicit none
contains
function mysum(arr)
real, dimension(:), intent(in) :: arr
real :: mysum
integer :: i,arrsize
arrsize = size(arr)
mysum=0.0
do i=1,arrsize
mysum=mysum+arr(i)
enddo
end function mysum
end module
program test
use procedures
implicit none
!no mysum declared here, it comes from the module
...
end program
2.
internal procedure - only for short simple procedures or if the procedure needs access to the host's variables. Because of the access to the host variables it is error-prone.
program test
implicit none
!no a_sum declared here, it is visible below contains
...
contains
function mysum(arr)
!implicit none inherited from the program
real, dimension(:), intent(in) :: arr
real :: mysum
integer :: i,arrsize
arrsize = size(arr)
mysum=0.0
do i=1,arrsize
mysum=mysum+arr(i)
enddo
end function mysum
end program
3.
interface block - not recommended at all, you should have some particular reason to use it
function mysum(arr)
! removed to save space
end function mysum
program test
implicit none
interface
function mysum(arr)
real, dimension(:), intent(in) :: arr
real :: mysum
end function
end interface
!no mysum declared there
!it is declared in the interface block
...
end program
I have a subroutine (minimal example)
subroutine treatfunction(f,input,output)
external, real::f
real, intent(in):: input
real, intent(out):: output
output = f(input) + f(1.0) ! i.e. f has only one argument
end subroutine
and a function with two arguments
real function fun(x,a)
real,intent(in)::x,a
Now for a given a fixed at runtime, I want to pass fun to treatfunction. So ideally, I would want to call something like
call treatfunction(fun(:,a=a0), input=myinput, output=myoutput)
What is the most elegant way of doing this with the Fortran2003 features gfortran-5 supports?
Of course, I could insert an optional dummy argument a in treatfunction and call f either with f(x) or f(x,a) depending on present(a) in the subroutine's body. But changing the subroutine is not elegant.
In Fortran 2008 you can pass internal functions as arguments and gfortran supports it.
subroutine calling()
a0 = ...
call treatfunction(wrapper, input=myinput, output=myoutput)
contains
real function wrapper(x)
real, intent(in) :: x
wrapper = fun(x,a0)
end function
end subroutine
BTW, I would stay away from external it is evil, use interface blocks.
I have the following FORTRAN code:
FUNCTION inverse_deterministic_cdf(dist, p) RESULT(value)
!=========== result ============
REAL(C_DOUBLE) :: value
!====== input parameters =======
TYPE(deterministic), INTENT(IN) :: dist
REAL(C_DOUBLE), INTENT(IN) :: p
!======= subroutine body =======
value = p ! This is only here to suppress unused dummy argument warning
value = dist%value
END FUNCTION inverse_deterministic_cdf
In this case, inverse_deterministic_cdf is an implementation of an inverse_cdf interface, which is why there's the unused p here. As you can see, I have a method of suppressing the unused dummy argument, but it feels inelegant to me. Does anyone have any best practices for how they handle this? (I also want this to be compiler agnostic.) I know how to suppress the warnings universally, but I want to be warned when I have an unused dummy argument and I'm not anticipating it.
Edit to add (upon request):
The inverse_cdf interface is defined thusly:
INTERFACE inverse_cdf
MODULE PROCEDURE inverse_distribution_cdf, inverse_normal_cdf, inverse_lognormal_cdf, inverse_deterministic_cdf
END INTERFACE
My guess would be that you need to define a generic interface.
stuff.f90
MODULE stuff
IMPLICIT NONE
INTERFACE stuff_foo
MODULE PROCEDURE foo1
MODULE PROCEDURE foo2
END INTERFACE stuff_foo
CONTAINS
FUNCTION foo1(a) RESULT(f)
REAL :: a
REAL :: f
f = a
END FUNCTION foo1
FUNCTION foo2(a, b) RESULT(f)
REAL :: a
REAL :: b
REAL :: f
f = a + b
END FUNCTION foo2
END MODULE stuff
main.f90
PROGRAM main
USE stuff
IMPLICIT NONE
PRINT *, stuff_foo(1.0)
PRINT *, stuff_foo(1.0, 2.0)
END PROGRAM main
Since you have your procedure in a module (and thus, the procedure has an explicit interface), why not use an optional argument? E.g. something like
FUNCTION inverse_cdf(dist, p) RESULT(value)
!=========== result ============
REAL(C_DOUBLE) :: value
!====== input parameters =======
TYPE(deterministic), INTENT(IN) :: dist
REAL(C_DOUBLE), INTENT(IN), OPTIONAL :: p
!======= subroutine body =======
IF (PRESENT(p)) THEN
value = dist%value * p ! Some expression using p
ELSE
value = dist%value
END IF
END FUNCTION inverse_cdf