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

Assumed Size VS Assumed Shape Array

24 views
Skip to first unread message

topvis

unread,
Aug 30, 2002, 10:39:47 PM8/30/02
to
Could anyone told me the differnce between:

REAL:: A(:) and REAL:: A(*)

Where A is a parameter of a subroutine.

When the rank of A is 1, I think they are the same. Am I right?

Thanks!
Topvis


James Van Buskirk

unread,
Aug 31, 2002, 12:44:23 AM8/31/02
to

"topvis" <top...@163.com> wrote in message
news:akpaaj$1kenmf$1...@ID-155171.news.dfncis.de...

No. First example to show some differences:

module all_my_functions
implicit none
contains
subroutine sub1(A)
real A(:)

write(*,*) ' size(A) = ', size(A)
write(*,*) ' shape(A) = ', shape(A)
write(*,*) ' ubound(A) = ', ubound(A)
write(*,*) ' sum(A) = ', sum(A)
write(*,*) A(::2)
call sub3(A)
call sub4(A(1)) ! Illegal because A does not form a sequence
! of elements
end subroutine sub1

subroutine sub2(A)
real A(*)
real, pointer :: p(:)

write(*,*) ' size(A) = ', size(A) ! Illegal because A has
! no size
write(*,*) ' shape(A) = ', shape(A) ! Illegal because A has
! no shape
write(*,*) ' ubound(A) = ', ubound(A) ! Illegal because A has
! no upper bound
write(*,*) ' sum(A) = ', sum(A) ! Transformational
! intrinsic also illegal
write(*,*) A(::2) ! Illegal because A has no upper bound
call sub3(A) ! Elemental call also illegal
call sub4(A(1))
end subroutine sub2

elemental subroutine sub3(B)
real, intent(out) :: B

B = 1
end subroutine sub3

subroutine sub4(B)
real B(*)

write(*,*) ' B(1) = ', B(1)
end subroutine sub4
end module all_my_functions

program main
use all_my_functions
implicit none
real A(10)
integer i

A = (/(i,i=1,size(A))/)
call sub1(A(::2)) ! No copy-in/copy out
call sub2(A(::2)) ! Copy-in/copy out required
end program main

Curiously, CVF 6.6A only yields 5 error messages here instead
of 7. (Well 6 instead of 8, but one is a compound error.) Should I
get up the energy to compose a bug report?

Another example, this time with pointer association:

module all_my_functions_2
implicit none
contains
subroutine sub10(A, p)
real, target :: A(:)
real, pointer :: p

p => A(1)
end subroutine sub10

subroutine sub11(A, p)
real, target :: A(*)
real, pointer :: p

p => A(1)
end subroutine sub11
end module all_my_functions_2

subroutine sub12(A)
real A(:)

A = 1
end subroutine sub12

program main_2
use all_my_functions_2
implicit none
real, target :: A(10)
real, pointer :: p

call sub10(A(::2), p)
write(*,*) ' Associated(p,A(1)) = ', associated(p,A(1))
call sub11(A(::2), p)
write(*,*) ' Associated(p,A(1)) = ', associated(p,A(1))
! call sub10(A) ! Would be illegal because of lack of explicit
! interface
end program main_2

Output:

Associated(p,A(1)) = T
Associated(p,A(1)) = F

We see that p remains associated with A(1) on return from
subroutine sub10 because an assumed shape dummy is a reference
handle for the actual argument, as long as it doesn't have
a vector subscript. p does not remain associated with A(1)
on return from subroutine sub11 because the discontiguous
array section had to be copied into a contiguous temporary
on invocation which has copied back to A(::2) on return
while p, still pointing at the copy, had undefined
association status on return. Also if you uncommented the
call of sub12 you would find that it wouldn't give any
expected results due to the omission of an explicit
interface which is always required when one of the dummy
arguments has assumed shape.

Ron Shepard

unread,
Aug 31, 2002, 2:25:14 AM8/31/02
to
In article <akpaaj$1kenmf$1...@ID-155171.news.dfncis.de>,
"topvis" <top...@163.com> wrote:

No. The former requires an explicit interface visible in the calling
subprogram, the latter doesn't. In the former, you can determine the
size of the array A, in the latter you can't. With the former, you can
get the compiler to tell you at compile time if you called the
subroutine with an actual argument of incorrect shape, with the latter
declaration you can't.

$.02 -Ron Shepard

Richard Maine

unread,
Aug 31, 2002, 2:30:49 AM8/31/02
to
"topvis" <top...@163.com> writes:

No. The basic concepts have a critical difference, which then
manifests itself in numerous ways. The basic difference is that
wth assumed size (The A(*) form), the compiler passes no information
about A other than its starting location. This means that

1. You can't do anything that depends on the compiler knowing the
size of A. It doesn't. For example, you can't do whole array
operations or such things as "write (...) A".

2. The actual argument either essentially needs to be contiguous.
I say essentially because you can pass a non-contiguous actual
argument, but only because the compiler will make a contiguous
copy behind your back.

With assumed shape, the compiler passes information about the array
shape for you. This means

1. You can do whole array operations.

2. The actual argument doesn't need to be contiguous, as the
information passed by the compiler includes the stride
information necessary to access non-contiguous slices.

3. A *VERY* important point. The compiler has to know about this
when compiling the *CALLING* subroutine. This means that the
interface of the callee *MUST* be explicit in the caller.
Otherwise, the compiler won't know to pass the necessary
information, which can result in all kinds of strange symptoms.

There are many other secondary differences, for example in
performance implications, but the above are basics to start with.

--
Richard Maine
email: my last name at domain
domain: isomedia dot com

Pearu Peterson

unread,
Aug 31, 2002, 5:22:21 AM8/31/02
to

On 30 Aug 2002, Richard Maine wrote:

> "topvis" <top...@163.com> writes:
>
> > Could anyone told me the differnce between:
> >
> > REAL:: A(:) and REAL:: A(*)
> >
> > Where A is a parameter of a subroutine.
> >
> > When the rank of A is 1, I think they are the same. Am I right?
>
> No. The basic concepts have a critical difference, which then
> manifests itself in numerous ways. The basic difference is that
> wth assumed size (The A(*) form), the compiler passes no information
> about A other than its starting location. This means that

<snip>

> With assumed shape, the compiler passes information about the array
> shape for you. This means
>
> 1. You can do whole array operations.
>
> 2. The actual argument doesn't need to be contiguous, as the
> information passed by the compiler includes the stride
> information necessary to access non-contiguous slices.
>
> 3. A *VERY* important point. The compiler has to know about this
> when compiling the *CALLING* subroutine. This means that the
> interface of the callee *MUST* be explicit in the caller.
> Otherwise, the compiler won't know to pass the necessary
> information, which can result in all kinds of strange symptoms.

Is there any source of information available about the specification of
the interface for assumed shape arrays? In particular, I am interested in
constructiong assumed shape arrays in C in order to pass them to Fortran
functions.

I have been searching the ways to do that for years for the f2py program
but have found no good solutions. Currently the working solution
is to use an intermediate Fortran subroutine, say,

subroutine foo_wrap(a,n)
integer n
real a(n)
call foo(a)
end

for calling the following Fortran subroutine from C

subroutine foo(a)
real a(:)
! do stuff
end subroutine

So, is there any way to call foo(a) directly from C (to avoid
the usage of foo_wrap(a,n))? As I understand it, it would mean
constructing the argument a in a proper way, right? But how?
Any bits of information are most welcome.

Pearu

Steve Lionel

unread,
Aug 31, 2002, 9:04:24 AM8/31/02
to
"Pearu Peterson" <pe...@cens.ioc.ee> wrote in message
news:Pine.LNX.4.21.020831...@cens.kybi...

> Is there any source of information available about the specification of
> the interface for assumed shape arrays? In particular, I am interested in
> constructiong assumed shape arrays in C in order to pass them to Fortran
> functions.

This is compiler-specific. Check the documentation for the Fortran compiler
you are using. Compaq Fortran documents this in the User Manual (or
Programmer's Guide) chapter on mixed-language programming. Note that for
multi-platform compilers (such as Compaq Fortran), the interface may vary by
platform. (For example, on OpenVMS, Compaq Fortran uses the OpenVMS calling
standard "class NCA" descriptor.)

--

Steve Lionel
Software Products Division
Intel Corporation
Nashua, NH

Compaq Fortran - http://www.compaq.com/fortran
Intel Fortran - http://developer.intel.com/software/products/compilers/f60/

Richard Maine

unread,
Aug 31, 2002, 12:16:22 PM8/31/02
to
Pearu Peterson <pe...@cens.ioc.ee> writes:

> On 30 Aug 2002, Richard Maine wrote:

> > With assumed shape, the compiler passes information about the array

> > shape for you....

> Is there any source of information available about the specification of
> the interface for assumed shape arrays? In particular, I am interested in
> constructiong assumed shape arrays in C in order to pass them to Fortran
> functions.

That is compiler-dependent. Some compilers have documentation of the
details, but they *DO* vary from one compiler to another; don't assume
portability of such a thing.

> Currently the working solution
> is to use an intermediate Fortran subroutine,...
[example elided]

That's what I do. I know of no better way that is portable. Although
you can find the underlying details for some compilers, either by
reading their docs or by reverse engineering, I've yet to have an
application where I thought this bought me enough to be worth the
portability problems.

Bil Kleb

unread,
Aug 31, 2002, 12:32:29 PM8/31/02
to
Richard Maine wrote:
>
> "topvis" <top...@163.com> writes:
>
> > Could anyone told me the differnce between:
> >
> > REAL:: A(:) and REAL:: A(*)
>
> [..]

>
> There are many other secondary differences, for example in
> performance implications, but the above are basics to start with.

I just happened to collect some *preliminary* performance numbers
last week. The intent was to examine the relative performance
of using arrays accessed by various methods, i.e., through argument
lists with assumed size, assumed shape, and derived types; and accessed
via module data. The numbers are elapsed time normalized by that
required by the assumed size arrays.

For the IO tests I am merely reading data from disk and for the work
tests I am doing operations typical of our main code base. These
results are for arrays of 200,000 elements, but the trends are similar
for larger arrays. Both real and integer arrays are used. Default
compiler settings were used, i.e., no flags, and the data represents
the average of ten separate runs.

Lahey/Fujitsu lf95 compiler on i686/Linux:

IO tests:
Assumed-size: 1.00000000
Assumed-shape: 1.16666639
Use Module: 8.08333492
Derived type: 8.49999809
Work tests:
Assumed-size: 1.00000000
Assumed-shape: 1.04831302
Use Module: 1.06288338
Derived type: 1.05291426

Absoft f95 compiler on i686/Linux:

IO tests:
Assumed-size: 1.00000
Assumed-shape: 1.02256
Use Module: 1.03008
Derived type: 1.00000
Work tests:
Assumed-size: 1.00000
Assumed-shape: 1.12665
Use Module: 1.14474
Derived type: 1.18421

Intel ifc compiler on i686/Linux:

IO tests:
Assumed-size: 1.000000
Assumed-shape: 0.9444444
Use Module: 1.055556
Derived type: 1.111111
Work tests:
Assumed-size: 1.000000
Assumed-shape: 1.131188
Use Module: 1.138614
Derived type: 1.121287

NAG f95 compiler i686/Linux:

IO tests:
Assumed-size: 1.0000000
Assumed-shape: 1.0326086
Use Module: 1.0217385
Derived type: 1.2282608
Work tests:
-Abort-

NA Software f95 compiler i686/Linux:

IO tests:
Assumed-size: 1.000000
Assumed-shape: 0.9947917
Use Module: 1.015625
Derived type: 1.031250
Work tests:
Assumed-size: 1.000000
Assumed-shape: 0.8864198
Use Module: 0.8930864
Derived type: 1.074815

Portland pgf90 compiler on i686/Linux:

IO tests:
Assumed-size: -nan
Assumed-shape: -nan
Use Module: -nan
Derived type: -nan
Work tests:
Assumed-size: 1.000000
Assumed-shape: 1.055556
Use Module: 1.166667
Derived type: 1.277778

SGI f90 compiler iris4d/Linux:

IO tests:
Assumed-size: 1.
Assumed-shape: 33.0572739
Use Module: 36.2234993
Derived type: 33.699028
Work tests:
Assumed-size: 1.
Assumed-shape: 1.22804034
Use Module: 1.33691001
Derived type: 1.27308822

Compaq fort compiler on alpha/Linux:

IO tests:
Assumed-size: 1.000000
Assumed-shape: 1.010757
Use Module: 1.000001
Derived type: 6.494653
Work tests:
-Abort-

Sun f95 compiler on sun4u/SunOS

IO tests:
Assumed-size: 1.0
Assumed-shape: 1.044771
Use Module: 1.0526927
Derived type: 1.0494714
Work tests:
Assumed-size: 1.0
Assumed-shape: 1.0914603
Use Module: 1.0350938
Derived type: 1.1422796

As you can see, I'm having some troubles with Portland's
implementation of cpu_time as well as my "work" tests for
the NAG and Compaq compilers. And, until a recent update
to our SGI compiler, it was giving numbers in the hundreds
for anything but assumed-size!

If there is interest I can post the code I'm using. I would
appreciate any suggestions/criticisms.

--
Bil Kleb
NASA Langley Research Center
Hampton, Virginia, USA

Richard Maine

unread,
Sep 1, 2002, 1:21:05 PM9/1/02
to
Bil Kleb <W.L....@LaRC.NASA.Gov> writes:

> As you can see, I'm having some troubles with Portland's
> implementation of cpu_time as well as my "work" tests for
> the NAG and Compaq compilers. And, until a recent update
> to our SGI compiler, it was giving numbers in the hundreds
> for anything but assumed-size!
>
> If there is interest I can post the code I'm using. I would
> appreciate any suggestions/criticisms.

Yes, I'd be interested if the code isn't unreasonably large to post.
Mostly I'm curious to track down why NAG is aborting on it; I
don't have enough data to guess intelligently right now. I've
got the NAG compiler, so I should be able to experiment with it
if I can see the code.

Bil Kleb

unread,
Sep 1, 2002, 9:15:46 PM9/1/02
to
Richard Maine wrote:

>
> Bil Kleb <W.L....@LaRC.NASA.Gov> writes:
>
> > If there is interest I can post the code I'm using. I would
> > appreciate any suggestions/criticisms.
>
> Yes, I'd be interested if the code isn't unreasonably large to post.

It could certainly use an overhaul, but here it is warts and all...

Thanks in advance,


--
Bil Kleb
NASA Langley Research Center
Hampton, Virginia, USA

! $Id: test_array_storage_performance.f90,v 1.4 2002/09/02 01:23:38 kleb Exp $
!
! Preliminary stab at testing the relative performance of various
! array types: through argument lists as assumed-size, assumed shape,
! and derived type; and via module data.

module kind_definitions

integer, parameter :: iKind = selected_int_kind(r=8)
integer, parameter :: rKind = selected_real_kind(p=15)

end module kind_definitions


module module_data

use kind_definitions, only: iKind, rKind

implicit none
integer(iKind), dimension(:), pointer, save :: module_data_array_int
real(rKind), dimension(:), pointer, save :: module_data_array_real

end module module_data


module type_definition

use kind_definitions, only: iKind, rKind

implicit none

type derived
integer(iKind), dimension(:), pointer :: component_array_int
real(rKind), dimension(:), pointer :: component_array_real
end type derived

end module type_definition


module test_various_array_types

use kind_definitions, only: iKind, rKind
use type_definition, only: derived
use module_data, only: module_data_array_int, module_data_array_real

implicit none

integer, save :: number_of_tests = 0
real, save :: assumed_size_time = 0.0
real, save :: assumed_shape_time = 0.0
real, save :: module_data_time = 0.0
real, save :: derived_type_time = 0.0

contains

subroutine reset_counters()
number_of_tests = 0
assumed_size_time = 0.0
assumed_shape_time = 0.0
module_data_time = 0.0
derived_type_time = 0.0
end subroutine reset_counters

subroutine read_array_types(logical_unit, array_size, &
assumed_size_array_int, assumed_size_array_real, &
assumed_shape_array_int, assumed_shape_array_real,&
derived_type)

integer, intent(in) :: logical_unit
integer, intent(in) :: array_size

integer(iKind),dimension(array_size), intent(inout):: assumed_size_array_int
real(rKind), dimension(array_size), intent(inout):: assumed_size_array_real

integer(iKind), dimension(:), intent(inout) :: assumed_shape_array_int
real(rKind), dimension(:), intent(inout) :: assumed_shape_array_real

type(derived), intent(inout) :: derived_type

integer :: i
real :: start, finish

continue

number_of_tests = number_of_tests + 1

rewind(logical_unit)
call cpu_time(start)
read(logical_unit) (assumed_size_array_int(i), i=1,array_size)
read(logical_unit) (assumed_size_array_real(i),i=1,array_size)
call cpu_time(finish)
assumed_size_time = assumed_size_time + finish-start

rewind(logical_unit)
call cpu_time(start)
read(logical_unit) (assumed_shape_array_int(i), i=1,array_size)
read(logical_unit) (assumed_shape_array_real(i),i=1,array_size)
call cpu_time(finish)
assumed_shape_time = assumed_shape_time + finish-start

rewind(logical_unit)
call cpu_time(start)
read(logical_unit) (module_data_array_int(i), i=1,array_size)
read(logical_unit) (module_data_array_real(i),i=1,array_size)
call cpu_time(finish)
module_data_time = module_data_time + finish-start

rewind(logical_unit)
call cpu_time(start)
read(logical_unit) (derived_type%component_array_int(i), i=1,array_size)
read(logical_unit) (derived_type%component_array_real(i),i=1,array_size)
call cpu_time(finish)
derived_type_time = derived_type_time + finish-start

end subroutine read_array_types

subroutine work_with_array_types(array_size, &
assumed_size_array_int, assumed_size_array_real, &
assumed_shape_array_int, assumed_shape_array_real, &
derived_type)

integer, intent(in) :: array_size

integer(iKind),dimension(array_size), intent(inout):: assumed_size_array_int
real(rKind), dimension(array_size), intent(inout):: assumed_size_array_real

integer(iKind), dimension(:), intent(inout) :: assumed_shape_array_int
real(rKind), dimension(:), intent(inout) :: assumed_shape_array_real

type(derived), intent(inout) :: derived_type

integer :: i, j
real :: start, finish

real(rKind) :: dot, sum, max_element
real(rKind), dimension(:), allocatable :: vector

continue

number_of_tests = number_of_tests + 1

allocate( vector(array_size) )

call random_number( vector )

call cpu_time(start)
do j = 1, 5
dot = 0.0_rKind
do i = 1, array_size
dot = dot + assumed_size_array_real(i)*vector(i)
end do
max_element = -huge(max_element)
do i = 1, array_size
if ( abs(assumed_size_array_real(i)) > abs(max_element) ) &
max_element = assumed_size_array_real(i)
end do
sum = 0.0_rKind
do i = 1, array_size
sum = sum + assumed_size_array_real(i)
end do
do i = 2, array_size
assumed_size_array_real(i) = assumed_size_array_real(i) &
+ assumed_size_array_real(i-1)
end do
do i = 1, array_size
assumed_size_array_real(i) = assumed_size_array_real(i) &
+ assumed_size_array_real(assumed_size_array_int(i))
end do
end do
call cpu_time(finish)
assumed_size_time = assumed_size_time + finish-start

call cpu_time(start)
do j = 1, 5
dot = 0.0_rKind
do i = 1, array_size
dot = dot + assumed_shape_array_real(i)*vector(i)
end do
max_element = -huge(max_element)
do i = 1, array_size
if ( abs(assumed_shape_array_real(i)) > abs(max_element) ) &
max_element = assumed_shape_array_real(i)
end do
sum = 0.0_rKind
do i = 1, array_size
sum = sum + assumed_shape_array_real(i)
end do
do i = 2, array_size
assumed_shape_array_real(i) = assumed_shape_array_real(i) &
+ assumed_shape_array_real(i-1)
end do
do i = 1, array_size
assumed_shape_array_real(i) = assumed_shape_array_real(i) &
+ assumed_shape_array_real(assumed_shape_array_int(i))
end do
end do
call cpu_time(finish)
assumed_shape_time = assumed_shape_time + finish-start

call cpu_time(start)
do j = 1, 5
dot = 0.0_rKind
do i = 1, array_size
dot = dot + module_data_array_real(i)*vector(i)
end do
max_element = -huge(max_element)
do i = 1, array_size
if ( abs(module_data_array_real(i)) > abs(max_element) ) &
max_element = module_data_array_real(i)
end do
sum = 0.0_rKind
do i = 1, array_size
sum = sum + module_data_array_real(i)
end do
do i = 2, array_size
module_data_array_real(i) = module_data_array_real(i) &
+ module_data_array_real(i-1)
end do
do i = 1, array_size
module_data_array_real(i) = module_data_array_real(i) &
+ module_data_array_real(module_data_array_int(i))
end do
end do
call cpu_time(finish)
module_data_time = module_data_time + finish-start

call cpu_time(start)
do j = 1, 5
dot = 0.0_rKind
do i = 1, array_size
dot = dot + derived_type%component_array_real(i)*vector(i)
end do
max_element = -huge(max_element)
do i = 1, array_size
if ( abs(derived_type%component_array_real(i)) > abs(max_element) ) &
max_element = derived_type%component_array_real(i)
end do
sum = 0.0_rKind
do i = 1, array_size
sum = sum + derived_type%component_array_real(i)
end do
do i = 2, array_size
derived_type%component_array_real(i) &
= derived_type%component_array_real(i) &
+ derived_type%component_array_real(i-1)
end do
do i = 1, array_size
derived_type%component_array_real(i) &
= derived_type%component_array_real(i) &
+ derived_type%component_array_real(derived_type%component_array_int(i))
end do
end do
call cpu_time(finish)
derived_type_time = derived_type_time + finish-start

end subroutine work_with_array_types

end module test_various_array_types


program test_array_storage_performance

use kind_definitions, only: iKind, rKind
use type_definition, only: derived
use module_data, only: module_data_array_int, module_data_array_real

use test_various_array_types, only: read_array_types, &
work_with_array_types, &
reset_counters, &
assumed_size_time, &
assumed_shape_time, &
module_data_time, &
derived_type_time

implicit none

integer, parameter :: logical_unit = 1
integer, parameter :: number_of_runs = 10
integer, parameter :: array_size = 200000

integer(iKind), dimension(:), allocatable :: assumed_size_array_int
real(rKind), dimension(:), allocatable :: assumed_size_array_real

integer(iKind), dimension(:), allocatable :: assumed_shape_array_int
real(rKind), dimension(:), allocatable :: assumed_shape_array_real

type(derived) :: derived_type

integer :: i

continue

allocate( assumed_size_array_int(array_size), &
assumed_size_array_real(array_size) )
allocate( assumed_shape_array_int(array_size), &
assumed_shape_array_real(array_size) )
allocate( module_data_array_int(array_size), &
module_data_array_real(array_size) )
allocate( derived_type%component_array_int(array_size), &
derived_type%component_array_real(array_size) )

open (logical_unit, file='data', form='unformatted' )

write (logical_unit) ((array_size-i+1), i=1,array_size)
write (logical_unit) (1.0_rKind, i=1,array_size)

do i = 1, number_of_runs
call read_array_types( logical_unit, array_size, &
assumed_size_array_int, assumed_size_array_real, &
assumed_shape_array_int, assumed_shape_array_real, &
derived_type )
end do

close (logical_unit)

write(*,*) 'IO tests:'
write(*,*) ' Assumed-size:', assumed_size_time / assumed_size_time
write(*,*) ' Assumed-shape:', assumed_shape_time / assumed_size_time
write(*,*) ' Use Module:', module_data_time / assumed_size_time
write(*,*) ' Derived type:', derived_type_time / assumed_size_time

call reset_counters()

do i = 1, number_of_runs
call work_with_array_types(array_size, &
assumed_size_array_int, assumed_size_array_real, &
assumed_shape_array_int, assumed_shape_array_real, &
derived_type )
end do

write(*,*) 'Work tests:'
write(*,*) ' Assumed-size:', assumed_size_time / assumed_size_time
write(*,*) ' Assumed-shape:', assumed_shape_time / assumed_size_time
write(*,*) ' Use Module:', module_data_time / assumed_size_time
write(*,*) ' Derived type:', derived_type_time / assumed_size_time

end program test_array_storage_performance

Richard Maine

unread,
Sep 3, 2002, 3:58:59 PM9/3/02
to
Bil Kleb <W.L....@LaRC.NASA.Gov> writes:

> NAG f95 compiler i686/Linux:
>
> IO tests:
> Assumed-size: 1.0000000
> Assumed-shape: 1.0326086
> Use Module: 1.0217385
> Derived type: 1.2282608
> Work tests:
> -Abort-

Figured I'd try to trace down why this was aborting, but...
I ran it and it worked fine. That makes it trickier to debug
(and perhaps not worth the time). For what it is worth, I'm
using (from the compiler's -V output)

NAGWare Fortran 95 compiler Release 4.2(484)

on RedHat 7.3 (with an AMD Athlon 1.4, though I've got it
underclocked by about 10% in order to make Windows stable,
though I haven't have Windows booted on it in native mode
for ages, so perhaps I should undo the underclock...)

For what it is worth, here's data from one run. As with
your runs, no compiler switches at all.

IO tests:
Assumed-size: 1.0000000
Assumed-shape: 0.9859152
Use Module: 1.0140843
Derived type: 1.1408453
Work tests:
Assumed-size: 1.0000000
Assumed-shape: 0.9953927
Use Module: 1.0276515
Derived type: 2.1198175

Optimization does appear to be a significant effect on the work
tests. With -O4, I get

IO tests:
Assumed-size: 1.0000000
Assumed-shape: 0.9722220
Use Module: 0.9861110
Derived type: 1.1111113
Work tests:
Assumed-size: 1.0000000
Assumed-shape: 1.3058839
Use Module: 1.3058822
Derived type: 3.8705909

Nag has some special options that are likely to be relevant here.
Using -Oassumed=contig gets

IO tests:
Assumed-size: 1.0000000
Assumed-shape: 1.0416671
Use Module: 1.0138892
Derived type: 1.1388891
Work tests:
Assumed-size: 1.0000000
Assumed-shape: 1.0146341
Use Module: 1.0731709
Derived type: 2.2390242

With both -O4 and -Oassumed=contig, one gets

IO tests:
Assumed-size: 1.0000000
Assumed-shape: 1.0147053
Use Module: 1.0294114
Derived type: 1.2058823
Work tests:
Assumed-size: 1.0000000
Assumed-shape: 0.9431824
Use Module: 1.2499989
Derived type: 3.7499998

I'll leave interpretation of all this to others.

P.S. I realize your tests were all based on default compiler switches,
and I'm not criticizing that as a test basis. Just thought I'd provide
the extra info while I was experimenting.

--
Richard Maine | Good judgment comes from experience;
email: my last name at host.domain | experience comes from bad judgment.
host: altair, domain: dfrc.nasa.gov | -- Mark Twain

Bil Kleb

unread,
Sep 3, 2002, 5:25:42 PM9/3/02
to
Richard Maine wrote:
>
> Figured I'd try to trace down why this was aborting, but...
> I ran it and it worked fine.

Hmmm...

> NAGWare Fortran 95 compiler Release 4.2(484)

That's the same one I have. Double "Hmmm..."

> I'll leave interpretation of all this [relative array
> type performance] to others.

Anyone?

Our conclusion has been that assumed-size is the *only*
way to go on SGIs, while for other machines/compilers
it is *usually* the way to go, i.e., using the Fortran 9X
features given unpredictable performance penalties/gains.

> Just thought I'd provide the extra info while I was
> experimenting.

Appreciated.

--
Bil

Jan C. Vorbrüggen

unread,
Sep 4, 2002, 6:56:14 AM9/4/02
to
> Our conclusion has been that assumed-size is the *only*
> way to go on SGIs, while for other machines/compilers
> it is *usually* the way to go, i.e., using the Fortran 9X
> features given unpredictable performance penalties/gains.

This is a bit of a chicken and egg-problem: if people don't start
to use assumed-shape arrays, with all their other advantages, because
the performance is a little or a lot (in some cases) worse that using
an assumed-size array, the compiler vendors will not improve the analysis
and code-generation parts of their compilers for assumed-shape arrays,
so their customers won't use them, so...

Assumed-size is much less safe and modular, and also - in some situations,
the frequency of which is application- and programmer-dependent - much
less expressive. Don't use it, and complain to your compiler vendor when
performance suffers.

Jan

Arjen Markus

unread,
Sep 4, 2002, 7:21:31 AM9/4/02
to

A severe problem with assumed-shape arrays and array operations
used to be the endless waiting in an interactive debugger.
I am not sure that this has been solved for all popular
compilers and debuggers (often an interactive debugger is
not the suitable tool for finding a particular bug).

I agree with Jan's conclusion: assumed-shape is one of the very
attractive features of Fortran 90 and any consequences it has on
performance (or on debugging) should be reported to the compiler
vendors.

Regards,

Arjen

0 new messages