How do we write boolean functions in Fortran 90. Like if I was making a stack and wanted to make a boolean function isEmpty which would return a true/false.
I tried looking for an example of this but literally couldn't find one. Would someone show me an example of how this could be done.
Here are three examples of functions returning a logical value, using different syntax. You can choose whether to define a RESULT variable that is different from the function name. I use the first syntax in my code.
module foo
implicit none
contains
!
function even(i) result(tf)
integer, intent(in) :: i
logical :: tf
tf = modulo(i,2) == 0
end function even
!
logical function odd(i) result(tf)
integer, intent(in) :: i
tf = modulo(i,2) == 1
end function odd
!
logical function triplet(i)
integer, intent(in) :: i
triplet = modulo(i,3) == 0
end function triplet
!
end module foo
!
program main
use foo, only: even,odd,triplet
implicit none
print*,even(2),even(3),even(5),even(0) ! output: T F F T
print*,odd(2),odd(3),odd(5),odd(0) ! output: F T T F
print*,triplet(2),triplet(3),triplet(5),triplet(0) ! output: F T F T
end program main
Related
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 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 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 an optimization solver in Fortran 90. So, if I want to change the objective function
I have to modified the main file and write the objective function in this way:
subroutine fobj(n,x,f)
implicit none
integer :: n
real(8) :: f
real(8) :: x(n)
intent(in ) :: n,x
intent(out) :: f
!OBJECTIVE FUNCTION
f = x(1)**2-x(2)+2*x(3)
end subroutine fobj
I have a big objective function, so I want to call this line "f = x(1)**2-x(2)+2*x(3)" from an external file or at least the subrutine.
Is that possible? (I'm new in Fortran.)
I know that I can modified the file with Python, but I want to do it in other file.
Thanks a lot!
Sure. Use:
include 'file.inc'
to include source code from an external file.
I'm not sure if this is what you're looking for, but:
Fortran also allows you to pass subroutine/function names around as actual arguments to subroutine/function calls. The corresponding dummy arguments must have the "external" attribute.
subroutine fobj(n,x,f,func)
implicit none
integer :: n
real(8),external :: func
real(8) :: f
real(8) :: x(n)
intent(in ) :: n,x
intent(out) :: f
!OBJECTIVE FUNCTION
f=func(x,n)
end subroutine fobj
function func1(x,n)
implicit none
real(8) func1
integer n
real(8) :: f,x(n)
f = x(1)**2-x(2)+2*x(3)
end function func1
function func2(x,n)
implicit none
real(8) func2
integer n
real(8) :: f,x(n)
f = x(1)**2+x(2)+2*x(3)
end function func2
program main
real(8),external :: func1,func2
real(8),allocatable :: x(:)
real(8) :: f
integer n
n=50
allocate(x(n))
x=10. !Set X to a known value
call fobj(n,x,f,func1) !Call func1
print*,f !10**2-10+2*10 = 110
x=10. !Reset X ... just to make sure there is no funny business in func1,func2
call fobj(n,x,f,func2) !Call func2
print*,f !10**2+10+2*10 = 130
deallocate(x)
end program main
Of course, this program does nothing useful other than call func1 and func2 in obscure ways, but hopefully it illustrates the point. If you're looking to switch out the function at compile-time, then I think a include "myfile" is probably cleaner (just switching which file you're including at the time as suggested by #AlejandroLL)
You might also try to use Modules in your program. Sometimes when you pass special variables to your subroutines/functions you need to write interfaces for them. Using modules will improve your program structure and you'll be more effective and all interfaces would be generated automatically.
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