Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
28386 Discussions

fortran allocation, unknown a priori DIMENSION

mic_esp96
New Contributor I
3,424 Views

I want to generalise allocation of a variable which may have different number of dimension.

To do so I created an interface having different procedures which are called depending of the SIZE of DIMS (the array of the dimensions).

To be clearer:

 

inteface allbisp

    module procedure allbisp1

    module procedure allbisp2

    module procedure allbisp3

end interface allbisp

 

in which  subroutine allbisp"i"(bisp, dims, varname)  the difference stands in dims("i") only. Depending the case, bisp has different number of dimensions.

Moreover, in the case allbisp2 (i.e. in which dims is array with 2 values) I would like to differentiate w.r.t. the value 1 of dims.

That is, IF (dims(1).eq.SPEC_VALUE) then "allocate bisp with 5 dimensions" ELSE "allocate bisp with 4 dimensions" END IF

However, this requires to know a priori dims(1) and then the number of dimensions of bisp to correctly declarate it, which is the opposite of using interfaces to generalise things.

I hope I was clear enough.

 

Thanks,

Michele

Labels (1)
0 Kudos
20 Replies
Arjen_Markus
Honored Contributor I
3,366 Views

Well, interfaces distinguish on the basis of the type, rank and kind of their arguments. So, distinguishing based a value of one of the arguments is impossible. But the kind of things you want to do could be done via an assumed-rank array. I have never used them, but they are implemented in Intel Fortran 19 (https://software.intel.com/content/www/us/en/develop/documentation/fortran-compiler-developer-guide-and-reference/top/language-reference/specification-statements/type-declarations/declarations-for-arrays/assumed-rank-specifications.html).

If this does not help, you may want to redesign the interface - if you pass a 4-dimensional array and the first dimension has the wrong value, that could be flagged via a run-time error.

0 Kudos
mic_esp96
New Contributor I
3,352 Views

if I declare

 

real,allocatable,dimension(..) :: bisp

 

I get: error #6792: The rank of the allocate-shape-spec-list differs from the rank of the allocate-object.

 

0 Kudos
Arjen_Markus
Honored Contributor I
3,346 Views

Can you show the full example? I just tried with gfortran (I do not have  access to Intel Fortran 19 at the moment, so couldn't try that), but that works fine:

! assumed_rank.f90 --
!     Test assumed rank arrays
!
module assumed_rank
    implicit none

contains
subroutine alloc( r )
    real, dimension(..), allocatable, intent(out) :: r

    select rank ( r )
        rank( 1 )
            allocate(  r(100) )
        rank ( 2 )
            allocate(  r(10,10) )
    end select
end subroutine alloc

end module assumed_rank

program test_rank
    use assumed_rank

    real, dimension(:,:), allocatable :: x

    call alloc( x )

    write(*,*) size(x), shape(x)
end program test_rank

 

0 Kudos
mic_esp96
New Contributor I
3,338 Views

@Arjen_Markus I guess what you did is not what I would like to do. Here it is the code:

interface allbisp
      module procedure allbisp1
      module procedure allbisp2
      module procedure allbisp3
end interface



subroutine allbisp2(bisp,dims,varname)
      implicit none
      !input
      integer,intent(in)::dims(2)
      real,allocatable,dimension(..),intent(inout)::bisp
      character(len=*),optional,intent(in)::varname
      !local
      integer:: istat,dim1,dim2

      if (dims(1).eq.numfrqs) then
         dim1 = dims(1)
         dim2 = dims(2)
         allocate(bisp(dim1,dim1,dim2,dim2,dim2), stat=istat)
         if (istat.ne.0) call errall('ALLBISP2',istat,trim(varname))
      else
         dim1 = dims(1)
         dim2 = dims(2)
         allocate(bisp(dim1,dim1,dim1,dim2), stat=istat)
         if (istat.ne.0) call errall('ALLBISP2',istat,trim(varname))
      end if
end subroutine allbisp2

 

Then, within the main program one will have:

!declaration
! ...
real,allocatable,dimension(..) :: B
real :: dimensions(2)
! ...


! ...
dimensions = [dim1, dim2]
call allbisp(B, dimensions, 'B') !will get to allbisp2 since size(dimensions).eq.2

! ...
0 Kudos
mic_esp96
New Contributor I
3,335 Views

Unfortunately I cannot report the full example since it is part of a large code, but the idea should be explained by previous message. If not clear, I can go deeper, maybe trying to build a quick and simple little program.

0 Kudos
mic_esp96
New Contributor I
3,332 Views

Basically, in your example, in your main you already know the rank of your array. In my example, the rank depends on what the program selects for dimensions.

0 Kudos
Arjen_Markus
Honored Contributor I
3,321 Views

True, the only thing I can think of that would work is that you pass the array as an assumed-size array (in the FORTRAN 77 tradition) and pass it on as either a 4- or a 5-dimensional array. Though I think that would be rather error-prone.

Assumed-rank arrays are very limited in their use and what you want is in fact a dynamic rank. Fortran does not have that, though there are several techniques I can think of to mimick that. None very elegant though. Can you indeed create a small program that illustrates what you want to do? And can you explain why you want such a dynamic rank? Not how, but why, as we might be able to advise on alternatives.

0 Kudos
mic_esp96
New Contributor I
3,304 Views

Here's a sample program:

 

subroutine allbisp2(b,dims,val)
   implicit none
   real,allocatable,dimension(..),intent(inout)::b
   integer,intent(in) :: dims(2),val
   !local
   integer :: dim1,dim2,istat

   if (dims(1).eq.val) then
      dim1 = dims(1)
      dim2 = dims(2)
      allocate(b(dim1,dim1,dim2,dim2,dim2),stat=istat)
      if (istat.ne.0) write(*,'(/,a,/)'), '[ERROR] Error allocating "b"!'
   else
      dim1 = dims(1)
      dim2 = dims(2)
      allocate(b(dim1,dim1,dim1,dim2),stat=istat)
      if (istat.ne.0) write(*,'(/,a,/)'), '[ERROR] Error allocating "b"!'
   end if

end subroutine allbisp2


program main_prog
   implicit none
   real,allocatable,dimension(..) :: b
   integer,dimension(2) :: dims
   integer :: val

   dims = [10,20]
   val  = 10

   call allbisp2(b,dims,val)

   write(*,'(/,/,a)'), '[FINISH] Program ended!'
   
end program main_prog

 

The reason:

b is basically a tensor of multiple dimensions (6 or more), the first two representing a surface (3D plot), the others indexes along which iterating. The distinction is to chose whether

  1. to store the entire surface (to be then plotted) for some indexes (I do not explain them since is out if scope)  (CASE 1, true IF)
  2. store a single value of the matrix for some others given values of indexes.

 

Hope being clear enough.

0 Kudos
jimdempseyatthecove
Honored Contributor III
3,296 Views

I suggest you .NOT. use assumed rank programming, except for not having any other choice.

Instead consider declaring your array(s) with your model's maximum number of dimensions. Then allocate the desired ranks to their specific sizes and the undesired ranks to size of 1. This will simplify your programming efforts.

Jim Dempsey

0 Kudos
mic_esp96
New Contributor I
3,295 Views

Thanks @jimdempseyatthecove , I knew that possibility, but I was wondering if there was a nicer one, so I asked.

0 Kudos
FortranFan
Honored Contributor II
3,278 Views

@mic_esp96 ,

With Fortran, the bottom-line is RANKs of your objects need to be known at compile-time.

The advice by @jimdempseyatthecove is very pertinent, especially in terms of compute efficiency.

And also because there is another facility which Fortran allows: the target of a RANK-N array pointer can be a RANK-1 array.

Thus an option you can consider is to make your primary data object 'b' a RANK-1 array and give it the TARGET attribute.

You can then have in your code some 'work' arrays with POINTER attributes.  Say two or more RANK-N and RANK-N+1 arrays of POINTERs e.g., rank-4 and rank-5 as you show with allbisp2 case in your original post.

Then, at run-time based on program logic, can point these work arrays to your base data object 'b' with suitable array bounds.

With this approach, you would then only do allocation and deallocation with object 'b'.  And with your working array pointers, you only associate them in a pointer assignment (=>)and nullify the associations when done.  Thus it can be reasonably safe. 

0 Kudos
jimdempseyatthecove
Honored Contributor III
3,273 Views

TARGET and ASSIGN may be suitable in some places, but in other cases you could pass the  front-slice of the array (the used dimensions), and thus the DUMMY of the called procedure is equivalent to the pointer assignment (with no data transfer).

It may be handy to write a function that returns the ranks used of the large rank placeholder. Note, the Rank-1 allocation method of FortranFan would not provide a means to reconstitute the shape&size of the original array (sans extra dimensions) without having extra scalars assigned and manipulated for this purpose. In the excess dimensions method these "extra scalars" are maintained in the array descriptor.

Jim Dempsey

0 Kudos
mic_esp96
New Contributor I
3,255 Views

Dear @jimdempseyatthecove , could you be more explicit if that does not bother you, I'm not so expert in FORTRAN programming..

 

What is a "front-slice" of an array? What do you mean in the first sentence of the second paragraph?

 

Thanks a lot for your comprehension and kindness.

 

Michele

0 Kudos
jimdempseyatthecove
Honored Contributor III
3,250 Views

>>What is a "front-slice" of an array?

Not specific to your problem, but "front-slice" of an array in general:

real :: array(12,34,56)
...
call foo(array(:,:,1)) ! same as array(1:12,1:34,1) or 1/56th of array at front part
...
subroutine foo(frontSlice)
real :: frontSlice(12,34) ! or frontSlice(:,:)

In your case, the "unused" dimensions would have size of 1

real, allocatable :: array(:,:,:,:,:)
...
allocate(array(12,34,56,1,1) ! 3D array held in 5D descriptor
...
call foo(array(:,:,:,1,1)) ! pass "front part" to subroutine expecting 3D array

Jim Dempsey

0 Kudos
mic_esp96
New Contributor I
3,258 Views

Thanks @FortranFan . So if I well understood, based on the original sample I reported, I should declare:

...

real, allocatable, dimension(:), target :: b

real, allocatable, pointer :: ptr4(:,:,:,:), ptr5(:,:,:,:,:)

...

if (dims(1).eq.GIVEN_VALUE) then
    allocate(ptr5(dim1,dim2,dim3,dim4,dim5))
    ptr5 => b
else
    allocate (ptr4(dim1,dim2,dim3,dim4))
    ptr4 => b
end if

 

Not sure if I got how to handle the output "b", what I'm interested in finally...

 

Thanks for your clarification!

0 Kudos
jimdempseyatthecove
Honored Contributor III
3,254 Views

FF will likely respond. I think he meant something along the line of:

...
real, allocatable, dimension(:), target :: b
real, pointer :: ptr4(:,:,:,:), ptr5(:,:,:,:,:)
...
allocate(b(dim1*dim2*dim3*dim4*dim5))
...
if (dims(1).eq.GIVEN_VALUE) then
ptr5 => b(dim1,dim2,dim3,dim4,dim5)
else
ptr4 => b(dim1,dim2,dim3,dim4)
end if

Moderator </> (paste code) no longer has Fortran as markup *****

Jim Dempsey

0 Kudos
mic_esp96
New Contributor I
3,253 Views

Thanks @jimdempseyatthecove .

 

What about:

 

...
real, allocatable, dimension(:), target :: b
real, pointer :: ptr4(:,:,:,:), ptr5(:,:,:,:,:)
...

...
if (dims(1).eq.GIVEN_VALUE) then

allocate(b(dim1*dim2*dim3*dim4*dim5))
ptr5 => b(dim1,dim2,dim3,dim4,dim5)
else

allocate(b(dim1*dim2*dim3*dim4))
ptr4 => b(dim1,dim2,dim3,dim4)
end if

 

But I have a question: with pointer association, does b change shape?? (to 1 to 4/5 dimensions?)

0 Kudos
jimdempseyatthecove
Honored Contributor III
3,247 Views

b never changes shape. It is Rank-1 of size of allocation.

ptr4, and ptr5 become Rank-4 and Rank-5 pointers to the contiguous allocation made for b. It is your responsibility not to exceed the total size of the allocation of b .AND. to nullify/fix these pointers should you deallocate or reallocate or movealloc b.

Jim Dempsey

0 Kudos
FortranFan
Honored Contributor II
3,229 Views

Pointer assignment ( ptrN => b ) will have no impact on the shape of 'b' which remains a rank-1 array object.  Subsequent ordinary assignments ( ptrN(n,m,o,p) = x ) can redefine the value of elements of array b, that's all.

Re: your question on syntax, take a look at this example for an illustration:

module m

   real, allocatable, save, target, private :: b(:) ! base data 'held' by module; can be private

   real, pointer, save, public :: ptr4( :, :, :, : ) => null()
   real, pointer, save, public :: ptr5( :, :, :, :, : ) => null()

contains

   subroutine allbisp2(dims,val)

      !Argument list
      integer, intent(in) :: dims(2)
      integer, intent(in) :: val

      if ( dims(1) == val ) then
         ! Checks elided for when 'b' might be allocated already
         allocate( b(dims(1)*dims(2)*dims(1)*dims(2)*dims(1)) )
         ptr5(1:dims(1),1:dims(2),1:dims(1),1:dims(2),1:dims(1)) => b
         print *, "shape of ptr5 = ", shape(ptr5)
      else
         ! Checks elided for when 'b' might be allocated already
         allocate( b(dims(1)*dims(2)*dims(1)*dims(2)) )
         ptr4(1:dims(1),1:dims(2),1:dims(1),1:dims(2)) => b
         print *, "shape of ptr4 = ", shape(ptr4)
      end if

      return

   end subroutine allbisp2

   subroutine clean()

      ! Nullify pointers
      ptr4 => null()
      ptr5 => null()

   end subroutine

end module

program main_prog

   use m

   implicit none

   integer,dimension(2) :: dims
   integer :: val

   dims = [10,20]
   val  = 10

   call allbisp2( dims, val )

   ! .. do some work

   ! diassociate the pointers
   call clean()

   write(*,'(/,/,a)') '[FINISH] Program ended!'

end program main_prog

 

Upon execution of above program, the expected output is:

 shape of ptr5 =  10 20 10 20 10


[FINISH] Program ended!

 

0 Kudos
jimdempseyatthecove
Honored Contributor III
2,966 Views

A suggestion for using FortranFan's code sample would be to place a call to clean() in the front part of allbisp2 as well as in an added subroutine deallbisp2 to deallocate the blob b.

The pointer method is suitable in a procedure that is passed b and which needs to directly process ptr....

It is not necessary to construct a pointer when it is only used by an immediately following CALL, it these cases you pass the "slice" of the over-ranked array.

Choose the method that works best for you.

Jim Dempsey

0 Kudos
Reply