Do we need REALLOCATE?

It is getting even more interesting. I have checked the number of times the address of the allocated array really changes after ‘reallocation’. The result was very surprising. It seems that the address changes are extremely rare. When the
allocated array is shrinking, almost no changes happen. Which would be obvious but from the timing, it seems that the data gets copied on every operation both ways.
BTW, is there a standard-conforming way of getting the address of a variable, other than LOC(variable) extension?

gfortran-10 -O3 realloc.f90
./a.out 100000
up: 35 addr changes 2.97556090 secs
down: 2 addr changes 1.71359110 secs
./a.out 200000
up: 38 addr changes 12.1577778 secs
down: 2 addr changes 7.31757259 secs

program testrealloc
  real, allocatable :: a(:)
  real :: t0, t1
  integer(kind=8) :: p1, p2
  integer :: i, nch=0, max=10000
  character(len=16) :: arg

  if ( command_argument_count() .ge. 1 ) then
    call get_command_argument(1, arg)
    read(arg,*) max
  endif
  allocate(a(1))
  p1 = loc(a)
  call cpu_time(t0)
  do i=2, max
    a = [ a, real(i) ]
    p2 = loc(a)
    if ( p2 /= p1 ) nch=nch+1
    p1 = p2
  end do
  call cpu_time(t1)
  print *, 'up:  ', nch, 'addr changes', t1-t0, ' secs'
  nch = 0
  call cpu_time(t0)
  do i=max-1, 1, -1
    a = a(1:i)
    p2 = loc(a)
    if ( p2 /= p1 ) nch=nch+1
    p1 = p2
  end do
  call cpu_time(t1)
  print *, 'down:', nch, 'addr changes', t1-t0, ' secs'
end program testrealloc
2 Likes

The caveat, per the Fortran standard, is there is no stipulation there be a companion C processor but the use of c_loc will require as such.

But now when a companion C processor is on hand, the easier approach will be to use C_ASSOCIATED function defined in the intrinsic module ISO_C_BINDING:

   use iso_c_binding, only: c_loc, c_ptr, c_associated, c_size_t
   integer, allocatable, target :: a(:)
   type(c_ptr) :: p1, p2
   integer(c_size_t) :: i
   a = [ 1 ]
   p1 = c_loc(a)
   print "(g0,z0)", "Address of a (hex) following initial allocation: ", &
      transfer( p1, mold=i )
   a = [ a, [ 2, 3 ] ]
   p2 = c_loc(a)
   print "(g0,z0)", "Address of a (hex) following reallocation: ", &
      transfer( p2, mold=i )
   print *, "c_associated(p1, p2)?", c_associated(p1, p2)
end

Note the response from 2 different compilers: with gfortran where you get a C realloc kind of behavior and the other with IFORT where you don;'t:

C:\temp>ifort /standard-semantics a.f90
Intel(R) Fortran Intel(R) 64 Compiler Classic for applications running on Intel(R) 64, Version 2021.2.0 Build 20210228_000000
Copyright (C) 1985-2021 Intel Corporation. All rights reserved.

Microsoft (R) Incremental Linker Version 14.27.29112.0
Copyright (C) Microsoft Corporation. All rights reserved.

-out:a.exe
-subsystem:console
a.obj

C:\temp>a.exe
Address of a (hex) following initial allocation: 267DA1A6890
Address of a (hex) following reallocation: 267DA1A63B0
c_associated(p1, p2)? F

C:\temp>gfortran a.f90 -o gcc-a.exe

C:\temp>gcc-a.exe
Address of a (hex) following initial allocation: 793A40
Address of a (hex) following reallocation: 793A40
c_associated(p1, p2)? T

C:\temp>

2 Likes

I remember trying this a very long time ago. It did differ between compilers. Even if the pointer remained the same, the execution was still much slower than it was in C.