Consider the following excerpt from a student code
program pot
implicit none
real, allocatable :: tab(:,:)
integer :: m
read(*,*) m
allocate(tab(m,m))
call sub(tab)
contains
subroutine sub(tab)
real, intent(inout) :: tab(m,m)
integer :: m ! WRONG
print *, m, size(tab)
end subroutine sub
end program pot
The m
variable in sub
should be either passed as a dummy, intent(in)
argument or accessed by host association from main program. Intel Fortran reports an error:
$ ifx p.f90
p.f90(14): error #7157: This name has been incorrectly used in a specification expression of a contained procedure. [M]
integer :: m
---------------^
Gfortran, unfortunately, compiles the code silently, then giving somewhat strange output:
$ gfortran p.f90 && ./a.out
3
32610 9
so the m
variable has a random value, as expected, but tab(m,m)
shows its proper size, as passed from main program.
Interestingly, if one exchanges the declariation statements in sub
:
subroutine sub(tab)
integer :: m
real, intent(inout) :: tab(m,m)
gfortran reports an error (actually, two errors, for each m
):
p.f90:14:31:
14 | real, intent(inout) :: tab(m,m)
| 1
Error: Variable 'm' cannot appear in the expression at (1)
Any comments? Could that be possible (standard conforming), that the error/no-error condition depends on the order of declarations?