Simplify the declaration of automatic arrays?

Often I want to write code that declares automatic arrays as follows:

subroutine foo(x)
real, intent(in) :: x(:)
integer          :: n = size(x)    ! not legal
real             :: a(n),b(n),c(n) ! not legal
! real             :: a(size(x)),b(size(x)),c(size(x)) ! legal but awkward
end subroutine foo

but gfortran says

size.f90:3:29:

    3 | integer          :: n = size(x)
      |                             1
Error: Assumed-shape array 'x' at (1) is not permitted in an initialization expression
size.f90:5:21:

    5 | real             :: a(size(x)),b(size(x)),c(size(x))
      |                     1
Error: Symbol 'a' at (1) already has basic type of REAL
size.f90:4:22:

    4 | real             :: a(n),b(n),c(n) ! not legal
      |                      1
Error: Variable 'n' cannot appear in the expression at (1)

Besides using the line I commented out, I know I can use ALLOCATABLE array, so that n = size(x) can appear after the declarations and n can be used to allocate the arrrays. But would it make sense to extend Fortran so that the code above works? Often when I use the current syntax

real :: a(size(x)),b(size(x)),c(size(x))

I later define n = size(x) anyway, and I wish I could have used n earlier to simplify the code.

A different compiler gives messages more closely tied to the standard text:

ftn -c test.f90

integer :: n = size(x) ! not legal
^
ftn-842 crayftn: ERROR FOO, File = test.f90, Line = 3, Column = 25
The initialization expression used on a type declaration statement must be a constant expression.

real :: a(n),b(n),c(n) ! not legal
^
ftn-521 crayftn: ERROR FOO, File = test.f90, Line = 4, Column = 23
Object ā€œNā€, used in a bounds expression must be a constant, a dummy argument, a common block member or use or host associated.

Note that this alternative does work and avoids writing size(x):

subroutine foo(x)
real, intent(in) :: x(: )
real,allocatable :: a(:),b(:),c(: )

allocate (a,b,c,mold=x)

end subroutine foo

1 Like

Off the top of my head, two options come to mind that you can look into to alleviate the awkwardness!

First might be the simplest even if old-fashioned and that is to pass the array size as an argument

   subroutine foo(x, n)
      real, intent(in)    :: x(:)
      integer, intent(in) :: n
      real :: a(n)

Second approach is verbose but it may be worth it if the subprogram has to deal with a fair bit of different objects, perhaps in 2 or more sections of code, and whose sizes depend on the array dummy arguments. This is with more drawn out ASSOCIATE and BLOCK constructs:

   subroutine foo(x)
      real, intent(in) :: x(:)
      associate ( n => size(x) )
         block
            real :: a(n), b(n), ..
1 Like

How about the following syntax?

subroutine foo(x)
real, intent(in) :: x(:)
real, dimension(size(x)) :: a,b,c
1 Like