Determine assumed-shape array strides at runtime - arrays

Is it possible in a modern Fortran compiler such as Intel Fortran to determine array strides at runtime? For example, I may want to perform a Fast Fourier Transform (FFT) on an array section:
program main
complex(8),allocatable::array(:,:)
allocate(array(17, 17))
array = 1.0d0
call fft(array(1:16,1:16))
contains
subroutine fft(a)
use mkl_dfti
implicit none
complex(8),intent(inout)::a(:,:)
type(dfti_descriptor),pointer::desc
integer::stat
stat = DftiCreateDescriptor(desc, DFTI_DOUBLE, DFTI_COMPLEX, 2, shape(a) )
stat = DftiCommitDescriptor(desc)
stat = DftiComputeForward(desc, a(:,1))
stat = DftiFreeDescriptor(desc)
end subroutine
end program
However, the MKL Dfti* routines need to be explicitly told the array strides.
Looking through reference manuals I have not found any intrinsic functions which return stride information.
A couple of interesting resources are here and here which discuss whether array sections are copied and how Intel Fortran handles arrays internally.
I would rather not restrict myself to the way that Intel currently uses its array descriptors.
How can I figure out the stride information? Note that in general I would want the fft routine (or any similar routine) to not require any additional information about the array to be passed in.
EDIT:
I have verified that an array temporary is not created in this scenario, here is a simpler piece of code which I have checked on Intel(R) Visual Fortran Compiler XE 14.0.2.176 [Intel(R) 64], with optimizations disabled and heap arrays set to 0.
program main
implicit none
real(8),allocatable::a(:,:)
pause
allocate(a(8192,8192))
pause
call random_number(a)
pause
call foo(a(:4096,:4096))
pause
contains
subroutine foo(a)
implicit none
real(8)::a(:,:)
open(unit=16, file='a_sum.txt')
write(16, *) sum(a)
close(16)
end subroutine
end program
Monitoring the memory usage, it is clear that an array temporary is never created.
EDIT 2:
module m_foo
implicit none
contains
subroutine foo(a)
implicit none
real(8),contiguous::a(:,:)
integer::i, j
open(unit=16, file='a_sum.txt')
write(16, *) sum(a)
close(16)
call nointerface(a)
end subroutine
end module
subroutine nointerface(a)
implicit none
real(8)::a(*)
end subroutine
program main
use m_foo
implicit none
integer,parameter::N = 8192
real(8),allocatable::a(:,:)
integer::i, j
real(8)::count
pause
allocate(a(N, N))
pause
call random_number(a)
pause
call foo(a(:N/2,:N/2))
pause
end program
EDIT 3:
The example illustrates what I'm trying to achieve. There is a 16x16 contiguous array, but I only want to transform the upper 4x4 array. The first call simply passes in the array section, but it doesn't return a single one in the upper left corner of the array. The second call sets the appropriate stride and a subsequently contains the correct upper 4x4 array. The stride of the upper 4x4 array with respect to the full 16x16 array is not one.
program main
implicit none
complex(8),allocatable::a(:,:)
allocate(a(16,16))
a = 0.0d0
a(1:4,1:4) = 1.0d0
call fft(a(1:4,1:4))
write(*,*) a(1:4,1:4)
pause
a = 0.0d0
a(1:4,1:4) = 1.0d0
call fft_stride(a(1:4,1:4), 1, 16)
write(*,*) a(1:4,1:4)
pause
contains
subroutine fft(a) !{{{
use mkl_dfti
implicit none
complex(8),intent(inout)::a(:,:)
type(dfti_descriptor),pointer::desc
integer::stat
stat = DftiCreateDescriptor(desc, DFTI_DOUBLE, DFTI_COMPLEX, 2, shape(a) )
stat = DftiCommitDescriptor(desc)
stat = DftiComputeForward(desc, a(:,1))
stat = DftiFreeDescriptor(desc)
end subroutine !}}}
subroutine fft_stride(a, s1, s2) !{{{
use mkl_dfti
implicit none
complex(8),intent(inout)::a(:,:)
integer::s1, s2
type(dfti_descriptor),pointer::desc
integer::stat
integer::strides(3)
strides = [0, s1, s2]
stat = DftiCreateDescriptor(desc, DFTI_DOUBLE, DFTI_COMPLEX, 2, shape(a) )
stat = DftiSetValue(desc, DFTI_INPUT_STRIDES, strides)
stat = DftiCommitDescriptor(desc)
stat = DftiComputeForward(desc, a(:,1))
stat = DftiFreeDescriptor(desc)
end subroutine !}}}
end program

I'm guessing you get confused because you worked around the explicit interface of the MKL function DftiComputeForward by giving it a(:,1). This is contiguous and doesn't need an array temporary. It's wrong, however, the low-level routine will get the whole array and that's why you see that it works if you specify strides. Since the DftiComputeForward exects an array complex(kind), intent inout :: a(*), you can work by passing it through an external subroutine.
program ...
call fft(4,4,a(1:4,1:4))
end program
subroutine fft(m,n,a) !{{{
use mkl_dfti
implicit none
complex(8),intent(inout)::a(*)
integer :: m, n
type(dfti_descriptor),pointer::desc
integer::stat
stat = DftiCreateDescriptor(desc, DFTI_DOUBLE, DFTI_COMPLEX, 2, (/m,n/) )
stat = DftiCommitDescriptor(desc)
stat = DftiComputeForward(desc, a)
stat = DftiFreeDescriptor(desc)
end subroutine !}}}
This will create an array temporary though when going into the subroutine. A more efficient solution is then indeed strides:
program ...
call fft_strided(4,4,a,16)
end program
subroutine fft_strided(m,n,a,lda) !{{{
use mkl_dfti
implicit none
complex(8),intent(inout)::a(*)
integer :: m, n, lda
type(dfti_descriptor),pointer::desc
integer::stat
integer::strides(3)
strides = [0, 1, lda]
stat = DftiCreateDescriptor(desc, DFTI_DOUBLE, DFTI_COMPLEX, 2, (/m,n/) )
stat = DftiSetValue(desc, DFTI_INPUT_STRIDES, strides)
stat = DftiCommitDescriptor(desc)
stat = DftiComputeForward(desc, a)
stat = DftiFreeDescriptor(desc)
end subroutine !}}}

Tho routine DftiComputeForward accepts an assumed size array. If you pass something complicated and non-contiguous, a copy will have to be made at passing. The compiler can check at run-time if the copy is actually necessary or not. In any case for you the stride is always 1, because that will be the stride the MKL routine will see.
In your case you pass A(:,something), this is a contiguous section, provided A is contiguous. If A is not contiguous a copy will have to be made. Stride is always 1.

Some of the answers here do not understand the different between fortran strides and memory strides (though they are related).
To answer your question for future readers beyond the specific case you have here - there does not appear to be away to find an array stride solely in fortran, but it can be done via C using inter-operability features in newer compilers.
You can do this in C:
#include "stdio.h"
size_t c_compute_stride(int * x, int * y)
{
size_t px = (size_t) x;
size_t py = (size_t) y;
size_t d = py-px;
return d;
}
and then call this function from fortran on the first two elements of an array, e.g.:
program main
use iso_c_binding
implicit none
interface
function c_compute_stride(x, y) bind(C, name="c_compute_stride")
use iso_c_binding
integer :: x, y
integer(c_size_t) :: c_compute_stride
end function
end interface
integer, dimension(10) :: a
integer, dimension(10,10) :: b
write(*,*) find_stride(a)
write(*,*) find_stride(b(:,1))
write(*,*) find_stride(b(1,:))
contains
function find_stride(x)
integer, dimension(:) :: x
integer(c_size_t) :: find_stride
find_stride = c_compute_stride(x(1), x(2))
end function
end program
This will print out:
4
4
40

In short: assumed-shape arrays always have stride 1.
A bit longer: When you pass a section of an array to a subroutine which takes an assumed-shape array, as you have here, then the subroutine doesn't know anything about the original size of the array. If you look at the upper- and lower-bounds of the dummy argument in the subroutine, you'll see they will always be the size of the array section and 1.
integer, dimension(10:20) :: array
integer :: i
array = [ (i, i=10,20) ]
call foo(array(10:20:2))
subroutine foo(a)
integer, dimension(:) :: a
integer :: i
print*, lbound(a), ubound(a)
do i=lbound(a,1), ubound(a,2)
print*, a(i)
end do
end subroutine foo
This gives the output:
1 6
10 12 14 16 18 20
So, even when your array indices start at 10, when you pass it (or a section of it), the subroutine thinks the indices start at 1. Similarly, it thinks the stride is 1. You can give a lower bound to the dummy argument:
integer, dimension(10:) :: a
which will make lbound(a) 10 and ubound(a) 15. But it's not possible to give an assumed-shape array a stride.

Related

Difference in Fortran pointer and Fortran allocatable in calling C_F_POINTER

The thing is, 'C_F_POINTER' compiles successfully(ifort version 19.0.5.281) with 'allocatable arrays' as its argument, and it works in the exactly same way with the case in which 'pointer' is used as its argument.
program test1
use mkl_spblas
use omp_lib
use iso_c_binding
implicit none
integer, parameter :: DIM_ = 4, DIM_2 = 6
integer :: stat, i
integer :: irn(DIM_2), jcn(DIM_2)
real*8 :: val(DIM_2)
integer(c_int) :: indexing
integer :: DIM_r, DIM_c
type(c_ptr) :: rows_start_c, rows_end_c, col_indx_c, values_c
(*1)!integer,allocatable :: rows_start_f(:), rows_end_f(:), col_indx_f(:)
!real*8 ,allocatable :: values_f(:)
(*2)integer ,pointer :: rows_start_f(:), rows_end_f(:), col_indx_f(:)
real*8 ,pointer :: values_f(:)
type(SPARSE_MATRIX_T) :: mat1, mat2
irn = (/ 2, 2, 3, 4, 0, 0 /)
jcn = (/ 1, 2, 3, 2, 0, 0 /)
val = (/ 5, 8, 3, 6, 0, 0 /)
call omp_set_num_threads(1)
stat = mkl_sparse_d_create_coo (A=mat1, indexing=SPARSE_INDEX_BASE_ONE, &
rows=DIM_, cols=DIM_, nnz=DIM_,&
row_indx=irn, col_indx=jcn, values=val )
if (stat /= 0) stop 'Error in mkl_sparse_d_create_coo'
stat = mkl_sparse_convert_csr (source=mat1,&
operation=SPARSE_OPERATION_NON_TRANSPOSE, &
dest = mat2 )
if (stat /= 0) stop 'Error in mkl_sparse_convert_csr'
stat = mkl_sparse_d_export_csr(mat2, indexing, DIM_r, DIM_c, &
rows_start_c, rows_end_c, col_indx_c, values_c)
(*3)call c_f_pointer(rows_start_c, rows_start_f, [DIM_r])
call c_f_pointer(rows_end_c , rows_end_f , [DIM_c])
call c_f_pointer(col_indx_c , col_indx_f , [rows_end_f(DIM_r)-1])
call c_f_pointer(values_c , values_f , [rows_end_f(DIM_r)-1])
stat = mkl_sparse_destroy (A=mat1)
if (stat /= 0) stop 'Error in mkl_sparse_destroy (mat1)'
stat = mkl_sparse_destroy (A=mat2)
if (stat /= 0) stop 'Error in mkl_sparse_destroy (mat2)'
call mkl_free_buffers
(*4)print *, 'rows_start'
print *, rows_start_f
print *, 'rows_end'
print *, rows_end_f
print *, 'col_indx'
print *, col_indx_f
print *, 'values'
print *, values_f
print *, 'indexing'
print *, indexing
print *, 'size(values_f,1)'
print *, size(values_f,1)
end program test1
In the test code above, I marked some points as (*1), (*2), and so on in the leftside of the code.
(*1) & (*2) : allocatable array version and pointer version of the code
(*3) : where I call 'C_F_POINTER'
(*4) : print statements to see the output
The results are 'exactly' the same in both (*1), and (*2) case, and all values are properly converted into desired CSR format.
rows_start
1 1 3 4
rows_end
1 3 4 5
col_indx
1 2 3 2
values
5.00000000000000 8.00000000000000 3.00000000000000
6.00000000000000
indexing
1
size(values_f,1)
4
I found a similar question in StackOverflow 2 years ago (difference between fortran pointers or allocatable arrays for c_f_pointer call).
This question is asking the exactly the same questions in my mind right now.
If I rearange questions in my words,
Difference between pointer and allocatable array?
In C, as far as I know, the arrays are stored in contiguous memory and can be represented by the pointer which points its 1st element. And in Fortran90, if I pass a array into a subroutine as 'assumed-size array', the code behaves like it never cares about how it's allocated, how it's size is like, and treates the array as 1D being stored in contiguous site.
In below code, the subroutine 'assign_A' just gets the 'tot_array(1,2)' as its starting point, and do its work on contiguous site and seems to do it even out of bound of 'tot_array'!! (tot_array is 2x2 matrix, and assign_A's do loop runs 5 times starting at tot_array(1,2)) I was 'feeling' the pointer and allocatable arrays are similar stuff in this sense. But apparently, as the answers in difference between fortran pointers or allocatable arrays for c_f_pointer call, they are different things. Why arrays acts like pointer when they are passed to subroutine as 'assumed-size' one?
program assumed_size_array_test
implicit none
external assign_A
real*8 :: tot_array(2,2)
integer:: i
! Initially 'tot_array' set to be 1.d0
tot_array = 1.d0
write(*,*) 'Before'
write(*,'(5f5.2)') tot_array
call assign_A(tot_array(1,2))
write(*,*) 'After'
write(*,'(5f5.2)') tot_array
end program
subroutine assign_A(A)
implicit none
real*8, intent(inout) :: A(*)
integer :: i
do i = 1,5
A(i) = 2.d0
enddo
end subroutine
Before
1.00 1.00 1.00 1.00
After
1.00 1.00 2.00 2.00
Is there any difference in using 'allocatable array' and 'pointer' in calling 'C_F_POINTER' in Fortran90?
I used ifort version 19.0.5.281, and this compiler seems to give me exactly the same results as far as I checked. If it's okay, I prefer to use allocatble arrays instead of pointers. Is there any difference in using 'allocatable array' and 'pointer' with 'C_F_POINTER', and is there anything that I should be aware of in doing so?
The answers in difference between fortran pointers or allocatable arrays for c_f_pointer call says that I SHOULD use pointers, not using allocatable arrays with C_F_POINTER, but it seems it's some ongoing issue that was not concluded exactly at that time. Is there any conclusion in why 'C_F_POINTER', which is designed for fortran pointer, works fine with allocatable arrays and is result is the same?
Thank you for reading this question.
Obviously, both Fortran POINTER variables and ALLOCATABLE variables have a lot of common in their internal impementation. Most of that is under the hood and should not be accessed directly. Both allocate some memory and probably use the same operating system's or C runtime library's allocator. For example, malloc().
In both there is some memory allocated or pointed to and described by a simple address (for scalars) or by an array descriptor (for an array).
Pointers and allocatable variables mainly differ in what you can do with them and what the compiler will do with them for you. You can think of allocatables as a sort of "smart pointers" quite similar to std::unique_ptr in C++. Recall what happens in C++ you have new and delete which in turn call malloc and free but you are not allowed to mix them. And you are certainly not allowed to manually modify the address stored in a C++ smart pointer either.
When you send an allocatable variable to a procedure that expects a pointer, anything can happen, it is an undefined behaviour. But, if the internal hidden structure has a similar layout, it may happen that you actually set the allocatable internals to point to some memory that was not allocated through allocatable. You may then think that everything is OK and you have a new feature. However, when the time for deallocation comes, and allocatables are often deallocated automatically, it can easilly fail in very unpredictable ways. It can crash in very strange places of the code, the results can be wrong and so on. Anything can happen.
For example, this extremely ugly program works for me too (in gfortran):
subroutine point(ptr, x)
pointer :: ptr
target :: x
ptr => x
end subroutine
interface
subroutine point(ptr, x)
allocatable :: ptr
target :: x
end subroutine
end interface
allocatable z
y = 1.0
call point(z, y)
print *, z
end
But you should never do stuff like this. It is really something very, very wrong. If you make z a local variable, so that it is deallocated, or if you try to deallocate it, it will crash. That is because the only information the compiler has is the address. Internally, the allocatable really looks the same as a pointer. It is just an address (for a scalar). The only difference is what you are allowed to do with it and what the compiler will do for you automatically.
This won't even crash, because the internal implementation similarities I mentioned. but it is no less wrong.
subroutine point(ptr, x)
pointer :: ptr
target :: x
ptr => x
end subroutine
interface
subroutine point(ptr, x)
allocatable :: ptr
target :: x
end subroutine
end interface
allocatable z
pointer y
allocate(y)
y = 1.0
call point(z, y)
print *, z
deallocate(z)
end
It just survives because both allocatable and pointer use the same internal allocator (malloc) in gfortran and they are both implemented as a simple address.

What's the right way to pass a Fortran zero-length arrays to C?

I have the following kind of subroutine wrapper to pass a Fortran array to a ISO_C_BINDING-bound C function.
subroutine mysub( array )
integer, dimension(:) :: array
call f_mysub( size(array) , array(1) )
end subroutine
The problem is that if the array is of size 0 then array(1) is out-of-bounds. What's the right way to handle this situation?
In general I cannot avoid the call, i.e. with a if( size(array) > 0 ) because the call may be important to register, e.g. it is actually a class method, naturally with different signature than above, and could clear an existing array.
Example Files
The C routine is c_mysub.c.
#include <stdio.h>
void c_mysub( size_t* size, int* arr )
{
printf("size=%d\n",*size);
for(size_t i=0; i<*size; ++i)
{
printf("element %d=%d\n",i,arr[i]);
}
}
The main Fortran file is mysub.f90
module mysub_I
interface
subroutine f_mysub( size, arr) BIND(C,name="c_mysub")
use,intrinsic :: ISO_C_BINDING
integer(C_SIZE_T) :: size
integer(C_INT) :: arr
end subroutine
end interface
end module
module mysub_M
use mysub_I
contains
subroutine mysub( array )
use ISO_C_BINDING
integer, dimension(:) :: array
call f_mysub( int(size(array),C_SIZE_T) , array(1) )
end subroutine
end module
program main
use mysub_M
integer, allocatable :: x(:)
allocate( x(7) )
x=1
call mysub( x )
deallocate( x )
allocate( x(0) )
call mysub( x )
end
Compile the C with gcc -c c_mysub.c and the Fortran with gfortran -fbounds-check c_mysub.o mysub.f90, which gives the following error when you run the code, balking at the second call with size=0.
size=7
0:1
1:1
2:1
3:1
4:1
5:1
6:1
At line 18 of file mysub.f90
Fortran runtime error: Index '1' of dimension 1 of array 'array' above upper bound of 0
Compiling with bounds check off behaves as expected.
size=7
0:1
1:1
2:1
3:1
4:1
5:1
6:1
size=0
I do not see any reason to pass array(1) as actual argument. The whole array array should be passed.
call f_mysub( size(array) , array )
and the interface must be changed to pass an array and not just a scalar
integer(C_INT) :: arr(*)
Passing the first element (even to an array argument) could easily cause incorrect behaviour if array is not contiguous - which is theoretically possible given it is assumed shape dummy argument (with (:)).
If you pass the whole array and size 0 then just make sure no element is actually dereferenced from the pointer in the C procedure (which should already be the case if it is well-written).

Pointer to subarray defined by a map

I want to define a pointer to a subarray. For a simple range this is easily done by pointer => array(i:j), but I can't figure out how to do this for a map like k=[k1,k2,k3]. If I would define another array I could use a loop like array2=[(array1(k(j)),j=1,size(k,1))]. But it isn't possible to assign a pointer in a similar way (pointer => [(array1(k(j)),j=1,size(k,1))]) since the r.h.s. of the expression seems to define another variabel which then not even has the target attribute. For simple tasks, a trick around this, is to first assign a pointer to the total array an to use the map on the readout. But in my case this doesn't seem to be possible.
I will attach to examples: The first one shows what I described above. The second one is a more complicated example, where the trick doesn't work anymore. And in addition a two dimensional map is required.
Minimal example:
program test
integer, parameter :: n=10,n_k=3
real,target :: a(1:n)
real :: b(1:n_k)
integer :: k(1:n_k)
integer :: j
real,pointer :: p(:)
! fill array a and define map k:
a=[(real(j),j=1,n)]
k=[((j+1)*2,j=1,n_k)]
! can be used to print the arrays:
!write(*,*) a
!write(*,*) k
! can be used to write only the part of a defined by k:
!write(*,*) (a(k(j)),j=1,n_k)
! this an similar things didn't work:
!p(1:n_k) => [(a(k(j)),j=1,n_k)]
! works, but not generally:
p => a
write(*,*) (p(k(j)),j=1,n_k)
! works, only for arrays:
b=(/(a(k(j)),j=1,n_k)/)
write(*,*) b
end program
More complicated (but also kind of minimal) example which shows (hopefully) the problem I really have. For an easy understanding some explanation leads through it. There are plenty of write commands to print the arrays. I appreciate for the amount of code, but I really don't see how to make a shorter and understandable working example:
module mod1
type base
real :: a
end type
type,extends(base) :: type1
end type
type,extends(base) :: type2
type(type1),allocatable :: b(:)
end type
type(type2),allocatable,target :: c(:)
contains
subroutine printer(z)
class(*),pointer,dimension(:) :: z
integer :: j,a_z,n_z
character(len=40) :: f,ff='(F10.2,1x))',form_z
! define format for printing:
a_z=lbound(z,1)
n_z=ubound(z,1)
write(f,'(I0)') (n_z-a_z+1)
form_z="("//trim(adjustl(f))//ff
! writing:
select type(z)
class is (base)
write(*,form_z) (z(j)%a,j=a_z,n_z)
end select
end subroutine
end module
program test
use mod1
integer,parameter :: n_b=8,n_c=6,n_js=3,n_ls=2
integer :: js(1:n_js),ls(1:n_ls)
integer :: j,l
class(*),pointer :: p(:)
character(len=40) :: f,ff='(F10.2,1x))',form_c,form_b
! define format for printing:
write(f,'(I0)') n_b
form_b="("//trim(adjustl(f))//ff
write(f,'(I0)') n_c
form_c="("//trim(adjustl(f))//ff
! creating and filling the arrays:
allocate(c(n_c))
c%a=[(2d0*real(j),j=1,n_c)]
do j=1,n_c
allocate(c(j)%b(n_b))
c(j)%b%a=[(real(l)*1d1**(j-1),l=1,n_b)]
end do
! write arrays to compare later:
write(*,form_c) c%a
write(*,*)
write(*,form_b) (c(j)%b%a,j=1,n_c)
write(*,*)
! denfining two maps (size and entries will be input in the final program):
js=[1,4,6]
ls=[2,7]
! using the maps to print only the desired entries:
write(*,*) (c(js(j))%a,j=1,n_js)
write(*,*)
write(*,*) ((c(js(j))%b(ls(l))%a,j=1,n_js),l=1,n_ls)
write(*,*)
! !!! here I want to use the maps as well, but so far I only know how to use ranges:
p => c(1:4)
call printer(p)
write(*,*)
p => c(2)%b(3:6)
call printer(p)
write(*,*)
end program
Edit:
Just for the record, I solved the problem now by using arrays of derived types including pointers and slightly changing the calling subroutines.
You cannot do this with pointer association (e.g. pointer1 => array1(vector_subscript). Section 7.2.2.2 of the Fortran 2008 standard that disallows this is:
R733 pointer-assignment-stmt is data-pointer-object [ (bounds-spec-list) ] => data-target
There are two other forms, but they do not match your use, nor would they change the outcome. Reading further:
R737 data-target is variable
C724 (R737) A variable shall have either the TARGET or POINTER attribute, and shall not be an array section with a vector subscript.
This is why you cannot perform the pointer association your are attempting. You can however work around this and with pointer allocation. See this code:
n_k = 3
k = [((j+1)*2,j=1,n_k)] ! a vector subscript
p => a(k) ! NOT OK. Violates C724
allocate(p(n_k)) ! Associate your pointer this way
p = a(k) ! This is OK.
write(*,*) p
Which yields (wrapped in your example program):
% ./ptrtest
4.00000000 6.00000000 8.00000000
This allocates p to be the proper size and then assigns from a with a vector subscript. This gets around the issue of directly associating p with a map of a. This snippet assumes the variables are declared and initialized per your example code. This shows that you can assign a vector subscript of an array to a pointer, but only one that is already associated, not during the association.
As noted in a comment to your Q, if you have a regular stride, you can make the pointer association directly. For your first test case, this would be equivalent and work:
p => a(4:2:8) ! Allocation to a strided array is allowed
If however, you have an irregular vector subscript then the method in this answer will be what you need to use to accomplish the pointer association.
Another workaround you can use is passing a pointer and the map to a procedure. Consider the following code:
program test
implicit none
integer, parameter :: nx = 10, nx_m = 3
integer,dimension(nx_m) :: x_map
integer :: i
real, dimension(nx),target :: a
real, dimension(:), pointer :: p
! initialize array
a = [(real(i*2),i=1,10)]
write (*,'(10(f5.1 x))') a
!define a map
x_map = [1, 9, 4]
! associate pointer
p => a
call print_map(p, x_map)
contains
subroutine print_map(apointer, map)
implicit none
real, dimension(:), pointer :: apointer
integer, dimension(:) :: map
write (*,*) apointer(map)
end subroutine print_map
end program test
In this case, p "knows" about a and the map of elements in a can be calculated in the caller. Rather than associating (=>) p as a map of a (which cannot be done), p is associated to a and the map passed along with it.
This code produces the output:
% ./ptrtest3
2.0 4.0 6.0 8.0 10.0 12.0 14.0 16.0 18.0 20.0
2.00000000 18.0000000 8.00000000

How to declare an array variable and its size mid-routine in Fortran

I would like to create an array with a dimension based on the number of elements meeting a certain condition in another array. This would require that I initialize an array mid-routine, which Fortran won't let me do.
Is there a way around that?
Example routine:
subroutine example(some_array)
real some_array(50) ! passed array of known dimension
element_count = 0
do i=1,50
if (some_array.gt.0) then
element_count = element_count+1
endif
enddo
real new_array(element_count) ! new array with length based on conditional statement
endsubroutine example
Your question isn't about initializing an array, which involves setting its values.
However, there is a way to do what you want. You even have a choice, depending on how general it's to be.
I'm assuming that the element_count means to have a some_array(i) in that loop.
You can make new_array allocatable:
subroutine example(some_array)
real some_array(50)
real, allocatable :: new_array(:)
allocate(new_array(COUNT(some_array.gt.0)))
end subroutine
Or have it as an automatic object:
subroutine example(some_array)
real some_array(50)
real new_array(COUNT(some_array.gt.0))
end subroutine
This latter works only when your condition is "simple". Further, automatic objects cannot be used in the scope of modules or main programs. The allocatable case is much more general, such as when you want to use the full loop rather than the count intrinsic, or want the variable not as a procedure local variable.
In both of these cases you meet the requirement of having all the declarations before executable statements.
Since Fortran 2008 the block construct allows automatic objects even after executable statements and in the main program:
program example
implicit none
real some_array(50)
some_array = ...
block
real new_array(COUNT(some_array.gt.0))
end block
end program example
Try this
real, dimension(50) :: some_array
real, dimension(:), allocatable :: other_array
integer :: status
...
allocate(other_array(count(some_array>0)),stat=status)
at the end of this sequence of statements other_array will have the one element for each element of some_array greater than 0, there is no need to write a loop to count the non-zero elements of some_array.
Following #AlexanderVogt's advice, do check the status of the allocate statement.
You can use allocatable arrays for this task:
subroutine example(some_array)
real :: some_array(50)
real,allocatable :: new_array(:)
integer :: i, element_count, status
element_count = 0
do i=lbound(some_array,1),ubound(some_array,1)
if ( some_array(i) > 0 ) then
element_count = element_count + 1
endif
enddo
allocate( new_array(element_count), stat=status )
if ( status /= 0 ) stop 'cannot allocate memory'
! set values of new_array
end subroutine
You need to use an allocatable array (see this article for more on it). This would change your routine to
subroutine example(input_array,output_array)
real,intent(in) :: input_array(50) ! passed array of known dimension
real, intent(out), allocatable :: output_array(:)
integer :: element_count, i
element_count = 0
do i=1,50
if (some_array.gt.0) element_count = element_count+1
enddo
allocate(output_array(element_count))
end subroutine
Note that the intents may not be necessary, but are probably good practice. If you don't want to call a second array, it is possible to create a reallocate subroutine; though this would require the array to already be declared as allocatable.

Share allocatable Arrays

I have some allocatable arrays which I need to share between some subroutines. I usually would just pass them as arguments or maybe write everything in a Module, but I'm afraid this isn't possible in my situation.
I only write some own subroutines and use subroutines provided and described by an FEM-Solver. So i cannot alter the arguments of this subroutines or wrap them in a Module.
As far as i know it also isn't possible to Build common blocks with array of unknown size at compile time.
Is there something else to pass my arrays?
Update:
At the moment my program environment looks like this:
I have a subroutine, provided by the FEM-program, which is called after each increment, this calls several of my subroutines where I compute some values for each node or for a subset of those.
To display these values in the post-Simulation, i have to pass them to another subroutine. This subroutine is called by the FEM-solver for each node at the end of the increment. So shifting my code to this Subroutine would produce a lot of overhead.
My idea is to compute the values once, store the Values in an array and pass this array to the second subroutine where they will be written to the database of the computation.
Update
Some Pseudo-code:
Assumed from program behaviour:
Program FEM-solver
*magic*
call ENDINC(ar1,ar2)
*something*
do NodeID=1,Sum_Of_Nodes
do valueID=1,Sum_Of_User_Computed_Values !(defined in preprocessing)
call nodeval(NodeID,valueID,Value,ar3,...,arN)
end do
end do
*voodoo*
end program FEM-solver
Written and working:
Subroutine ENDINC(ar1,ar2)
*Computation of some node values*
*Calling of own Subroutines, which compute more values*
*Writing an array with results values for some/each node(s)*
nodersltArr(NodeID,rslt)=*some Value*
end Subroutine ENDINC
Needed, writng the computed Values to the Node solution database:
Subroutine nodeval(NodeID,valueID,Value,ar3,...,arN)
*called for each NodeID and valueID*
value=noderslArr(NodeID,valueID)
end subroutine nodeval
You can pass an allocatable array to procedure that isn't declared to use allocatable arrays, as long as the array is allocated before the call. (Of course, you can't use the array as an allocatable array in the procedure in which it is declared without that property.) Perhaps that will solve your problem. Allocate the array in the code that you write, than pass it as an argument to the FEM solver.
Example code: (I'd normally put the function into a module but you say that you can't do that, so I write an example showing the case of not using a module.)
function MySum ( RegArray )
real :: MySum
real, dimension (:), intent (in) :: RegArray
MySum = sum (RegArray)
end function MySum
program TestArray
implicit none
interface AFunc
function MySum ( SomeArray )
real :: MySum
real, dimension (:), intent (in) :: SomeArray
end function MySum
end interface AFunc
real, dimension (:), allocatable :: AllocArray
integer :: N
real :: answer
write (*, '("Input array size: ")', advance="no")
read (*, *) N
allocate ( AllocArray (1:N) )
AllocArray = 1.0
answer = MySum ( AllocArray )
write (*, *) answer
end program TestArray
---------- EDIT: Second Concept ---------
Sharing an allocatable array between two subroutines, without the calling routine being "aware" of the array.
module MySubs
real, allocatable, dimension (:,:) :: array
contains
subroutine One ( x, y, ... N, M )
integer, intent (in) :: N, M
if ( .NOT. allocated (array) ) allocate ( array (N, M) )
end subroutine One
subroutine Two ( .... )
end subroutine Two
end module MySubs
UPDATE: note: This approach can be used to pass information between the two routines without the main program having access the module ... for the question, without modifying the original main prpgram. Part of the example is how to allocate the arrays: the example does that by having the subroutine that would first use the array test whether the array is allocated -- if not, it allocates the array.
The three examples below all work with gfortran. The second may fail on some compilers as it uses a F2003 feature (allocatable dummy arguments), and not all compilers are 100% F2003 compliant. However, most implement ISO TR 15581 (which includes this feature).
First version, you can use a common pointer to allocatable array.
program hip
implicit none
double precision, dimension(:, :), pointer :: p
common /hiphop/ p
double precision, allocatable, dimension(:, :), target :: a
allocate(a(100, 100))
a(1, 1) = 3.1416d0
p => a
call hop
deallocate(a)
end program
subroutine hop
implicit none
double precision, dimension(:, :), pointer :: p
common /hiphop/ p
print *, size(p, 1), size(p, 2), p(1, 1)
end subroutine
Second version, allocating in a subroutine then calling another. One still needs to declare the array in main program.
program hip
implicit none
interface
subroutine hip_alloc(arr)
double precision, allocatable, dimension(:, :) :: arr
end subroutine
end interface
double precision, dimension(:, :), pointer :: p
common /hiphop/ p
double precision, allocatable, dimension(:, :) :: a
p => null()
print *, "a:", allocated(a)
print *, "p:", associated(p)
call hip_alloc(a)
print *, "a:", allocated(a)
print *, "p:", associated(p)
call hop
deallocate(a)
end program
subroutine hip_alloc(arr)
implicit none
double precision, dimension(:, :), pointer :: p
common /hiphop/ p
double precision, allocatable, dimension(:, :), target :: arr
allocate(arr(100, 100))
arr(1, 1) = 3.1416d0
p => arr
end subroutine
subroutine hop
implicit none
double precision, dimension(:, :), pointer :: p
common /hiphop/ p
print *, size(p, 1), size(p, 2), p(1, 1)
end subroutine
Third version, here we first call a function returning a pointer, then pass this pointer to a subroutine through a common. The function does the allocation, as in second example. The pointer is deallocated in main program, but could be elsewhere.
program hip
implicit none
interface
function hip_alloc(n)
integer :: n
double precision, dimension(:, :), pointer :: hip_alloc
end function
end interface
double precision, dimension(:, :), pointer :: p
common /hiphop/ p
p => null()
print *, "p:", associated(p)
p => hip_alloc(100)
print *, "p:", associated(p)
call hop
deallocate(p)
end program
function hip_alloc(n)
implicit none
integer :: n
double precision, dimension(:, :), pointer :: hip_alloc
allocate(hip_alloc(n, n))
hip_alloc(1, 1) = 3.1416d0
end function
subroutine hop
implicit none
double precision, dimension(:, :), pointer :: p
common /hiphop/ p
print *, size(p, 1), size(p, 2), p(1, 1)
end subroutine
I do not understand why writing a MODULE would not work, but have you considered CONTAINS? Everything above the CONTAINS declaration is visible to the subroutines below the CONTAINS:
PROGRAM call_both
INTEGER,DIMENSION(2) :: a, b
a = 1
b = 2
PRINT *,"main sees", a, b
CALL subA
CALL subB
CONTAINS
SUBROUTINE subA
PRINT *,"subA sees",a,b
END SUBROUTINE subA
SUBROUTINE subB
PRINT *,"subB sees",a,b
END SUBROUTINE subB
END PROGRAM call_both
The output would be
main sees 1 1 2 2
subA sees 1 1 2 2
subB sees 1 1 2 2
This works with ALLOCATABLE arrays as well.

Resources