Let's say we have several different contiguous arrays
real :: a1(2),a2(2),a3(2)
real :: b1(2,2), b2(2,2),b3(2,2)
real :: c1(3,3,3), c2(3,3,3),c3(3,3,3)
and a subroutine
subroutine mtpy(x,y,z)
real,contiguous, intent(in) :: x(:), y(:)
real, intent(out) :: z(size(x))
z=x*y
end subroutine mtpy
How to use mtpy in the following series of calls:
call mtpy(a1,a2,a3)
call mtpy(b1,b2,b3)
call mtpy(c1,c2,c3)
Obviously, this is going to cause the compiler errors as the shape of the actual and dummy arguments do not match. In cases like these, I used to declare several specific procedures that each handles a specific shape and then wrap all of them using an interface. However, this is quite tedious (Imagine having huge amount of simple elemental function and pure procedures that treat multidimensional arrays (with up to three dimensions) as single dimension arrays and then providing instances such as sub_1d, sub_2d, sub_3d, .. for each of them despite all of them actually doing the same job).
One partial solution is to, I suppose, use RESHAPE
call mtpy(reshape(b1,[4]),reshape(b2,[4]),bb)
but, can I be certain that the compiler (I am interested in gfortran and ifort mostly) won't start creating 1d temporaries to hold the reshaped b1 and b2 arrays?
Now, I am also aware that one can declare an array pointer such as
real, pointer, contiguous :: p1(:),p2(:),p3(:)
and make the following pointer assignment such as
p1(1:size(c1))=>c1
However, this approach has a drawback that I need to declare the original arrays as targets. Isn't this going to impact on the optimisations the compiler is going to be able to perform?
Yet another solution is, I suppose, to use assumed size arrays, but I noticed that Metcalf et al call their usage 'deprecated' and again, I am not sure about the impact on omptimisations.
So, is there a simple way of treating a multi-dimensional fortran array as a single dimension array (in a subroutine, or a fuction) which does not impose unnecessary assumptions (such as TARGET) on that array? If I can use RESHAPE without fear of creating temporaries (I am only dealing with contiguous arrays) I'd go for that. Any suggestions?
The future Fortran 2018 standard will provide assumed-rank arrays (that will allow to receive arrays of any rank) and a select rank construct that will easily allow to address situations like this with one assumed-rank array (see, e.g., The new features of Fortran 2018 starting on page 16), and with more difficulty with multiple assumed-rank arrays.
Assumed-size arrays, while not fashionable or recommended are valid, non-obsolescent features of the current standard (Fortran 2008), as well as of the next standard draft (Fortran 2018), so they can be used if needed. Since a lot of Fortran 77 code depends on this, and much of it is decades old, I would expect it to be significantly optimised in most compilers.
However, you don't need to use assumed-size arrays, you can use explicit-shape arrays (arrays with explicit dimensions), and as long as the array actual arguments have enough elements the code will be valid, since, according to paragraph 4 of section 12.5.2.11 of the 2008 standard,
An actual argument that represents an element sequence and corresponds to a dummy argument that is an array is sequence associated with the dummy argument if the dummy argument is an explicit-shape or assumed-size array. The rank and shape of the actual argument need not agree with the rank and shape of the dummy argument, but the number of elements in the dummy argument shall not exceed the number of elements in the element sequence of the actual argument. If the dummy argument is assumed-size, the number of elements in the dummy argument is exactly the number of elements in the element sequence.
So you could
call mtpy(a1,a2,a3,size(a3))
call mtpy(b1,b2,b3,size(b3))
call mtpy(c1,c2,c3,size(c3))
...
subroutine mtpy(x,y,z,n)
integer, intent(in) :: n
real, intent(in) :: x(n), y(n)
real, intent(out) :: z(n)
z=x*y
end subroutine mtpy
Because I'm also not sure whether reshape() makes a temporary array even for contiguous cases, I've tried printing the address of the original and passed arrays by c_loc(). Then, even for small 1-dimensional arrays, reshape() in both gfortran-8 and ifort-16 seems to create temporaries (because the address of the first element is different). So, it seems safer to assume that temporaries are created even for simple cases (for more info, please see comments by francescalus below.)
module test
use iso_c_binding, only: c_loc
implicit none
interface linear
module procedure linear_r2d, linear_r3d
endinterface
contains
subroutine calc_ver1( a ) !! assumed-shape dummy array
real, contiguous, target :: a(:)
print *, "addr = ", c_loc( a(1) )
print *, "vals = ", a
endsubroutine
subroutine calc_ver2( a, n ) !! explicit-shape dummy array
integer :: n
real, target :: a( n )
print *, "addr = ", c_loc( a(1) )
print *, "vals = ", a
endsubroutine
function linear_r2d( a ) result( ptr ) !! returns a 1-d pointer from 2-d array
real, contiguous, target :: a(:,:)
real, contiguous, pointer :: ptr(:)
ptr( 1 : size(a) ) => a
endfunction
function linear_r3d( a ) result( ptr ) !! returns a 1-d pointer from 3-d array
real, contiguous, target :: a(:,:,:)
real, contiguous, pointer :: ptr(:)
ptr( 1 : size(a) ) => a
endfunction
endmodule
program main
use test
implicit none
integer i
real, target :: a(2), b(2,2), c(2,2,2)
a = [1,2]
b = reshape( [( 2*i, i=1,4 )], [2,2] )
c = reshape( [( 3*i, i=1,8 )], [2,2,2] )
print *, "addr(a) = ", c_loc( a(1) )
print *, "addr(b) = ", c_loc( b(1,1) )
print *, "addr(c) = ", c_loc( c(1,1,1) )
print *, "[ use assumed-shape dummy ]"
call calc_ver1( a )
! call calc_ver1( b ) ! rank mismatch
! call calc_ver1( c ) ! rank mismatch
print *, "--- with reshape() ---"
call calc_ver1( reshape( b, [size(b)] ) )
call calc_ver1( reshape( c, [size(c)] ) )
print *, "--- with linear() ---"
call calc_ver1( linear( b ) )
call calc_ver1( linear( c ) )
print *
print *, "[ use explicit-shape dummy ]"
call calc_ver2( a, size(a) )
call calc_ver2( b, size(b) )
call calc_ver2( c, size(c) )
end
Result of ifort-16 on Linux:
addr(a) = 7040528
addr(b) = 7040544
addr(c) = 7040560
[ use assumed-shape dummy ]
addr = 7040528
vals = 1.000000 2.000000
--- with reshape() ---
addr = 140736361693536
vals = 2.000000 4.000000 6.000000 8.000000
addr = 140736361693560
vals = 3.000000 6.000000 9.000000 12.00000 15.00000 18.00000 21.00000 24.00000
--- with linear() ---
addr = 7040544
vals = 2.000000 4.000000 6.000000 8.000000
addr = 7040560
vals = 3.000000 6.000000 9.000000 12.00000 15.00000 18.00000 21.00000 24.00000
[ use explicit-shape dummy ]
addr = 7040528
vals = 1.000000 2.000000
addr = 7040544
vals = 2.000000 4.000000 6.000000 8.000000
addr = 7040560
vals = 3.000000 6.000000 9.000000 12.00000 15.00000 18.00000 21.00000 24.00000
Result of gfortran-8 on OSX10.11:
addr(a) = 140734555734776
addr(b) = 140734555734752
addr(c) = 140734555734720
[ use assumed-shape dummy ]
addr = 140734555734776
vals = 1.00000000 2.00000000
--- with reshape() ---
addr = 140734555734672
vals = 2.00000000 4.00000000 6.00000000 8.00000000
addr = 140734555733984
vals = 3.00000000 6.00000000 9.00000000 12.0000000 15.0000000 18.0000000 21.0000000 24.0000000
--- with linear() ---
addr = 140734555734752
vals = 2.00000000 4.00000000 6.00000000 8.00000000
addr = 140734555734720
vals = 3.00000000 6.00000000 9.00000000 12.0000000 15.0000000 18.0000000 21.0000000 24.0000000
[ use explicit-shape dummy ]
addr = 140734555734776
vals = 1.00000000 2.00000000
addr = 140734555734752
vals = 2.00000000 4.00000000 6.00000000 8.00000000
addr = 140734555734720
vals = 3.00000000 6.00000000 9.00000000 12.0000000 15.0000000 18.0000000 21.0000000 24.0000000
And I also think that explicit-shape dummy arrays are useful depending on cases, and the code in the Question seems precisely the case. (Because the actual argument is contiguous, there is no array temporary created.) If the size argument n in calc_ver2() is not desired, we could use a function that returns a 1-d array pointer (see linear() above), but I guess this may be overkill considering the simplicity of calc_ver2()... (By the way, I've attached target in various places in the code, which is simply because c_loc() requires it).
Related
I want to add elements to a 1d matrix mat, subject to a condition as in the test program below. In Fortran 2003 you can add an element
mat=[mat,i]
as mentioned in the related question Fortran array automatically growing when adding a value. Unfortunately, this is very slow for large matrices. So I tried to overcome this, by writing the matrix elements in an unformatted file and reading them afterwards. This turned out to be way faster than using mat=[mat,i]. For example for n=2000000_ilong the run time is 5.1078133666666661 minutes, whereas if you store the matrix elements in the file the run time drops to 3.5234166666666665E-003 minutes.
The problem is that for large matrix sizes the file storage.dat can be hundreds of GB...
Any ideas?
program test
implicit none
integer, parameter :: ndig=8
integer, parameter :: ilong=selected_int_kind(ndig)
integer (ilong), allocatable :: mat(:)
integer (ilong), parameter :: n=2000000_ilong
integer (ilong) :: i, cn
logical, parameter :: store=.false.
real(8) :: z, START_CLOCK, STOP_CLOCK
open(1, file='storage.dat',form='unformatted')
call cpu_time(START_CLOCK)
if(store) then
cn=0
do i=1,n
call random_number(z)
if (z<0.5d0) then
write(1) i
cn=cn+1
end if
end do
rewind(1); allocate(mat(cn)); mat=0
do i=1,cn
read(1) mat(i)
end do
else
allocate(mat(1)); mat=0
do i=1,n
call random_number(z)
if (z<0.5d0) then
mat=[mat,i]
end if
end do
end if
call cpu_time(STOP_CLOCK)
print *, 'run took:', (STOP_CLOCK - START_CLOCK)/60.0d0, 'minutes.'
end program test
If the data file has hundreds of gigabytes, than there can may be no solution available at all, because you need so much RAM memory anyway for your array. Maybe you made the mistake of storing the data as text and then the memory size will be somewhat lower, but still tens of GB.
What is often done, when you need to add elements one-by-one and you do not know the final size, is growing the array geometrically in steps. That means pre-allocate an array to size N. When the array is full, you allocate a new array of size 2*N. When the array is full again, you allocate it to 4*N. And so on. Either you are finished or you exhausted all your memory.
Of course, it is often best to know the size of the array beforehand, but in some algorithms you simply do not have the information.
Maybe you need a dynamic container such as C++'s std::vector, with a push_back() function.
The following is a simplified version. You probably ought to check the allocation to make sure that you don't run out of addressable memory.
Note the need for random_seed.
module container
use iso_fortran_env
implicit none
type array
integer(int64), allocatable :: A(:)
integer(int64) num
contains
procedure push_back
procedure print
end type array
interface array ! additional constructors
procedure array_constructor
end interface array
contains
!----------------------------------------------
function array_constructor() result( this ) ! performs initial allocation
type(array) this
allocate( this%A(1) )
this%num = 0
end function array_constructor
!----------------------------------------------
subroutine push_back( this, i )
class(array), intent(inout) :: this
integer(int64) i
integer(int64), allocatable :: temp(:)
if ( size(this%A) == this%num ) then ! Need to resize
allocate( temp( 2 * this%num ) ) ! <==== for example
temp(1:this%num ) = this%A
call move_alloc( temp, this%A )
! print *, "Resized to ", size( this%A ) ! debugging only!!!
end if
this%num = this%num + 1
this%A(this%num) = i
end subroutine push_back
!----------------------------------------------
subroutine print( this )
class(array), intent(in) :: this
write( *, "( *( i0, 1x ) )" ) ( this%A(1:this%num) )
end subroutine print
end module container
!=======================================================================
program test
use iso_fortran_env
use container
implicit none
type(array) mat
integer(int64) :: n = 2000000_int64
integer(int64) i
real(real64) z, START_CLOCK, STOP_CLOCK
mat = array() ! initial trivial allocation
call random_seed ! you probably need this
call cpu_time(START_CLOCK)
do i = 1, n
call random_number( z )
if ( z < 0.5_real64 ) call mat%push_back( i )
end do
call cpu_time(STOP_CLOCK)
print *, 'Run took ', ( STOP_CLOCK - START_CLOCK ) / 60.0_real64, ' minutes.'
! call mat%print ! debugging only!!!
end program test
I need to call some fortran code that dynamically allocates arrays similar to this basic example. (unlike this example in the code I'm working with the size of the array is not known at the beginning of the function)
subroutine getIdentity(n,I)
integer, intent(in) :: n
integer, allocatable,dimension(:,:), intent(out) :: I
integer :: j,k
write(*,*) "creating " ,n, "x", n, "identity matrix"
allocate(I(n,n))
do j=1,n
do k=1,n
if(k==j) then
I(j,k) = 1
else
I(j,k) = 0
end if
end do
end do
end subroutine getIdentity
When I call this with this julia code:
I = zeros(Int32,1,1)
n = Ref{Int32}(3)
ccall((:__myModule_MOD_getidentity,"./test.so"), Cvoid ,
(Ref{Int32},Ref{Int32}), n,I)
println(I)
When I look at I in julia it is just garbage, not the Identity matrix I would expect. What would be the correct way to do this?
I am trying to pass an array of strings from C to a Fortran subroutine as well as from Fortran to that same Fortran subroutine. I have managed to pass single strings (i.e. 1D character arrays) successfully from both C and Fortran. However, I'm having trouble with arrays of strings. I am using ISO C binding on the Fortran side, and ideally I'd like this to be as seamless as possible on the calling side.
I have read some related questions and answers. Some, (i.e. this and this) are simply "Use ISO C" without further details, which doesn't help much. This answer was very helpful (similar answer to a different question), but only works for single strings, where it seems that the c_null_char is recognized in the single Fortran string. I can't figure out what to do for the array case without having two separate routines.
What I currently have is a C routine which I want to pass the array of strings (string) from:
#include <iostream>
extern "C" void print_hi_array(char input_string[][255]);
using namespace std;
int main() {
char string[3][255] = {"asdf","ghji","zxcv"};
print_hi_array(string);
return 0;
}
And, a similar Fortran routine:
program main
implicit none
call print_hi_array( (/"asdf", "ghji", "zxcv"/) )
end program
Thus far, this is what I have for the receiving end:
subroutine print_hi_array(input_string) bind(C)
use iso_c_binding, only: C_CHAR, c_null_char
implicit none
character (kind=c_char, len=1), dimension (3,255), intent (in) :: input_string
character (len=255), dimension (3) :: regular_string
character (len=255) :: dummy_string
integer :: i,j,k
write (*,*) input_string
do j = 1 , 3
dummy_string(:) = c_null_char
k = 1
do i = 1 + (j-1)*255, j*255,1
if (input_string(i) .ne. c_null_char) then
write (*,*) "i ",i,j, input_string(i)
dummy_string(k:k) = input_string(i)
endif
k = k +1
enddo
regular_string(j) = dummy_string
enddo
write (*,*) regular_string
end subroutine print_hi_array
This works for the C function; I get this output:
asdfghjizxcv
j= 1
i 1 1 a
i 2 1 s
i 3 1 d
i 4 1 f
j= 2
i 256 2 g
i 257 2 h
i 258 2 j
i 259 2 i
j= 3
i 511 3 z
i 512 3 x
i 513 3 c
i 514 3 v
asdf ghji zxcv
However, when it's done through Fortran I get nonsense out:
asdfghjizxcv#O,B�#(P,B�]B]6(P,B�# .......
It seems there is no c_null_char in this approach.
So, how can I write a Fortran subroutine to take in arrays of strings from both C and Fortran?
Fortran uses spaces to fill the rest of the string if it is declared longer than its stored text. It is not zero delimited, the declared length is stored in a hidden variable. It does not contain c null char and therefore you are reading some garbage (buffer overflow). What Fortran should print when tlit prints a string with \000 is undefined by the standard and depends on the implementation.
In particular, you are also passing a character(4) array with dimension 3 to a subroutine that expects much more data (255 chars, though I am not shure about the index order). Only pointers are passed so I think it can not be checked.
It is possible to define the length of the strings in the array constructor this way:
[character(255) :: "a","ab","abc"]
I see actually two ways to do that. Either, you write a loop in C and pass the strings one by one to Fortran, as you already did it before. Alternatively, if you want to pass the entire array and you want to handle the Fortran and the C arrays with the same routine, you will have to make an appropriate copy of your C-string array. Below a working, but not too much tested example:
extern "C" void print_array_c(int nstring, char input_string[][255]);
using namespace std;
int main() {
char string[3][255] = {"asdf","ghji","zxcv"};
print_array_c(3, string);
return 0;
}
Please note that I also pass the number of the strings, so that the example can handle arrays with various sizes. (The length of the strings is, however, assumed to be 255 characters.) On the Fortran size, one would need a routine to convert it Fortran strings. One possible visualization could be:
module arrayprint_module
use, intrinsic :: iso_c_binding
implicit none
integer, parameter :: STRLEN = 255
contains
!> The printing routine, works with Fortran character arrays only.
subroutine print_array(strings)
character(len=STRLEN), intent(in) :: strings(:)
integer :: ii
do ii = 1, size(strings)
write(*,*) ii, strings(ii)
end do
end subroutine print_array
!> Converts C string array to Fortran string array and invokes print_array.
subroutine print_array_c(nstring, cptr) bind(C)
integer(c_int), value :: nstring
type(c_ptr), intent(in), value :: cptr
character(kind=c_char), pointer :: fptr(:,:)
character(STRLEN), allocatable :: fstrings(:)
integer :: ii, lenstr
call c_f_pointer(cptr, fptr, [ STRLEN, nstring ])
allocate(fstrings(nstring))
do ii = 1, nstring
lenstr = cstrlen(fptr(:,ii))
fstrings(ii) = transfer(fptr(1:lenstr,ii), fstrings(ii))
end do
call print_array(fstrings)
end subroutine print_array_c
!> Calculates the length of a C string.
function cstrlen(carray) result(res)
character(kind=c_char), intent(in) :: carray(:)
integer :: res
integer :: ii
do ii = 1, size(carray)
if (carray(ii) == c_null_char) then
res = ii - 1
return
end if
end do
res = ii
end function cstrlen
end module arrayprint_module
Please note, that the array you pass from C must be contigous for this to work and I assumed that the character(kind=c_char) is compatible with the fortran character type, which usually it should be.
One approach which I've come up with is to modify the calling Fortran routine to also use ISO C binding:
program main
use iso_c_binding, only: C_CHAR
implicit none
character (kind=c_char, len=255), dimension (3) :: input_string
input_string = (/ "asdf", "ghji", "zxcv" /)
call print_hi_array(input_string)
end program
I've just stumbled upon the fact that compiler lets me use integer arrays as indices to other arrays. For example:
implicit none
real*8 :: a(3), b(2)
integer :: idx(2)
a=1.d0
idx=(/1,2/)
b = a(idx)
print*,shape(b)
print*,b
print*
end
Given the fact that this seems to work with both gfortan and a PGI compiler, I'm wondering if this a language feature rather than something compiler just lets me out with. I would appreciate if somebody more knowledgeable than me can comment if this is really a language feature.
And if it is, than I'd appreciate if somebody would spell out the exact language rules of how such constructions are interpreted in multidimensional case, like here:
implicit none
real*8 :: aa(3,3), bb(2,2)
integer :: idx(2)
do i=1,3 ; do j=1,3
aa(i,j) = 1.d0*(i+j)
enddo; enddo
bb=aa(idx,idx)
print*,shape(bb)
print*,bb
end
Yes, it is.
The final draft of the Fortran 2008 standard, ISO/IEC JTC 1/SC 22/WG 5/N1830, ftp://ftp.nag.co.uk/sc22wg5/N1801-N1850/N1830.pdf says on page 84
4.8 Construction of array values
...
6 If an ac-value is an array expression, the values of the elements of the expression, in array element order (6.5.3.2), specify the corresponding sequence of elements of the array constructor.
Example
real, dimension(20) :: b
...
k = (/3, 1, 4/)
b(k) = 0.0 ! section b(k) is a rank-one array with shape (3) and
! size 3. (0.0 is assigned to b(1), b(3), and b(4).)
The rules you can see directly from your code
implicit none
real*8 :: aa(3,3), bb(2,2)
integer :: idx(2),i,j,k
idx=(/3, 2/)
k=0
do i=1,3 ; do j=1,3
k=k+1
aa(i,j) = aa(i,j)+1.d0*k
enddo; enddo
write(*,*),shape(aa)
write(*,'(3G24.6,2X)') aa
bb=aa(idx,idx)
print*,shape(bb)
write(*,'(2G24.6,2X)'),bb
end
Output:
3 3
1.00000 4.00000 7.00000
2.00000 5.00000 8.00000
3.00000 6.00000 9.00000
2 2
9.00000 6.00000
8.00000 5.00000
I am trying to write a wrapper for 'allocate' function, i.e. function which receives an array and dimensions, allocates memory and returns allocated array. The most important thing is that the function must work with arrays of different rank. But I have to explicitly state rank of array in function interface, and in this case code only compiles if I pass arrays of certain rank as a parameter. For example, this code does not compile:
module memory_allocator
contains
subroutine memory(array, length)
implicit none
real(8), allocatable, intent(out), dimension(:) :: array
integer, intent(in) :: length
integer :: ierr
print *, "memory: before: ", allocated(array)
allocate(array(length), stat=ierr)
if (ierr /= 0) then
print *, "error allocating memory: ierr=", ierr
end if
print *, "memory: after: ", allocated(array)
end subroutine memory
subroutine freem(array)
implicit none
real(8), allocatable, dimension(:) :: array
print *, "freem: before: ", allocated(array)
deallocate(array)
print *, "freem: after: ", allocated(array)
end subroutine freem
end module memory_allocator
program alloc
use memory_allocator
implicit none
integer, parameter :: n = 3
real(8), allocatable, dimension(:,:,:) :: foo
integer :: i, j, k
print *, "main: before memory: ", allocated(foo)
call memory(foo, n*n*n)
print *, "main: after memory: ", allocated(foo)
do i = 1,n
do j = 1,n
do k = 1, n
foo(i, j, k) = real(i*j*k)
end do
end do
end do
print *, foo
print *, "main: before freem: ", allocated(foo)
call freem(foo)
print *, "main: after freem: ", allocated(foo)
end program alloc
Compilation error:
gfortran -o alloc alloc.f90 -std=f2003
alloc.f90:46.14:
call memory(foo, n*n*n)
1
Error: Rank mismatch in argument 'array' at (1) (1 and 3)
alloc.f90:60.13:
call freem(foo)
1
Error: Rank mismatch in argument 'array' at (1) (1 and 3)
Is there any way of implementing such wrapper?..
Thanks!
This can be done via a generic interface block. You have to create procedures for each rank that you want to handle, e.g., memory_1d, memory_2d, ... memory_4d. (Obviously a lot of cut & pasting.) Then you write a generic interface block that gives all of these procedures the alternative name memory as a generic procedure name. When you call memory, the compiler distinguishes which memory_Xd should be called based on the rank of the argument. The same for your freem functions.
This is how intrinsic functions such as sin have long worked -- you can call sin with a real arguments of various previsions, or with a complex argument, and the compiler figures out with actual sin function to call. In really old FORTRAN you had to use different names for the different sin functions. Now modern Fortran you can setup the same thing with your own routines.
Edit: adding a code example demonstrating the method & syntax:
module double_array_mod
implicit none
interface double_array
module procedure double_vector
module procedure double_array_2D
end interface double_array
private ! hides items not listed on public statement
public :: double_array
contains
subroutine double_vector (vector)
integer, dimension (:), intent (inout) :: vector
vector = 2 * vector
end subroutine double_vector
subroutine double_array_2D (array)
integer, dimension (:,:), intent (inout) :: array
array = 2 * array
end subroutine double_array_2D
end module double_array_mod
program demo_user_generic
use double_array_mod
implicit none
integer, dimension (2) :: A = [1, 2]
integer, dimension (2,2) :: B = reshape ( [11, 12, 13, 14], [2,2] )
integer :: i
write (*, '( / "vector before:", / 2(2X, I3) )' ) A
call double_array (A)
write (*, '( / "vector after:", / 2(2X, I3) )' ) A
write (*, '( / "2D array before:" )' )
do i=1, 2
write (*, '( 2(2X, I3) )' ) B (i, :)
end do
call double_array (B)
write (*, '( / "2D array after:" )' )
do i=1, 2
write (*, '( 2(2X, I3) )' ) B (i, :)
end do
stop
end program demo_user_generic
subroutine memory(array, length) has as it first dummy parameter 1-dimensional array (real(8), allocatable, intent(out), dimension(:) :: array).
Calling this subroutine from your main program with 3-dimensional array foo (real(8), allocatable, dimension(:,:,:) :: foo) is error obviously. And this is what compiler actually said.
If you really need such subroutines write one pair memory/freem subroutines for each array of different dimension - one subroutines pair for 1-dimensional array, another for 2-dimensional array, etc.
By the way, memory subroutines will be different in general because in order to allocate n-dimensional array you need to pass n extents to above-mentioned subroutine.