Polymorphic array allocation routine in Fortran - arrays

The goal is to create a single allocation routine which can handle any type of rank one allocation. Our code library can then have a single call with standardized error trapping.
The compiler error follows:
generic_allocation.f08:32:27:
call myAllocator ( array_int, source_int, lambda )
1
Error: Actual argument to ‘myarray’ at (1) must be polymorphic
generic_allocation.f08:33:27:
call myAllocator ( array_real, source_real, lambda )
1
Error: Actual argument to ‘myarray’ at (1) must be polymorphic
Can this code be rectified?
The test code attempts to allocate an integer array and then a real array:
module mAllocator
implicit none
contains
subroutine myAllocator ( myArray, source_type, lambda )
class ( * ), allocatable, intent ( inout ) :: myArray ( : )
class ( * ), intent ( in ) :: source_type
integer, intent ( in ) :: lambda
integer :: alloc_status = 0
character ( len = 512 ) :: alloc_message = ''
allocate ( myArray ( 1 : lambda ), source = source_type, stat = alloc_status, errmsg = alloc_message )
if ( alloc_status /= 0 ) then
write ( *, "( ' allocation errmsg = ', g0, '.' )" ) trim ( alloc_message )
stop 'Fatal error in subroutine myAllocator'
end if
end subroutine myAllocator
end module mAllocator
program generic_allocation
use mAllocator, only : myAllocator
implicit none
integer, parameter :: lambda = 10
integer, parameter :: source_int = 1
real, parameter :: source_real = 1.0
integer, allocatable :: array_int ( : )
real, allocatable :: array_real ( : )
call myAllocator ( array_int, source_int, lambda )
call myAllocator ( array_real, source_real, lambda )
end program generic_allocation
The first version of the code relied upon a select type construct as shown in FORTRAN: polymorphism allocation. Another reference used is Fortran polymorphism, functions and allocation.
The gfortran version is 6.0
$ gfortran -v
Using built-in specs.
COLLECT_GCC=gfortran
COLLECT_LTO_WRAPPER=/opt/gnu/6.0/libexec/gcc/x86_64-pc-linux-gnu/6.0.0/lto-wrapper
Target: x86_64-pc-linux-gnu
Configured with: ./configure --prefix=/opt/gnu/6.0 --enable-languages=c,c++,fortran,lto --disable-multilib --disable-werror
Thread model: posix
gcc version 6.0.0 20160227 (experimental) (GCC)

You are encountering a deliberate restriction in the language, put in place to prevent a procedure from allocating an object to some type that does not match the declared type of the actual argument. Consider what would happen if your allocator allocated the dummy argument corresponding to array_int to be of type REAL.
You cannot achieve your goal with a single procedure, however you may be able to get away with writing a single stretch of source code, that you then INCLUDE into the body of multiple procedures, one for each declared type (and kind) that you wish to deal with.
! In AllocateBody.i90
integer, intent(in) :: lambda
integer :: alloc_status
character ( len = 512 ) :: alloc_message
allocate ( myArray ( 1 : lambda ), &
source = source_type, &
stat = alloc_status, &
errmsg = alloc_message )
if ( alloc_status /= 0 ) then
write ( *, "( ' allocation errmsg = ', g0, '.' )" ) &
trim ( alloc_message )
stop 'Fatal error in subroutine myAllocator'
end if
! Elsewhere.
subroutine my_allocator_integer(myArray, source_type, lambda )
integer, intent(out), allocatable :: myArray(:)
integer, intent(in) :: source_type
include 'AllocateBody.i90'
end subroutine my_allocator_integer
subroutine my_allocator_real(myArray, source_type, lambda )
real, intent(out), allocatable :: myArray(:)
real, intent(in) :: source_type
include 'AllocateBody.i90'
end subroutine my_allocator_real
subroutine my_allocator_foo(myArray, source_type, lambda )
type(foo), intent(out), allocatable :: myArray(:)
type(foo), intent(in) :: source_type
include 'AllocateBody.i90'
end subroutine my_allocator_foo
You could put all these specific procedures behind the one generic name.
However, before you embark on this, note that in modern Fortran that allocatable things can be allocated even without an ALLOCATE statement - simple assignment to an allocatable variable can result in it being ALLOCATED. You have no way of handling error messages for those cases. There are also a very large number of coding constructs that will result in the compiler "allocating" memory for its own internal needs, which again, you have no way of handling errors for. At a lower level, the way that operating systems actually fulfil requests by program for memory is also working against you - the system may be overcommitted, and an insufficient memory error may not be reported by the operating system to the process until well after an allocate statement had completed. In combination, in the situation where available memory is very low and an attempt to allocate a small object has failed, it is possible that there is insufficient memory available for the compiler to even execute your error reporting code. There is also the issue that the compiler's runtime has a better idea of the reasons for failure and the state of the program that it can communicate via a simple integer code and a character message - for example the compiler's runtime can give the user a stack trace or similar, in addition to whatever message it could otherwise pass back to the program.
All up, for small allocations, programmer provided error reporting may not be very productive.
It can be very worthwhile for larger allocations, where the probability of specific failure is higher and it is very likely that the reason can be successfully communicated and acted on ("Your problem dimension is too big! Please make it smaller and try again...") by a user.

Related

How to directly use the return of maxloc as index of an array [duplicate]

Is there possibility to use indexing directly on a function's return value? Something like this:
readStr()(2:5)
where readStr() is a function which returns a character string or an array. In many other languages it is quite possible, but what about Fortran? The syntax in my example of course does not compile. Is there any other syntax to be used?
No, that is not possible in Fortran. You could, however, alter your function to take an additional index array that determines which elements are returned. This example illustrates this possibility using an interface to allow for an optional specification of the indices (simplified greatly thanks to the comment by IanH):
module test_mod
implicit none
contains
function squareOpt( arr, idx ) result(res)
real, intent(in) :: arr(:)
integer, intent(in), optional :: idx(:)
real,allocatable :: res( : )
real :: res_( size(arr) )
integer :: stat
! Calculate as before
res_ = arr*arr
if ( present(idx) ) then
! Take the sub-set
allocate( res(size(idx)), stat=stat )
if ( stat /= 0 ) stop 'Cannot allocate memory!'
res = res_(idx)
else
! Take the the whole array
allocate( res(size(arr)), stat=stat )
if ( stat /= 0 ) stop 'Cannot allocate memory!'
res = res_
endif
end function
end module
program test
use test_mod
implicit none
real :: arr(4)
integer :: idx(2)
arr = [ 1., 2., 3., 4. ]
idx = [ 2, 3]
print *, 'w/o indices',squareOpt(arr)
print *, 'w/ indices',squareOpt(arr, idx)
end program
No.
But if it bothers you, you can write your own user defined functions and operators to achieve a similar outcome without having to store the result of the function reference in a separate variable.
You can avoid declaring another variable if you use associate. Whether it is any better or clearer than a temporary variable must be decided by the user. The result has to be stored somewhere anyway.
associate(str=>readStr())
print *, str(2:5)
end associate
It will not be very useful for this specific case with a potentially long string but might be more useful for other similar cases that get linked here as duplicates.

Fortran polymorphic array assignment for `PACK`: issues

I am trying to code a computationally efficient PACK operation over a polymorphic array and I am running on issues with gfortran 9.2.0:
The PACK operation has to work on a polymorphic array of a derived type quantity, and return a result on itself
For reasons I'm not explaining here, this array should not be reallocated
In general, there is overlap between the locations of the returned indices, and those of the original array: something like array(1:5) = array([2,4,6,8,10])
I'm having problems, as the only version of the assigment I've tried with gfortran is with a loop - all array-based version either produce compiler or runtime segfaults.
An example is reported in this program:
module m
implicit none
type, public :: t
integer :: i = 0
contains
procedure, private, pass(this) :: t_assign => t_to_t
generic :: assignment(=) => t_assign
end type t
type, public, extends(t) :: tt
integer :: j = 0
contains
procedure, private, pass(this) :: t_assign => t_to_tt
end type tt
contains
elemental subroutine t_to_t(this,that)
class(t), intent(inout) :: this
class(t), intent(in ) :: that
this%i = that%i
end subroutine t_to_t
elemental subroutine t_to_tt(this,that)
class(tt), intent(inout) :: this
class(t ), intent(in ) :: that
this%i = that%i
select type (thatPtr=>that)
type is (t)
this%j = 0
type is (tt)
this%j = thatPtr%j
class default
! Cannot stop here
this%i = -1
this%j = -1
end select
end subroutine t_to_tt
end module m
program test_poly_pack
use m
implicit none
integer, parameter :: n = 100
integer :: i,j
class(t), allocatable :: poly(:),otherPoly(:)
allocate(t :: poly(n))
allocate(t :: otherPoly(10))
! Assign dummy values
forall(i=1:n) poly(i)%i = i
! Array assignment with indices => ICE segfault:
! internal compiler error: Segmentation fault
otherPoly(1:10) = poly([10,20,30,40,50,60,70,80,90,100])
! Scalar assignment with loop -> OK
do i=1,10
otherPoly(i) = poly(10*i)
end do
! Array assignment with PACK => Compiles OK, Segfault on runtime. GDB returns:
! Thread 1 received signal SIGSEGV, Segmentation fault.
! 0x000000000040163d in m::t_to_t (this=..., that=...) at test_poly_pack.f90:31
! 31 this%i = that%i
otherPoly(1:10) = pack(poly,mod([(j,j=1,100)],10)==0)
do i=1,10
print *, ' polymorphic(',i,')%i = ',otherPoly(i)%i
end do
end program test_poly_pack
Am I doing anything wrong, and/or is this only a compiler bug or there is any best practices I should be following?
The crashes are compiler bugs. When the compiler says internal compiler error ... Please submit a full bug report, you really can trust it and you should act accordingly (and submit the bug report). The runtime crash is a compiler bug as well (wrong code).
If you know the actual types at the time of the assignment, you can use type guards
select type (p => poly)
type is (t)
select type(op => otherpoly)
type is (t)
op(1:10) = pack(p,mod([(j,j=1,100)],10)==0)
end select
end select
If you need it to be polymorphic - you probably have to reallocate
allocate(otherPoly(1:10),source = pack(poly,mod([(j,j=1,100)],10)==0))
until the bugs you hopefully reported are fixed.

How to create array of arrays from all variables in a module

I have a number of variables declared in a module such as
module test
use othermod, only: n
integer, dimension(n) :: var0
real, dimension(n) :: var1
real, dimension(n) :: var2
.....
real, dimension(n) :: var1000
end module test
Then I have a subroutine that fills these variables with values.
At this point I would like to create an array of arrays with all the variables declared in module test so that I can easily copy or print all variables of a particular (n) at the same time, like dimension(n,allvariablesin module test). For example I would like to do something like array(3,:)=array(2,:).
Because this code is part of a very large program I cannot really modify too much, but rather I need to create an array of arrays from all the variables in this module without typing all the variables.
How can I easily integrate this change in the current code?
I urge you follow to #Vladimir F's advice and encapsulate your variables inside a derived data type. You can employ the associate construct to call old codes expecting var0, var1, .., etc. Lastly, we can overload the type's name to get a Java style constructor in the code below
module type_MyArray
implicit none
private
type, public :: MyArray
! type-components
real, dimension(:), allocatable :: var0, var1, var2
contains
! type-bound procedures
procedure :: create => create_my_array
procedure :: destroy => destroy_my_array
end type MyArray
interface MyArray
module procedure my_array_constructor
end interface MyArray
contains
pure function my_array_constructor(n) result (return_value)
! Dummy arguments
integer, intent (in) :: n
type (MyArray) :: return_value
call return_value%create(n)
end function my_array_constructor
pure subroutine create_my_array(self, n)
! Dummy arguments
class(MyArray), intent(in out) :: self
integer, intent(in) :: n
allocate( self%var0(n) )
allocate( self%var1(n) )
allocate( self%var2(n) )
end subroutine create_my_array
pure subroutine destroy_my_array(self)
! Dummy arguments
class(MyArray), intent(in out) :: self
if (allocated(self%var0)) deallocate( self%var0 )
if (allocated(self%var1)) deallocate( self%var1 )
if (allocated(self%var2)) deallocate( self%var2 )
end subroutine destroy_my_array
end module type_MyArray
program main
use type_MyArray, only: MyArray
use old_code, only: do_something
implicit none
type (MyArray) :: foo, bar
! Allocate memory
foo = MyArray(42)
bar = MyArray(4200)
associate( var0 => foo%var0, var1 => bar%var1 )
! Call old code using var0 and var1
call do_something(var0, var1)
end associate
! Release memory
call foo%destroy()
call bar%destroy()
end program main

Fortran: Choosing the rank of an allocatable array

I am trying to write a program where I want the allocatable array A to be of either rank 1, 2, or 3, depending on my input at run-time. I want to do this since the subsequent operations on A are similar, and I have defined in a module an interface work with module procedures that when acted on A, gives the desired result.
What I am doing currently is this:
program main
implicit none
integer :: rank,n=10
real*8, allocatable :: A1(:)
real*8, allocatable :: A2(:,:)
read (*,*) rank
if (rank.eq.1) then
allocate (A1(n))
else if (rank.eq.2) then
allocate (A2(n,n))
end if
! operate on the array
if (rank.eq.1) then
call work(A1)
else if (rank.eq.2) then
call work(A2)
end if
end program
Things would be much easier if somehow I could choose the rank of A, as then the if statements are not needed. Maybe this is not possible, but all help are appreciated.
The next Fortran standard (2015) has the select rank construct similar to select case. My example uses the select case construct on the rank intrinsic of an assumed-rank dummy variable.
module my_type
use, intrinsic :: iso_fortran_env, &
ip => INT32, &
wp => REAL64
implicit none
private
public :: MyType
type MyType
real (wp) :: rank0
real (wp), allocatable :: rank1(:)
real (wp), allocatable :: rank2(:,:)
real (wp), allocatable :: rank3(:,:,:)
contains
procedure :: create => create_my_type
procedure :: destroy => destroy_my_type
end type MyType
contains
subroutine create_my_type(this, array)
! calling arguments
class (MyType), intent (in out) :: this
real (wp), intent (in) :: array(..) !! Assumed-rank dummy variable
! local variables
integer (ip), allocatable :: r(:)
select case(rank(array))
case (0)
return
case (1)
r = shape(array)
allocate( this%rank1(r(1)) )
case (2)
r = shape(array)
allocate( this%rank2(r(1), r(2)) )
case (3)
r = shape(array)
allocate( this%rank3(r(1), r(2), r(3)) )
case default
error stop 'array must have rank 0,1,2, or 3'
end select
! Release memory
if (allocated(r)) deallocate( r )
end subroutine create_my_type
subroutine destroy_my_type(this)
! calling arguments
class (MyType), intent (in out) :: this
if (allocated(this%rank1)) deallocate( this%rank1 )
if (allocated(this%rank2)) deallocate( this%rank2 )
if (allocated(this%rank3)) deallocate( this%rank3 )
end subroutine destroy_my_type
end module my_type
program main
use, intrinsic :: iso_fortran_env, only: &
ip => INT32, &
wp => REAL64
use my_type, only: &
MyType
implicit none
type (MyType) :: foo
real (wp) :: a0, a1(42), a2(42,42), a3(42,42,42)
print *, rank(a0)
print *, rank(a1)
print *, rank(a2)
print *, rank(a3)
! Allocate array of rank 3
call foo%create(a3)
print *, rank(foo%rank3)
print *, shape(foo%rank3)
print *, size(foo%rank3)
! Release memory
call foo%destroy()
end program main
Declare the array to be rank three. If a lower rank array is required, allocate the relevant trailing dimensions to be of size one.
real, allocatable :: array(:,:,:)
...
select case (desired_rank)
case (1) ; allocate(array(n,1,1))
case (2) ; allocate(array(n,n,1))
case (3) ; allocate(array(n,n,n))
case default ; error stop 'bad desired rank'
end select
You can then use an array section to get a contiguous slice of array that is consistent with your desired rank. Alternatively, write the relevant procedures that operate on array to take a rank three argument, and make them aware of the meaning of a size one extent for the higher dimensions.

Can a input argument of a Fortran subroutine be deallocated and allocated in the body of the subroutine?

UPDATE: My modified code looks like this:
program run_module_test
use module_test
implicit none
TYPE(newXYZ), allocatable, intent(inout) :: xyzArray(:)
call update(xyzArray)
write(6,*)'xyzArray',xyzArray
end program run_module_test
module module_test
implicit none
TYPE :: newXYZ
real(4) :: x, u
real(4) :: y, v
real(4) :: z, w
real(4),dimension(3) :: uvw
END TYPE
integer(4) :: shape = 3
contains
subroutine update(xyzArray)
integer(4) :: i
TYPE(newXYZ), allocatable, intent(inout) :: xyzArray(:)
allocate( xyzArray(shape) )
do i = 1, shape
xyzArray(i)%x = 0
xyzArray(i)%y = 0
xyzArray(i)%z = 0
xyzArray(i)%u = 0
xyzArray(i)%v = 0
xyzArray(i)%w = 0
xyzArray(i)%uvw = (/0,0,0/)
end do
return
end subroutine update
end module module_test
When they are compiled, they generate a similar error:
TYPE(newXYZ), allocatable, intent(inout) :: xyzArray(:)
1
Error: ALLOCATABLE attribute conflicts with DUMMY attribute at (1)
When I eliminate the argument in update() subroutine, I receive a contradictory error:
TYPE(newXYZ), allocatable, intent(inout) :: xyzArray(:)
1
Error: Symbol at (1) is not a DUMMY variable
Have I eliminated the sources of error pointed out in the helpful suggestions? Could this be a compiler related error (using mpi90)?
~~~First Edit~~~
I have a subroutine whose input argument is an array of user defined type XYZ. I wish to deallocate xyzArray and allocate/modify it to a different size in the body of the subroutine. I attempted the method suggested by changing array dimensions in fortran, but when I do the following:
subroutine update(xyzArray, ...)
...
TYPE (XYZ), allocatable :: xyzArray(:)
I receive an error message:
Error: ALLOCATABLE attribute conflicts with DUMMY attribute at (1)
When I try:
subroutine update(xyzArray, ...)
...
deallocate( xyzArray(myshape) )
allocate( xyzArray(newshape) )
I receive error messages:
Error: Expression in DEALLOCATE statement at (1) must be ALLOCATABLE or a POINTER
Error: Expression in ALLOCATE statement at (1) must be ALLOCATABLE or a POINTER
What do I need to do to change the size of the array in the subroutine?
To do this:
The dummy argument must be allocatable. Allocatable dummy arguments require a compiler that implements the relevant part of the Fortran 2003 standard (or a Fortran 95 compiler that implements the so called "allocatable" TR).
An explicit interface to the procedure is required (the procedure must be a module procedure, an internal procedure or have an interface block in the calling scope).
The dummy argument must not be intent(in). If you are not using the allocation status or other aspects of the value of the dummy argument at all in the subroutine then intent(out) may be appropriate (if allocated beforehand the dummy argument will be automatically deallocated when the procedure is called), otherwise intent(inout) or no intent.
(Your second block of example code has a syntax error with the deallocate statement - you should simply specify the xyzArray variable, leave off the (myshape) shape specification))
For example, in a module:
subroutine update(xyzArray)
type(xyz), allocatable, intent(inout) :: xyzArray(:)
...
if (allocated(xyzArray)) deallocate(xyzArray)
allocate(xyzArray(newshape))
...
If you are sure, you want to deallocate the array in your subroutine, you can declare the dummy argument being intent(out), so that it is deallocated automatically when the subroutine is entered:
module whatever
implicit none
type :: xyz
:
end type xyz
contains
subroutine update(xyzArray)
type(xyz), allocatable, intent(out) :: xyzArray(:)
:
allocate(xyzArray(someshape))
:
end subroutine update
end module whatever
As already noted by IanH, the process must have an explicit interface (e.g. being enclosed in a module) and in the caller program you must declare the actual argument allocatable:
program test
use whatever
implicit none
type(xyz), allocatable :: array(:)
:
call update(array)
:
end program test

Resources