Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

implicit is not inherited by use. what else?

12 views
Skip to first unread message

The Star King

unread,
Sep 30, 2009, 2:15:23 PM9/30/09
to
The following code produces

1.00000

showing that implicit statements are not inherited from USEd modules.
But other things like variables and module procedures are inherited
(unless we use "private"). So, what other specifications are NOT
inherited from modules?

module implicit
implicit character (c)
end module implicit

program imptest

use implicit

c=1

print *,c

end program imptest

Richard Maine

unread,
Sep 30, 2009, 2:27:00 PM9/30/09
to
The Star King <j...@npl.co.uk> wrote:

> showing that implicit statements are not inherited from USEd modules.

Correct.

> But other things like variables and module procedures are inherited
> (unless we use "private"). So, what other specifications are NOT
> inherited from modules?

No specifications are accessed via USE. Nor are statements. Thinking of
it as accessing specifications or statements will lead you to numerous
errors, such as the one above. The only things accessed via USE are
identifiers. (Mostly that means names, but there are a few identifiers
that aren't names).

An implicit statement is not an identifier. Nor is the implicit mapping
defined by the implicit statements.

--
Richard Maine | Good judgment comes from experience;
email: last name at domain . net | experience comes from bad judgment.
domain: summertriangle | -- Mark Twain

The Star King

unread,
Sep 30, 2009, 2:48:15 PM9/30/09
to

Thanks for a quick reply! Can you tell me which identifiers are not
names?

So the things passed through use include
variables
contained subroutines
contained functions

anything else?

Richard Maine

unread,
Sep 30, 2009, 3:12:26 PM9/30/09
to
The Star King <j...@npl.co.uk> wrote:

> Thanks for a quick reply! Can you tell me which identifiers are not
> names?

The main ones that occur to me at the moment are operators, such as
.whatever.. Those don't count as names. A name in Fortran is a specific
syntactic form; operators have a different syntax.

>
> So the things passed through use include
> variables
> contained subroutines
> contained functions
>
> anything else?

Lots. An awful lot of things can have names. Let's correct the list
before extending it. There is no term "contained subroutine". I have
seen several people use that term, but it is not a standard term and it
leads to confusion. Internal procedures and module procedures are both
"contained" in that they follow CONTAINS statements, but they have very
different issues. In particular, no, internal procedures that might be
in the module cannot be accessed via USE; module procedures can. The
correct terms are "internal" and "module" rather than "contained".

Or, as long as we are on procedures, external or intrinsic procedures
can be accessed via USE of a module, provided they are appropriately
declared in the scope of the module. It is reasonably common to do this
as a way of providing an explicit interface for an external procedure.
Also generic procedures. In fact, just make it any kind of procedure
except for internal, dummy, or statement functions.

Parameters (named constants). No, those aren't variables.

Derived types. That's a very important category.

Namelist group names.

Hmm. Maybe I can find a list somewhere instead of trying to recall them
all.... Yep. There is is in the second para of 11.2.1 of f2003

"...named data objects, derived types, interface blocks, procedures,
abstract interfaces, generic identifiers, and namelist groups."

(I'm not quite sure why interface blocks are listed separately, as they
seem to be otherwise covered, and that's also nonparallel with the other
things listed as it is a piece of code - it would make more sense to me
to say the interfaces than the interface blocks).

My "operators" noted above are a subcategory of genetic identifiers.

nm...@cam.ac.uk

unread,
Sep 30, 2009, 3:17:19 PM9/30/09
to
In article <1j6uu7m.1wnykzgspgtf0N%nos...@see.signature>,

Richard Maine <nos...@see.signature> wrote:
>
>My "operators" noted above are a subcategory of genetic identifiers.

Fortran leads the way, again. The first language with support for
DNA computing :-)

I have always been good at making typos of that form - one valid
word in place of another.


Regards,
Nick Maclaren.

Richard Maine

unread,
Sep 30, 2009, 3:27:50 PM9/30/09
to
<nm...@cam.ac.uk> wrote:

> In article <1j6uu7m.1wnykzgspgtf0N%nos...@see.signature>,
> Richard Maine <nos...@see.signature> wrote:
> >
> >My "operators" noted above are a subcategory of genetic identifiers.
>
> Fortran leads the way, again. The first language with support for
> DNA computing :-)

Yep. Unlike names, each character in a genetic identifier is restricted
to be one of 4 letters. But there can be an awfully lot of them. :-)

The Star King

unread,
Sep 30, 2009, 3:54:19 PM9/30/09
to
On Sep 30, 8:27 pm, nos...@see.signature (Richard Maine) wrote:

Thanks! I look forward to using some of those genetic identifiers :-)

So, no specifications are accessed by use. But internal procedures do
gain access to their host's specifications. I assume this filters down
even to internal procedures in module procedures (trying to use the
right terminology!)

So:

module one
implicit none
contains
subroutine two
:
contains
subroutine three
:
end subroutine three
end subroutine two
end module one

Both subroutine two and subroutine three would have "implicit none"
active?

steve

unread,
Sep 30, 2009, 4:17:42 PM9/30/09
to

Yes. Most (all?) compilers will complain if an implicitly typed name
is found.

module jh
implicit none
contains
subroutine one
x = 1.
print *, x
call two
contains
subroutine two
y = 2.
print *, y
end subroutine two
end subroutine one
end module jh

troutmask:sgk[213] gfc4x -c jh.f90
jh.f90:5.8:

x = 1.
1
Error: Symbol 'x' at (1) has no IMPLICIT type
jh.f90:10.13:

y = 2.
1
Error: Symbol 'y' at (1) has no IMPLICIT type

James Van Buskirk

unread,
Sep 30, 2009, 5:03:23 PM9/30/09
to
"steve" <kar...@comcast.net> wrote in message
news:3dd7d393-188d-40e7...@m3g2000pri.googlegroups.com...

> troutmask:sgk[213] gfc4x -c jh.f90
> jh.f90:5.8:

> x = 1.
> 1
> Error: Symbol 'x' at (1) has no IMPLICIT type
> jh.f90:10.13:

> y = 2.
> 1
> Error: Symbol 'y' at (1) has no IMPLICIT type

But the IMPLICIT NONE acquired by host association can be overridden:

C:\gfortran\clf\implicit_override>type implicit_override.f90


module one
implicit none
contains
subroutine two

implicit character(4) (a)

write(*,'(a,i0)') 'In two: len(a) = ', len(a)
call three
contains
subroutine three
implicit character(6) (a)
write(*,'(a,i0)') 'In three: len(a) = ', len(a)


end subroutine three
end subroutine two
end module one

program zero
use one
implicit none

call two
end program zero

C:\gfortran\clf\implicit_override>gfortran -Wall
implicit_override.f90 -oimplici
t_override

C:\gfortran\clf\implicit_override>implicit_override
In two: len(a) = 4
In three: len(a) = 4

I Think the last line of output above is in error.
Oooh, maybe not. ifort gives the same output. OK, so I was wrong.
Let's change the line in question to:

write(*,'(a,i0)') 'In three: len(aa) = ', len(aa)

And we get:

C:\gfortran\clf\implicit_override>implicit_override
In two: len(a) = 4
In three: len(aa) = 6

Alternatively, adding the line

dimension a(1)

fixed the code because it created a new implicitly defined
array. In fact even adding it to both two and three fixed
the code. Shows one of the reasons why implicit typing is
so widely disliked, although it is necessary for template
code.

--
write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
6.0134700243160014d-154/),(/'x'/)); end


Richard Maine

unread,
Sep 30, 2009, 5:31:01 PM9/30/09
to
The Star King <j...@npl.co.uk> wrote:

> So, no specifications are accessed by use. But internal procedures do
> gain access to their host's specifications.

Not in general. They gain access to their host's identifiers. It really
is important that it is the identifiers - not some general notion of
getting access to the specifications. You should completely forget the
concept of accessing specifications; there isn't such a thing. Yes, the
distinction is critical. For example, consider the specification

real :: x

If one somehow gained acess to just that specification, then one could
presumably add other compatible specifications, such as

dimension :: x(10)

or any number of others. It doesn't work that way. What you gain access
to is the name x (and thus whatever that name represents) - not the
specification.

I happen to dislike the way that Fortran allows the specifications for a
single name to be spread out all over the place. It means you can't look
at something like the real::x statement above and be sure that you now
know what there is to know about x. You have to search all the
specifications to see if anything else might have added something that
completely changes things. But that's been in Fortran forever.

Yes, implicit mappings are also passed down from the host (but not
accessed via USE). These are not identifiers, it is true. But again, it
is wrong to think of it as the implicit specification being passed down.
What gets passed down is not the specification, but the mapping that
results from that specification.

Yes, again, it does make a difference. As James noted, you can override
the mapping by a respecification in the inner scope. If the
specification itself were passed down, you wouldn't be able to do that.
(Of course, I really, really recommend against that kind of mess anyway.
Implicit typing is bad enough in general, but when you start messing
with it like that, it becomes horrible.)

> I assume this filters down
> even to internal procedures in module procedures (trying to use the
> right terminology!)

[code elided]

> Both subroutine two and subroutine three would have "implicit none"
> active?

Correct. The one place it does not go into, however, is interface
bodies. I find that confusing and inconsistent. But that's the way it
is.

(At least, that's the way it was after an interpretation request changed
f90 to be that way. I happen to think that was a misuse of the
interpretation process. The f90 standard clearly and unambiguously said
otherwise, even giving examples. There was no internal contradiction
involved. But J3 used the interpretation process to change its mind
about that behavior. A lot of mess has resulted since - turns out that
you badly need host association into interface bodies for somethings.
The IMPORT statement got added as a workaround, but I personally see it
as just a workaround for a broken design. Well, that's about host
association, which isn't quite the same thing as how the implicit
mappings get inherited, but it is closely related.)

Richard Maine

unread,
Sep 30, 2009, 5:32:57 PM9/30/09
to
steve <kar...@comcast.net> wrote:

> On Sep 30, 12:54 pm, The Star King <j...@npl.co.uk> wrote:

[code elided]


> > Both subroutine two and subroutine three would have "implicit none"
> > active?
>
> Yes. Most (all?) compilers will complain if an implicitly typed name
> is found.

More fundamentally, that's what the standard says. It isn't just a
coincidence that all compilers happen to do this.

The Star King

unread,
Oct 1, 2009, 5:34:27 AM10/1/09
to

Richard,

Thanks for such a comprehensive reply. This is very helpful info.
REally it seems like the implicit none statement (only recommended use
of the command!) is the only thing that gets inherited in internal
subprograms but NOT through USE statements. Anyway this seems like a
sensible enough rule of thumb.

James, your code example,

module one
implicit none
contains
subroutine two

implicit character(4) (a)


write(*,'(a,i0)') 'In two: len(a) = ', len(a)
call three
contains
subroutine three
implicit character(6) (a)
write(*,'(a,i0)') 'In three: len(a) = ', len(a)

end subroutine three
end subroutine two
end module one

shows how implicit is partlicarly dangerous in internal subprograms.
Unless "a" is declared explicitly in three, references to "a" will
refer to the outer-scope version. You could then set a thinking you
are setting local variable and end up setting an outer-scope variable
instead. This is why I never use internal subprograms, its too
confusing to know which variable you are actually using. If internal
subprograms are used, I would say recommend using different-named
variables for all locals.

James, you said

> Shows one of the reasons why implicit typing is
> so widely disliked, although it is necessary for template code.

Why is implicit necessary for template code. Does this mean it has a
legitimate use?!

James Van Buskirk

unread,
Oct 1, 2009, 1:54:38 PM10/1/09
to
"The Star King" <j...@npl.co.uk> wrote in message
news:99ec36bf-39f1-43d4...@z24g2000yqb.googlegroups.com...

> James, you said

> > Shows one of the reasons why implicit typing is
> > so widely disliked, although it is necessary for template code.

> Why is implicit necessary for template code. Does this mean it has a
> legitimate use?!

Well, how about:

C:\gfortran\clf\heapsort>type heapsort.i90
subroutine heapsort_template(Qarray,N)
integer N
dimension Qarray(N)
integer i
integer current
integer parent
integer left_child, right_child

do i = 1, N
current = i
percolate_up: do
parent = current/2
if(parent <= 0) exit percolate_up
if(Qarray(current) <= Qarray(parent)) exit percolate_up
Qarray(parent:current:current-parent) = &
Qarray((/current,parent/))
current = parent
end do percolate_up
end do
do i = N, 2, -1
Qarray(1:i:i-1) = Qarray((/i,1/))
current = 1
percolate_down: do
left_child = 2*current
if(left_child >= i) exit percolate_down
right_child = 2*current+1
if(right_child < i) then
if(Qarray(right_child) <= Qarray(left_child)) then
if(Qarray(left_child) <= Qarray(current)) exit &
percolate_down
Qarray(current:left_child:left_child-current) = &
Qarray((/left_child,current/))
current = left_child
else
if(Qarray(right_child) <= Qarray(current)) exit &
percolate_down
Qarray(current:right_child:right_child-current) = &
Qarray((/right_child,current/))
current = right_child
end if
else
if(Qarray(left_child) <= Qarray(current)) exit &
percolate_down
Qarray(current:left_child:left_child-current) = &
Qarray((/left_child,current/))
current = left_child
end if
end do percolate_down
end do
end subroutine heapsort_template

C:\gfortran\clf\heapsort>type test.f90
module int_mod
implicit integer(Q)
private
public heapsort
interface heapsort
module procedure heapsort_template
end interface heapsort
contains
include "heapsort.i90"
end module int_mod

module real_mod
implicit real(Q)
private
public heapsort
interface heapsort
module procedure heapsort_template
end interface heapsort
contains
include "heapsort.i90"
end module real_mod

module char_mod
implicit character(len=*) (Q)
private
public heapsort
interface heapsort
module procedure heapsort_template
end interface heapsort
contains
include "heapsort.i90"
end module char_mod

module typedefs
implicit none
private
public mytype, assignment(=), operator(<=)
type mytype
integer key
character(5) data
end type mytype
interface assignment(=)
module procedure assign
end interface assignment(=)
interface operator(<=)
module procedure less_or_equals
end interface operator(<=)
contains
elemental subroutine assign(x,y)
type(mytype), intent(out) :: x
type(mytype), intent(in) :: y

x%key = y%key
x%data = y%data
end subroutine assign

function less_or_equals(x,y)
logical less_or_equals
type(mytype), intent(in) :: x, y

less_or_equals = x%key <= y%key
end function less_or_equals
end module typedefs

module type_mod
use typedefs
implicit type(mytype) (Q)
private
public heapsort
interface heapsort
module procedure heapsort_template
end interface heapsort
contains
include "heapsort.i90"
end module type_mod

module generic_recombination
use int_mod
use real_mod
use char_mod
use type_mod
implicit none
end module generic_recombination

program test
use generic_recombination
use typedefs
implicit none
integer Iarray(10)
character(80) fmt
real Rarray(10)
character(5) Carray(9)
integer i
type(mytype) Tarray(9)

Iarray = (/2,4,8,5,10,9,7,3,6,1/)
write(fmt,'(a,i0,a)') '(a,',size(Iarray),'(i0:1x))'
write(*,fmt) 'Before heapsort, Iarray = ',Iarray
call heapsort(Iarray,size(Iarray))
write(*,fmt) 'After heapsort, Iarray = ',Iarray

write(*,'()')
Rarray = (/8,9,6,4,10,3,2,5,7,1/)
write(fmt,'(a,i0,a)') '(a,',size(Rarray),'(f0.1:1x))'
write(*,fmt) 'Before heapsort, Rarray = ',Rarray
call heapsort(Rarray,size(Rarray))
write(*,fmt) 'After heapsort, Rarray = ',Rarray

write(*,'()')
Carray = (/character(len(Carray))::'The','quick','brown', &
'fox','jumps','over','the','lazy','dog'/)
write(fmt,'(a,i0,a)') '(a,',size(Carray),'(a:1x))'
write(*,fmt) 'Before heapsort, Carray = ', &
(trim(Carray(i)),i=1,size(Carray))
call heapsort(Carray,size(Carray))
write(*,fmt) 'After heapsort, Carray = ', &
(trim(Carray(i)),i=1,size(Carray))

write(*,'()')
Tarray = (/mytype(1,'The'),mytype(3,'brown'),mytype(9,'dog'), &
mytype(4,'fox'),mytype(5,'jumps'),mytype(8,'lazy'), &
mytype(6,'over'),mytype(2,'quick'),mytype(7,'the')/)
write(fmt,'(a,i0,a)') '(a,',size(Carray),'(i0,1x,a:1x))'
write(*,fmt) 'Before heapsort, Tarray = ', &
(Tarray(i)%key,trim(Tarray(i)%data),i=1,size(Tarray))
call heapsort(Tarray,size(Tarray))
write(*,fmt) 'after heapsort, Tarray = ', &
(Tarray(i)%key,trim(Tarray(i)%data),i=1,size(Tarray))
end program test

C:\gfortran\clf\heapsort>gfortran test.f90 -otest

C:\gfortran\clf\heapsort>test
Before heapsort, Iarray = 2 4 8 5 10 9 7 3 6 1
After heapsort, Iarray = 1 2 3 4 5 6 7 8 9 10

Before heapsort, Rarray = 8.0 9.0 6.0 4.0 10.0 3.0 2.0 5.0 7.0 1.0
After heapsort, Rarray = 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0

Before heapsort, Carray = The quick brown fox jumps over the lazy dog
After heapsort, Carray = The brown dog fox jumps lazy over quick the

Before heapsort, Tarray = 1 The 3 brown 9 dog 4 fox 5 jumps 8 lazy 6 over 2
quic
k 7 the
after heapsort, Tarray = 1 The 2 quick 3 brown 4 fox 5 jumps 6 over 7 the 8
lazy
9 dog

How are you going to do that without implicit typing? Also I find
that implicit typing can be good for automatically generated code
with lots of variables because the hugh list of declarations of more
or less meaningless variables doesn't help the machine to understand
the code it's generating.

0 new messages