I am passing an allocated array to a utility subroutine. The utility subroutine has no idea whether this array is of fixed dimensions (i.e. not allocatable) or has been allocated before. Inside the utility subroutine, I would like to check the status of the array, i.e. whether it is an allocatable array or a fixed-size array.
Thus, I was wondering whether the “allocated(my_array)” function can safely (and compiler-independently) be used to check the array’s status (i.e. allocatable or not). In my Fortran books the function “allocated(my_array)” is solely mentioned in conjunction with allocatable arrays. What does the Fortran standard say about an array that is passed to the “allocated(my_array)” function? Is there a restriction that only allocatable arrays can be passed to it?
This brings me to the question whether an inquiry function like “is_allocatable(my_array)” makes sense, provided that the “allocated(my_array)”-solution mentioned above does not work in general? The scenario were this could be useful is: if an allocatable array is passed to a procedure one may allow the utility procedure to expand it in size if needed (e.g. to hold larger amount of data than anticipated), and to issue an error/warning message/return code when this is not possible (because the array is not allocatable).
If the dummy argument has the allocatable attribute, then only allocatable actual arrays can be associated with that argument. The compiler should be able to catch violations at compile time. If the dummy argument does not have the allocatable attribute, then the actual argument can be either. If that latter is the situation, then I do not know of a way to test the dummy argument to know if the actual argument is allocatable.
There is a feature that for an optional dummy argument, the present(arg) intrinsic can be used to test for either a nonexistent actual argument or an unallocated actual argument. I dislike using this feature because it seems so obscure, but it might do the test that you want in this case. However, afterwards, you cannot resize the dummy array since it is not allocatable, so that part would still not work.
One can only (de)allocate or ask the allocation status of an allocatable variable. If the dummy argument is not allocatable then it is invalid to pass an unallocated argument.
Unfortunately there is not a good way in Fortran to provide anything that even looks like potential (re)allocation of a dummy argument if it happens to be allocatable.
Your words betray a certain confusion, which is understandable.
Yes
The decisions in Fortran are made to prioritize performance. Decisions must be made at compile-time, as much as possible. This makes it hard to write code that will turn out to be slow. The price of that is that it limits the expresiveness, somewhat. For your purposes, you need to know that arrays (and names, in general) come in 3 flavours: vanilla, ALLOCATABLE and POINTER.
Vanilla is for names that will refer to objects of some fixed size (for the lifetime of that name).
ALLOCATABLE is for names that will refer to objects of different sizes and these objects will not be referred to by any other name.
POINTER is for names that will refer to different objects (of varying sizes) and these objects can also be referred to by other names.
There is a mechanism in Fortran for associating a subroutine name with two or more implementations, depending on properties of the arguments. These properties must be decidable at compile time. One implementation can be for an ALLOCATABLE name and the other for Vanilla-or-POINTER. No, you can’t slice it 3 ways. This is what the MODULE below does, it provides an interface for is_Allocatable, and its implementation. Note however that it can only be used with actual arguments being ALLOCATABLE (and it can reallocate the actual argument to a different size) or POINTER. Also note that names that will be pointed to must be declared TARGET (if not POINTER). Also note that a section of an ALLOCATABLE is not an ALLOCATABLE (passing y(:) will be treated as non-ALLOCATABLE).
Module magic
Interface is_Allocatable
Module Procedure :: isAlloc, isPointer
End Interface Is_Allocatable
Contains
Subroutine isAlloc(arr,res)
Real, Allocatable :: arr(:)
Logical :: res
If (.Not. Allocated(arr)) Then
Allocate(arr(200))
Else If (Size(arr)<200) Then
Deallocate(arr)
Allocate(arr(200))
Print '("Reallocated")'
End If
res = .true.
End Subroutine IsAlloc
Subroutine isPointer(arr,res)
Real, Pointer :: arr(:)
Logical :: res
Print '("Size is ",I6)',size(arr)
res = .false.
End Subroutine isPointer
End Module magic
Program test_magic
Use magic
Real, Target :: x(100)
Real, Pointer :: p(:)
Real, Allocatable, Target :: y(:)
Logical :: rslt
p => x ! P is associated with Target X
Call is_allocatable(p,rslt)
Print '("P is associated with Target X and is ",A)', Merge("Allocatable ", "Not Allocatable", rslt)
Print '("Size(P) is",I6)', Size(p)
nullify(p)
allocate (p(100)) ! P is associated with an allocated target
Call is_allocatable(p,rslt)
Print '("P is associated with an allocated target and is ",A)', Merge("Allocatable ", "Not Allocatable",rslt)
Print '("Size(P) is",I6)', Size(p)
Call is_allocatable(y,rslt)
Print '("Y is allocatable and is ",A)', Merge("Allocatable ", "Not Allocatable",rslt)
Print '("Size(Y) is",I6)', Size(y)
p => x(2:5:2)
Call is_allocatable(p,rslt)
p => y(2:50:2)
Call is_allocatable(p,rslt)
End Program test_magic
Thanks very much! If my (simplistic) code below reflects your nice idea, then it works this way. The minor disadvantage is that the parameters passed to the subroutine must be arranged so that the optional ones are the last ones, since all arguments after an optional one must be optional as well (if I remember correctly). However, at first glance this seems to be a rather cosmetic issue.
program testcase
use proc_testarrays
implicit none
integer, parameter :: knd = 8
real(kind=knd), allocatable :: flex_array(:,:)
real(kind=knd) :: fix_array(6,6)
fix_array(:,:) = 1.0_knd
allocate(flex_array(12,12))
flex_array(:,:) = 2.0_knd
write(*,*) 'passing fix_array:'
call testarrays (fix=fix_array)
write(*,*) 'passing flex_array:'
call testarrays (flex=flex_array)
end program testcase
module proc_testarrays
contains
subroutine testarrays (flex, fix)
implicit none
integer, parameter :: knd = 8
real(kind=knd), optional, allocatable :: flex(:,:)
real(kind=knd), optional :: fix(:,:)
if (present(flex)) then
write(*,*) 'allocation status: allocated(flex) = ', allocated(flex)
write(*,*) 'flex = ', flex(:,:)
else if (present(fix)) then
write(*,*) 'fix = ', fix(:,:)
else
write(*,*) '***error: no array was passed!'
stop
end if
end subroutine testarrays
end module proc_testarrays
Thanks very much! If I understand you right, by using your module the compiler will be able to distinguish allocatable arrays and pointers (and calls the respective subroutine), but it won’t be able to distinguish between allocatable arrays and non-allocatable ones. Is it because arrays don’t have an attribute that labels them as allocatable or non-allocatable?
The trick of passing an unallocated actual argument only works when the dummy argument does not have the allocatable attribute. The expression present(flex_array) will be false either when the actual argument is not present or when the actual argument is an unallocated array. Here is a modified code that demonstrates this:
module proc_testarrays
integer, parameter :: knd = selected_real_kind(14)
contains
subroutine testarrays (flex, fix)
implicit none
real(kind=knd), optional :: flex(:,:)
real(kind=knd), optional :: fix(:,:)
write(*,*) 'present(flex)=', present(flex)
write(*,*) 'present(fix)=', present(fix)
if (present(flex)) then
!write(*,*) 'allocation status: allocated(flex) = ', allocated(flex)
write(*,*) 'flex = ', flex(:,:)
else if (present(fix)) then
write(*,*) 'fix = ', fix(:,:)
else
write(*,*) 'testarrays: no array was passed!'
end if
return
end subroutine testarrays
end module proc_testarrays
program testcase
use proc_testarrays
implicit none
real(kind=knd), allocatable :: flex_array(:,:)
real(kind=knd) :: fix_array(1,1)
fix_array(:,:) = 1.0_knd
allocate(flex_array(2,2))
flex_array(:,:) = 2.0_knd
write(*,*) 'passing fix_array:'
call testarrays (fix=fix_array)
write(*,*) 'passing allocated flex_array:'
call testarrays (flex=flex_array)
deallocate( flex_array )
write(*,*) 'passing deallocated flex_array:'
call testarrays (flex=flex_array)
write(*,*) 'passing no actual argument:'
call testarrays ()
end program testcase
$ nagfor proc_testarrays.f90 && a.out
NAG Fortran Compiler Release 7.1(Hanzomon) Build 7114
[NAG Fortran Compiler normal termination]
passing fix_array:
present(flex)= F
present(fix)= T
fix = 1.0000000000000000
passing allocated flex_array:
present(flex)= T
present(fix)= F
flex = 2.0000000000000000 2.0000000000000000 2.0000000000000000 2.0000000000000000
passing deallocated flex_array:
present(flex)= F
present(fix)= F
testarrays: no array was passed!
passing no actual argument:
present(flex)= F
present(fix)= F
testarrays: no array was passed!
Notice how the third and fourth calls are treated the same way.
If the dummy argument flex(:,:) has the alocatable attribute, then the program will seg fault in the third call because it will attempt to print an unallocated array.
Not exactly. Optional arguments can appear anywhere within the list, but any arguments following non-present optional arguments must be passed using keyword arguments. I.e.
subroutine some_optional(a, b, c)
integer, intent(in), optional :: a, c
integer, intent(in) :: b
end subroutine
call some_optional(b = 42)
It is able to distinguish between allocatables and non-allocatables-that-are-pointers. The user cannot call it with non-allocatable, non-pointer arrays. If they have one of these, they need to associate a pointer with it and pass that.
This is all a bit academic because the “user” is writing the code and has made the choice which of the three flavours the array has. You might as well tell users of your stuff: “if you use an allocatable array, call this_routine_does_what_I_want_for_allocatable_arrays(arr)”.
Overall, I think that an array is a just specific data type, and allocatable arrays should not be treated as a further data type. At present, this is basically done, because e.g. the allocated(array) function accepts only allocatable arrays, so there is obviously a distinction made between both.
If there would be an inquiry function like “is_allocatable”, then we could always and everywhere check whether it is allocatable or not, and, provided to be true, apply the respective operations reserved for allocatable arrays as we want. There could be a further mechanism like “make_allocatable” which turns an initially fixed array to an allocatable one, which has the nice side effect of increasing flexibility.
In short, the proposals I would like to discuss are:
1.) Eliminate the need to declare an array as allocatable. For example: instead of declaring an allocatable dummy array as integer, allocatable :: my_array(:,:)
one may write integer :: my_array(:,:)
and leave it open what happens later with this array in the respective procedure. The compiler should force the user to allocate it before it is used for the first time.
2.) Introduce the “is_allocatable” function to check if the array is allocatable, so that the respective operations (e.g. resizing) can be applied anywhere in our codes.
3.) Introduce “make_allocatable” to turn an initially fixed size array into an allocatable one (optional: the existing contents could be left unchanged).
4.) Optional: introduce “make_nonallocatable” to turn an allocatable array into a fixed one (i.e. to “freeze” its dimensions).
It is clear that all these ideas have be to discussed in a much broader context, which requires the involvement of many experts like in this forum. In this context, the most important requirement seems to be that these ideas should not collide with other concepts of Fortran, which is what I am not able to overlook.
It is currently not allowed to initialize an allocatable array, an allocatable derived type, or an allocatable character string. This proposal would bypass that restriction in the language, at least in some cases. Instead, the entity would be declared and initialized in the usual way, and then make_allocatable() could be invoked to change its allocatable attribute.
However, there are other situations where make_allocatable() would be inconsistent. Suppose you have and array or character string that is associated by storage sequence to another entity. A subsequent reallocation of that array would destroy that previous sequence association, and the compiler could not know about it. Storage sequence associations occur through EQUIVALENCE, COMMON blocks, and argument association. The first two are deprecated, but the last one would still apply.
I have suggested in the past a generalization of move_alloc() where pointers and allocatables could be used as the to= and from= arguments in shallow copy operations. However, since both pointers and allocatables can occur already in allocate() and deallocate(), this is a relatively minor suggested change to the language.
It is important to realize that type and rank (array-ness) are separate concepts in Fortran, and neither have anything to do with ALLOCATABLE or POINTER attributes. We recently introduced assumed-type and assumed-rank objects. It sounds like you want an assumed-attribute object, but I am not clear what the compelling use case is.
Thanks very much for sharing your thoughts! You’re right. The problem here is that the array being passed is seen in the foo() procedure as a rank 1 array, while its “parent” array is of rank 2. Do you think that the problem you’re referring to can be avoided if the proposed mechanisms were limited to arrays of the same rank? Also, one might think of restricting the applicability of is_allocatable() and make_allocatable() to arrays that have been passed in full size (in your code snippet: call foo(a) instead of call foo(a(10,:))), which appears to me the most common situation in which I would use these features.
This is a very good holistic perspective! I have to admit that I’m not aware of assumed-rank and assumed-type objects (my knowledge on new Fortran features is always lagging behind until I find time to read new Fortran books). I think that all these assumed-… objects lead to a significant increase of flexibility. At first glance, assumed-attribute objects seems to fit perfectly in this list of assumed objects.
PS: Assumed-rank and assumed-type objects remind me of Matlab or Python, where anything can be everything. Is this a first step towards dynamic typing, i.e. an interpreter-based “scripting” programming language? If yes, I hope that static typing will never be abandoned in Fortran.
No, the problem arises as soon as an array section is passed (e.g. a(:,5:7)). An array section can definitely not be considered as allocatable.
It could possibly work, but the problem is that the compiler wouldn’t know that a full array is needed in the call, and couldn’t detect the error if an array section was passed. And the execution would fail. A desirable behavior is to detect as many errors as possible at compile time as opposed to runtime.
There is actually another situation where even passing the whole array would not be enough to get what you want:
subroutine bar(n)
real, intent(in) :: n
real :: a(n)
call foo(a)
end subroutine
subroutine foo(x)
real, intent(inout) :: x(:)
...
if (.not.is_allocatable(x)) make_allocatable(x)
if (allocated(x)) deallocate(x) !!! FAILURE
allocate( x(5) )
...
end subroutine foo
a is here an automatic array, allocated at runtime upon entering the bar routine, and automatic arrays are often allocated on the stack. Reallocatating a stack variable is definitely not possible internally. It means that compilers should never allocate any array on the stack.
I have been frustrated also by the strong discrimation between allocatable and non allocatable arrays, typically when needing to return an array with a size that is not easily known in advance. One way is to have an allocatable dummy argument, but then it gets impossible to pass non-allocatable arrays. But I can not see good solutions to that.
I suggest you search whatever Fortran documentation you have and familiarize yourself with the distinction between foo(a) !Name foo(a(:)) !Designator foo((a)) !Expression
When a Designator is used as an actual argument, some attributes of the name involved (“a”, in this case) are not “transmitted” to the dummy argument of foo, ALLOCATABLE being one (compilers usually enforce this and won’t let you do it).
When an Expression is used as an actual argument, the corresponding dummy argument of foo shall not be assigned to (compilers usually do not enforce this and will let you shoot your foot off, but the INTENT attribute can help you avoid this by spotting it at compile-time).