For some use I need to define a function inside another function inside a fortran module.
A sample code for easy comprehension is
module func
implicit none
contains
real function f(x,y)
real x,y,g
real function g(r)
real r
g=r
end function g
f=x*g(y)
end function f
end module func
use func
implicit none
write(*,*) f(1.0,1.0)
end
This is giving lots of errors in gfortran like unexpected data declaration, expected end function f, not g....etc.
What is the correct way of defining a function inside another function in fortran?
You use an internal subprogram, see below. Note internal subprograms themselves can not contain internal subprograms.
ian#eris:~/work/stack$ cat contained.f90
Module func
Implicit None
Contains
Real Function f(x,y)
! Interface explicit so don't need to declare g
Real x,y
f=x*g(y)
Contains
Real Function g(r)
Real r
g=r
End Function g
End Function f
End Module func
Program testit
Use func
Implicit None
Write(*,*) f(1.0,1.0)
End Program testit
ian#eris:~/work/stack$ gfortran-8 -std=f2008 -Wall -Wextra -fcheck=all -O -g contained.f90
ian#eris:~/work/stack$ ./a.out
1.00000000
ian#eris:~/work/stack$
Related
I want to write function in a separate file myfunction.f90 and how to modify test.f90 to call it
program test
implicit none
external myfunc
real :: x,myfunc
x = 5
write(*,*) myfunc(x)
end program test
function myfunc(x)
implicit none
real :: myfunc,x
myfunc = x**2
end function myfunc
I separate into 2 files test.f90
program test
implicit none
external myfunc
real :: x,myfunc
x = 5
write(*,*) myfunc(x)
end program test
and myfunc.f90
function myfunc(x)
implicit none
real :: myfunc,x
myfunc = x**2
end function myfunc
But it does not work
The canonical solution is to create a file with a module that includes all your functions after the contains keyword.
Then reference the module in your program with use mymodule and include both files to the compiler command.
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
The purpose of the example below is to parallelize a do loop over a subroutine named "sub1" that invokes a function in which a simple addition operation is executed.
The problem that troubles me is that, in my mathematical model, the invoked function has two input arguments, (a,e), but for some reason in my code, I am restricted to pass a single-argument function to the subroutine "sub1." The solution I figured out is to set the second variable "e" to be inherited by the invoked function from the module it resides. The outcome looks good to me.
I am wondering whether using heritage to pass more than one arguments---identically defined in the module where the invoked function resides---to the invoked function in the parallel region will lead to any racing problem.
Thanks.
Lee
---- There are two files in this example: main.f90 and model.f90.
MAIN.f90
program main
! The definition of sub1 is:
! taking function_1,input_2,input_3 as inputs and
! returning output_4 as output
use omp_lib
use model
implicit none
integer :: j
real :: m(1000),k(1000)
m=[(real(j),j=1,1000)]
!$omp parallel do private(j) shared(m,k)
do j=1,1000
call sub1(fun1,m(j),2.,k(j))
enddo
!$omp end parallel do
end program main
MODEL.F90
module model
implicit none
real :: e
contains
subroutine sub1(func,a,c,d)
implicit none
real, intent(in) :: a,c
real, intent(out) :: d
interface
real function func(a)
implicit none
real :: a
end function func
end interface
e=c
d=func(a)
end subroutine sub1
real function fun1(a)
implicit none
real :: a
fun1=a**e
end function fun1
end module model
Yes, more threads will try to write to the variable e in this line
e=c
and that is a race condition. You can make it threadprivate. That way every thread will have its private copy that will persist during the calls.
In Fortran 2008 you could also do something along the lines of the program below, but the principle is the same.
module model
implicit none
real :: e
contains
subroutine sub2(func,a,d)
implicit none
real, intent(in) :: a
real, intent(out) :: d
interface
real function func(a)
implicit none
real :: a
end function func
end interface
d=func(a)
end subroutine
end module model
program main
! The definition of sub1 is:
! taking function_1,input_2,input_3 as inputs and
! returning output_4 as output
use omp_lib
use model
implicit none
integer :: j
real :: c
real :: m(1000),k(1000)
m=[(real(j),j=1,1000)]
!$omp parallel do private(j,c) shared(m,k)
do j=1,1000
c = i
call sub2(fun1,m(j),k(j))
enddo
!$omp end parallel do
contains
real function fun1(a)
implicit none
real :: a
fun1=a**c
end function fun1
end program main
I am trying writing a simple Fortran code that calculates h = g(f(x)). The x is a vector of length=2.
module m1
implicit none
contains
function f(x)
implicit none
real::f(2),x(2)
f(1)=x(1)-x(2)
f(2)=exp(x(1))-x(2)**2
end function f
function g(ff)
implicit none
real::g(2),x1(2),ffreslt(2)
interface
function ff(x)
implicit none
real::x(2),ff(2)
end function ff
end interface
ffreslt=ff(x1)
g(1)=1-ffreslt(1)
g(2)=2*ffreslt(1)**2-3*ffreslt(2)+4.2
end function g
end module m1
program hgf
use m1
implicit none
real::x1(2),h(2)
x1 = (/0.55,2.47/)
h = g(f(x1))
write(*,*) h
end program hgf
But, I am getting this error message:
h = g(f(x1))
1
Error: Actual parameter 'ff' at <1> is not a PROCEDURE
Am I missing something? Thanks.
in the call to g() you are not passing the function f() but rather the result of calling the function f() with the value of x1.
Check this Notes on converting from F77 to F90 and look at page 24, Section 3.2.7.
Also check this question on procedures as arguments.
Why does GCC not warn me when I forget to specify the return type of a interface function? For me this behavior seams unexpected. What do you say to this?
This is the test-program (uncoment Line 6 and it works as it should):
program returntest
implicit none
interface
function givehalf(Y)
double precision :: Y
!double precision :: givehalf !<-- Uncomment this line
end function givehalf
end interface
double precision :: temp
temp=givehalf(5.151515d0)
print*, 'result= ',temp
end program returntest
function givehalf(Y)
implicit none
double precision :: Y
double precision :: givehalf
print*, 'Y= ',Y
givehalf=Y/2.0d0
print*, 'return Y/2',givehalf
return
end function givehalf
The result is this:
user#bapf028dl:/media/disk> gfortran44 -Wall return-test.f90
user#bapf028dl:/media/disk> ./a.out
Y= 5.1515149999999998
return Y/2 2.5757574999999999
result= -1.0579199790954590
user#bapf028dl:/media/disk> ifort return-test.f90
user#bapf028dl:/media/disk> ./a.out
Y= 5.15151500000000
return Y/2 2.57575750000000
result= 2.57575750350952
edit: It is really a bug. It gives a type error in gfortran 4.6 and 4.7.
Also I would recommend you to use a module for your functions. You have only one place to change.
This is not a bug. The interface body inside an interface block forms a separate scope, so you should include an implicit none statement there to prevent yourself from making such errors. Without it the implicit typing rules are in effect, so the function is expected to return a real.
interface
function givehalf(Y)
implicit none !<-- now you should get an error during compilation
double precision :: Y
!double precision :: givehalf !<-- Uncomment this line
end function givehalf
end interface