http://gcc.gnu.org/bugzilla/show_bug.cgi?id=54788
--- Comment #4 from Sylwester Arabas <slayoo at staszic dot waw.pl> 2012-10-03
10:45:10 UTC ---
Thanks for your replies!
I've managed to get a vector of array pointers employing one more intermediate
derived type. The arrvec_t defined below has also some limited support for
negative indexing as in Python:
module arrvec_m
implicit none
type :: arr_t
real, pointer :: a(:,:)
end type
type :: arrptr_t
class(arr_t), pointer :: p
end type
type :: arrvec_t
class(arrptr_t), pointer :: at(:)
logical, pointer :: inited(:)
contains
procedure :: ctor => arrvec_ctor
procedure :: init => arrvec_init
procedure :: dtor => arrvec_dtor ! waiting for FINAL
end type
contains
subroutine arrvec_ctor(this, n)
class(arrvec_t) :: this
integer, intent(in) :: n
allocate(this%at(-n:n-1))
allocate(this%inited(0:n-1))
this%inited = .false.
end subroutine
subroutine arrvec_init(this, n, i_min, i_max, j_min, j_max)
class(arrvec_t) :: this
integer, intent(in) :: n, i_min, i_max, j_min, j_max
allocate(this%at(n)%p)
allocate(this%at(n)%p%a(i_min : i_max, j_min : j_max))
this%inited(n) = .true.
this%at(n - size(this%inited))%p => this%at(n)%p
end subroutine
subroutine arrvec_dtor(this)
class(arrvec_t) :: this
integer :: i
do i = 0, size(this%inited) - 1
if (this%inited(i)) then
deallocate(this%at(i)%p%a)
deallocate(this%at(i)%p)
end if
end do
deallocate(this%at)
end subroutine
end module
program test_arrvec
use arrvec_m
class(arrvec_t), pointer :: psi
allocate(psi)
call psi%ctor(2)
call psi%init(0, 0, 3, 0, 4)
print*, psi%at(0)%p%a
print*, psi%at(0)%p%a(1,1)
psi%at(0)%p%a(1,1) = 10
print*, psi%at(0)%p%a(1,1)
print*, psi%at(-2)%p%a(1,1)
call psi%dtor
deallocate(psi)
end
