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.
Related
I'm trying to learn Fortran (unfortunately a necessity for my research group) - one of the tasks I set myself was to package one of the necessary functions (Associated Legendre polynomials) from the Numerical Recipes book into a fortran 03 compliant module. The original program (f77) has some error handling in the form of the following:
if(m.lt.0.or.m.gt.1.or.abs(x).gt.1)pause 'bad arguments in plgndr'
Pause seems to have been deprecated since f77 as using this line gives me a compiling error, so I tried the following:
module sha_helper
implicit none
public :: plgndr, factorial!, ylm
contains
! numerical recipes Associated Legendre Polynomials rewritten for f03
function plgndr(l,m,x) result(res_plgndr)
integer, intent(in) :: l, m
real, intent(in) :: x
real :: res_plgndr, fact, pll, pmm, pmmp1, somx2
integer :: i,ll
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
res_plgndr=-10e6 !return a ridiculous value
else
pmm = 1.
if (m.gt.0) then
somx2 = sqrt((1.-x)*(1.+x))
fact = 1.
do i = 1, m
pmm = -pmm*fact*somx2
fact = fact+2
end do
end if
if (l.eq.m) then
res_plgndr = pmm
else
pmmp1 = x*(2*m+1)*pmm
if(l.eq.m+1) then
res_plgndr = pmmp1
else
do ll = m+2, l
pll = (x*(2*ll-1)*pmmp1-(ll+m-1)*pmm)/(ll-m)
pmm = pmmp1
pmmp1 = pll
end do
res_plgndr = pll
end if
end if
end if
end function plgndr
recursive function factorial(n) result(factorial_result)
integer, intent(in) :: n
integer, parameter :: RegInt_K = selected_int_kind(20) !should be enough for the factorials I am using
integer (kind = RegInt_K) :: factorial_result
if (n <= 0) then
factorial_result = 1
else
factorial_result = n * factorial(n-1)
end if
end function factorial
! function ylm(l,m,theta,phi) result(res_ylm)
! integer, intent(in) :: l, m
! real, intent(in) :: theta, phi
! real :: res_ylm, front_block
! real, parameter :: pi = 3.1415926536
! front_block = sqrt((2*l+1)*factorial(l-abs(m))/(4*pi*))
! end function ylm
end module sha_helper
The main code after the else works, but if I execute my main program and call the function with bad values, the program freezes before executing the print statement. I know that the print statement is the problem, as commenting it out allows the function to execute normally, returning -10e6 as the value. Ideally, I would like the program to crash after giving a user readable error message, as giving bad values to the plgndr function is a fatal error for the program. The function plgndr is being used by the program sha_lmc. Currently all this does is read some arrays and then print a value of plgndr for testing (early days). The function ylm in the module sha_helper is also not finished, hence it is commented out. The code compiles using gfortran sha_helper.f03 sha_lmc.f03 -o sha_lmc, and
gfortran --version
GNU Fortran (GCC) 4.8.2
!Spherical Harmonic Bayesian Analysis testbed for Lagrangian Dynamical Monte Carlo
program sha_analysis
use sha_helper
implicit none
!Analysis Parameters
integer, parameter :: harm_order = 6
integer, parameter :: harm_array_length = (harm_order+1)**2
real, parameter :: coeff_lo = -0.1, coeff_hi = 0.1, data_err = 0.01 !for now, data_err fixed rather than heirarchical
!Monte Carlo Parameters
integer, parameter :: run = 100000, burn = 50000, thin = 100
real, parameter :: L = 1.0, e = 1.0
!Variables needed by the program
integer :: points, r, h, p, counter = 1
real, dimension(:), allocatable :: x, y, z
real, dimension(harm_array_length) :: l_index_list, m_index_list
real, dimension(:,:), allocatable :: g_matrix
!Open the file, allocate the x,y,z arrays and read the file
open(1, file = 'Average_H_M_C_PcP_boschi_1200.xyz', status = 'old')
read(1,*) points
allocate(x(points))
allocate(y(points))
allocate(z(points))
print *, "Number of Points: ", points
readloop: do r = 1, points
read(1,*) x(r), y(r), z(r)
end do readloop
!Set up the forwards model
allocate(g_matrix(harm_array_length,points))
!Generate the l and m values of spherical harmonics
hloop: do h = 0, harm_order
ploop: do p = -h,h
l_index_list(counter) = h
m_index_list(counter) = p
counter = counter + 1
end do ploop
end do hloop
print *, plgndr(1,2,0.1)
!print *, ylm(1,1,0.1,0.1)
end program sha_analysis
Your program does what is known as recursive IO - the initial call to plgndr is in the output item list of an IO statement (a print statement) [directing output to the console] - inside that function you then also attempt to execute another IO statement [that outputs to the console]. This is not permitted - see 9.11p2 and p3 of F2003 or 9.12p2 of F2008.
A solution is to separate the function invocation from the io statement in the main program, i.e.
REAL :: a_temporary
...
a_temporary = plgndr(1,2,0.1)
PRINT *, a_temporary
Other alternatives in F2008 (but not F2003 - hence the [ ] parts in the first paragraph) include directing the output from the function to a different logical unit (note that WRITE (*, ... and PRINT ... reference the same unit).
In F2008 you could also replace the WRITE statement with a STOP statement with a message (the message must be a constant - which wouldn't let you report the problematic values).
The potential for inadvertently invoking recursive IO is part of the reason that some programming styles discourage conducting IO in functions.
Try:
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
stop
else
...
end if
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
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$
I'm trying to understand why one of the below is allowed by the standard while the other is not. They don't seem different except for boilerplate code to me. I feel like I'm misunderstanding something, or that there is a better way of doing it. Any help would be appreciated.
Not allowed:
real :: x
class(*) :: temp
x = 4
temp = genericAssignment(x)
select type(temp)
type is(real)
write(*,*) temp
end select
contains
function genericAssignment(a) result(b)
class(*) :: a
class(*) :: b
allocate(b, source=a)
end function genericAssignment
Allowed:
Type GenericContainer
class(*), pointer :: gen
End Type
real :: x
class(*) :: ptr
type(GenericContainer) :: temp
x = 4
temp = genericAssignment(x)
select type(ptr => temp%gen)
type is(real)
write(*,*) ptr
end select
contains
function genericAssignment(a) result(b)
class(*) :: a
type(GenericContainer) :: b
allocate(b%gen, source=a)
end function genericAssignment
The current standard allows both.
The "allowed" code block has a function with a non-polymorphic result, with the result of evaluating the function being assigned to a non-polymorphic variable. This is valid Fortran 2003.
The "not allowed" block has a function with a polymorphic result, with the result of evaluating the function being assigned to a polymorphic variable. This is valid Fortran 2008.
Note that the number of complete Fortran 2008 compiler implementations out there is small.
~~~
The function in the "not allowed" block is somewhat pointless - the code block is equivalent to:
real :: x
class(*) :: temp
x = 4
temp = x
select type(temp)
type is(real)
write(*,*) temp
end select
I created a fortran 90 program that I used on a linux machine and compiled using gfortran. It worked fine on the linux machine with gfortran but provides the error
error 327 - In the INTERFACE to SECANTMETHOD (from MODULE SECMETH), the ninth dummy argument (F) was of type REAL(KIND=2) FUNCTION, whereas the actual argument is of type REAL(KIND=2)
when using the Plato compiler (FTN95). Does anyone know how I would need to change my code to work in Plato? I tried to read up on this error and there was some mention of pointers but from what I tried that did not work. I have figured out some workarounds but they make it so that the subroutine can no longer accept any function as an argument - which is pretty much useless. Any help would be greatly appreciated. My code is below.
!--! A module to define a real number precision.
module types
integer, parameter :: dp=selected_real_kind(15)
end module types
module secFuncs
contains
function colebrookWhite(T)
use types
real(dp) :: colebrookWhite
real(dp), intent(in) :: T
colebrookwhite=25-T**2
return
end function colebrookWhite
end module secFuncs
module secMeth
contains
subroutine secantMethod(xolder,xold,xnew,epsi1,epsi2,maxit,exitFlag,numit,f)
use types
use secFuncs
implicit none
interface
function f(T)
use types
real(dp) :: f
real(dp), intent(in) :: T
end function f
end interface
real(dp), intent(in) :: epsi1, epsi2
real(dp), intent(inout) :: xolder, xold
real(dp), intent(out) :: xnew
integer, intent(in) :: maxit
integer, intent(out) :: numit, exitFlag
real(dp) :: fxold, fxolder, fxnew
integer :: i
fxolder = f(xolder)
fxold = f(xold)
i = 0
do
i = i + 1
xnew = xold - fxold*(xold-xolder)/(fxold-fxolder)
fxnew = f(xnew)
if (i == maxit) then
exitFlag = 1
numit = i
return
else if (abs(fxnew) < epsi1) then
exitFlag = 2
numit = i
return
else if (abs(xnew - xold) < epsi2) then
exitFlag = 3
numit = i
return
end if
xolder = xold
xold = xnew
fxolder = fxold
fxold = fxnew
end do
end subroutine secantMethod
end module secMeth
program secantRoots
use types
use secMeth
use secFuncs
implicit none
real(dp) :: x1, x2, xfinal, epsi1, epsi2
integer :: ioerror, maxit, numit, exitFlag
do
write(*,'(A)',advance="no")"Please enter two initial root estimates, 2epsi's, and maxit: "
read(*,*,iostat=ioerror) x1, x2, epsi1, epsi2, maxit
if (ioerror /= 0) then
write(*,*)"Invalid input."
else
exit
end if
end do
call secantMethod(x1,x2,xfinal,epsi1,epsi2,maxit,exitFlag,numit,colebrookWhite)
if (exitFlag == 1) then
write(*,*)"The maximum number of iterations was reached."
else if (exitFlag == 2) then
write(*,'(a,f5.3,a,i3,a)')"The root is ", xfinal, ", which was reached in ", numit, " iterations."
else if (exitFlag == 3) then
write(*,'(a,i3,a)')"There is slow or no progress at ", numit, " iterations."
end if
end program secantRoots
Current gfortran detects the error in the call to the secantMethod procedure, where you have parentheses, but no argument list, following the colebrookWhite function name.
If you want to pass a function as an argument (as opposed to the result of evaluating a function), which is what you want to do here, you do not follow the function name with a parenthesis pair.
call secantMethod(x1,x2,xfinal,epsi1,epsi2,maxit,exitFlag,numit,colebrookWhite )
! ^
I ended up just switching from Plato to Geany IDE (I actually like Geany WAY better now that I've used it for a couple hours), setting up gfortran with Geany, and the code works with that setup. I'm guessing the reason I'm getting the error with Plato is that its compiler is actually a fortran95 compiler while gfortran is a fortran90 compiler. It took a while to get everything working but once I downloaded mingw-w64 for gfortran and set the path user (not system) environment variable to the correct location everything works great. I would still be interested in seeing if there is a way to get the code working with the FTN95 compiler, but in the end I'm still sticking with gfortran and Geany.