growing dynamically an allocatable array of derived data;

[vjenel]

Hello,

I have a question about increasing the size of an allocatable array of a derived data, with

the command:

a%b =[a%b , element_b]

The specific example is exemplified in the code below.

-----

Basically , in the example below, I try to increase the array rn%word dynamically via

rn%word = [ rn%word  , word ]

however, as the grows to e.g. rn%word(4),   rn%word(5) , the previously assigned  value of rn%word(2) or rn%word(3) became incorrect. (as if they are overwritten)

----

Any hints why rn%word(2:3)%s became incorrect after the array rn%words  grows to 4,5 elements ?

Is the operator [ ] not defined for arrays of derived data?

-----

module hpp_string
type string
character(:), allocatable :: s
end type string
!save
end module hpp_string

module dbg_dbg
use hpp_string, only : string
type dbg_object
type(string), allocatable :: words(:)
! integer :: io ! etc
end type dbg_object
!save
end module dbg_dbg

program m1
use dbg_dbg , only : dbg_object
use hpp_string , only : string
implicit none
integer i,j,k
type (dbg_object) :: rn
type (string) , allocatable :: test(:), pd_reference(:)
do i = 1, size(pd_reference)
rn%words = [ rn%words, pd_reference(i) ]
! rn%words(i) = pd_reference(i)
test=[test, pd_reference(i) ]
print*,size(rn%words),'++++++',rn%words(size(rn%words))%s
enddo
!rn%words(2)=pd_reference(2)
do i = 1, size(test) !size(rn%words)
print*,i,'>',rn%words(i)%s, ' > ',test(i)%s
enddo
print*,'-------------------'

! 2nd pass; repeat above ; ,rn%words(2:3)%s  gets overwritten
read(*,*)
do i = 1, size(pd_reference)
rn%words = [ rn%words, pd_reference(i) ]
test=[test, pd_reference(i) ]
enddo
do i = 1, size(test) !size(rn%words)
print*,i,'>',rn%words(i)%s,' > ',test(i)%s
enddo
! 3rn pass; repeat above
print*,'-------------------'
do i = 1, size(pd_reference)
rn%words = [ rn%words, pd_reference(i) ]
test=[test, pd_reference(i) ]
enddo
read(*,*)
print*,'-------------------'
do i = 1, size(test) !size(rn%words)
print*,i,'>',rn%words(i)%s,' > ',test(i)%s
enddoend program m1

[andrew_4619]

At a first glance it seems that  "do i = 1, size(pd_reference)" is used when pd_reference is unallocated which would give an error, so I am thinking the code as pasted here is not the real code.... Maybe I am reading that wrong but if not it is not reasonable to try to draw any conclusion from the code that follows.

From earlier we have a%b =[a%b , element_b] I am not sure that is legal but I am guessing the compiler will need to create a temp and messes up. As a matter of interest does a%b =[a%b(1:n) , element_b] work any better?

[vjenel]

yes, you are right, I copy-paste incomplete (skipped a few lines), thanks for spotting it . Sorry about that.

I skipped to copy-paste this code sequence which allocated and initialized

"

allocate(pd_reference(3))
pd_reference(1)%s = '&id'
pd_reference(2)%s = '&234name'
pd_reference(3)%s = '&Nxyz'

allocate(rn%words(0),test(0))

"

Anyways, the complete code is paste below.

The ifort produces this output:

1 ++++++&id
2 ++++++&234name
3 ++++++&Nxyz
1 >&id > &id
2 >&id4name > &234name
3 >&Nxyz > &Nxyz
-------------------

1 >&id > &id
2 > > &234name
3 >&id4n > &Nxyz
4 >&id > &id
5 >&234name > &234name
6 >&Nxyz > &Nxyz
-------------------

-------------------
1 >&id > &id
2 > > &234name
3 >&id4n > &Nxyz
4 >&id > &id
5 >&id4n > &234name
6 >&id4n > &Nxyz
7 > > &id
8 >&id4name > &234name
9 >&Nxyz > &Nxyz

----

while pgi (18.7) and gfortran (8.1.0) generate the output:

1 ++++++&id
2 ++++++&234name
3 ++++++&Nxyz
1 >&id > &id
2 >&234name > &234name
3 >&Nxyz > &Nxyz
-------------------

1 >&id > &id
2 >&234name > &234name
3 >&Nxyz > &Nxyz
4 >&id > &id
5 >&234name > &234name
6 >&Nxyz > &Nxyz
-------------------

-------------------
1 >&id > &id
2 >&234name > &234name
3 >&Nxyz > &Nxyz
4 >&id > &id
5 >&234name > &234name
6 >&Nxyz > &Nxyz
7 >&id > &id
8 >&234name > &234name
9 >&Nxyz > &Nxyz

--

Basically the word in the middle (between ">" ...  ">" ) gets overwritten.

The complete code is this:

module hpp_string
type string
character(:), allocatable :: s
end type string
!save
end module hpp_string

module dbg_dbg
use hpp_string, only : string
type dbg_object
type(string), allocatable :: words(:)
! integer :: io ! etc
end type dbg_object
!save
end module dbg_dbg

program m1
use dbg_dbg , only : dbg_object
use hpp_string , only : string
implicit none
integer i,j,k
type (dbg_object) :: rn
type (string) , allocatable :: test(:), pd_reference(:)

allocate(pd_reference(3))
pd_reference(1)%s = '&id'
pd_reference(2)%s = '&234name'
pd_reference(3)%s = '&Nxyz'

allocate(rn%words(0),test(0))

do i = 1, size(pd_reference)
rn%words = [ rn%words, pd_reference(i) ]
! rn%words(i) = pd_reference(i)
test=[test, pd_reference(i) ]
print*,size(rn%words),'++++++',rn%words(size(rn%words))%s
enddo
!rn%words(2)=pd_reference(2)
do i = 1, size(test) !size(rn%words)
print*,i,'>',rn%words(i)%s, ' > ',test(i)%s
enddo
print*,'-------------------'

! repeat above
read(*,*)
do i = 1, size(pd_reference)
rn%words = [ rn%words, pd_reference(i) ]
test=[test, pd_reference(i) ]
enddo
do i = 1, size(test) !size(rn%words)
print*,i,'>',rn%words(i)%s,' > ',test(i)%s
enddo
print*,'-------------------'
do i = 1, size(pd_reference)
rn%words = [ rn%words, pd_reference(i) ]
test=[test, pd_reference(i) ]
enddo
read(*,*)
print*,'-------------------'
do i = 1, size(test) !size(rn%words)
print*,i,'>',rn%words(i)%s,' > ',test(i)%s
enddo

stop

end program m1

[andrew_4619]

OK, I see the same problem when I run your code. I think that is a bug, I suggest you file a ticket on that . On a practical note is see that the "test" variable works OK as does the code below:

    do i = 1, size(pd_reference)
        !rn%words = [ rn%words, pd_reference(i) ]
        ! rn%words(i) = pd_reference(i)
        test=[test, pd_reference(i) ]
        rn%words = test
        print*,size(rn%words),'++++++',rn%words(size(rn%words))%s
    enddo

I do not think your code is a good design. What I think will happen is the compiler will construct the array as new (a temp in effect) copy copying all the data it will then deallocate the old one and point at the new data , effectively a move_alloc. If you do this many times increasing by one it is very inefficient.  If you add a lot of data better to guess a large-ish size to allocate and then add data. At the end do a copy / move_alloc to resize to the correct size or you if you run out of space (due to a poor size guess) do a copy move_alloc to increase the allocation.

[vjenel]

For small lists read once, buffering wont make much difference , but for large lists i buffer in static arrays of 100..1000..etc. elements and then append whole chunk (like in subroutine grow_c1_b_larger_buffer in attached m1.f90 ; a move_alloc would save some time I would guess).

However, trying to append an array chunk e.g. [e1,e2,e3] utilizing a=[a ,[e1,e2,e2] ] still generated
unexpected results for lists of characters, as exemplified in the attached code m1.f90 for rn_biss and cc1_biss.

The same unexpected behavior happened with list of static character(1) ( the type "c1list" in m1.f90).

Yet, utilizing similar derived data structure of lists having integer and real*8 instead of characters
(as in the types "list" and "rlist" in m1.f90) behaves as expected and does not overwrite while growing the array with [ , ].

Replacing the operator [ , ] with my own coded subroutines (like the "grow" in m1.f90)
generated the expected/correct answer.

------

Thanks a lot for the fast answer(s).

----

[code]

module hpp_string
type string
character(:), allocatable :: s
end type string
end module hpp_string

module hpp_1ch
type c1list
character(1), allocatable :: c1(:)
end type c1list
end module hpp_1ch

module hpp_ilist
type list
integer, allocatable :: i(:)
end type list
end module hpp_ilist

module hpp_rlist
type rlist
real*8, allocatable :: r(:)
end type rlist
end module hpp_rlist

module dbg_dbg
use hpp_string, only : string
use hpp_ilist, only : list
use hpp_rlist, only : rlist
use hpp_1ch , only : c1list
type dbg_object
type(string), allocatable :: words(:)
end type dbg_object

type idbg_object
type(list), allocatable :: iw(:)
end type idbg_object

type c1dbg_object
type(c1list), allocatable :: c1(:)
end type c1dbg_object

type rdbg_object
type(rlist), allocatable :: r8(:)
end type rdbg_object

!save
end module dbg_dbg

module opps
public :: to_char

interface huh
module procedure huh0
module procedure huh1
module procedure huh2
module procedure huh3
end interface huh
private :: huh0,huh1,huh2, huh3

interface to_char
module procedure to_char_i
module procedure to_char_r
end interface to_char
private :: to_char_i,to_char_r

interface grow
module procedure grow_s
module procedure grow_s_b
module procedure grow_s_b_larger_buffer
module procedure grow_c1
module procedure grow_c1_b
module procedure grow_c1_b_larger_buffer
end interface grow
private:: grow_s,grow_c1,grow_s_b,grow_s_b_larger_buffer,grow_c1_b,grow_c1_b_larger_buffer

contains
function to_char_i ( v ) result (u)
implicit none
integer, intent(in) :: v(:)
character(:),allocatable :: u
character(50) :: ch50
integer i
u=""
do i = 1, size(v)
ch50=repeat(' ',len(ch50)) ; write(ch50,*) v(i)
u = u//' '//trim(adjustl(ch50))
enddo
u=trim(adjustl(u))
end function to_char_i
function to_char_r ( v , fmt) result (u)
implicit none
real*8, intent(in) :: v(:)
character(*),intent(in),optional :: fmt
character(:),allocatable :: u, fmt_
character(50) :: ch50
integer i,ierr,ierr1
real*8 tmp
fmt_='*'
if (present(fmt))fmt_=fmt
u=""
do i = 1, size(v)
ch50=repeat(' ',len(ch50)) ;
if(fmt_=='*') then
write(ch50,*) v(i)
else
write(ch50,fmt_,iostat=ierr) v(i)
read(ch50,*,iostat=ierr1) tmp
if (ierr/=0.or.ierr1/=0.or.index(ch50,'*')>0) then
ch50=repeat(' ',len(ch50)) !
write(ch50,*) v(i)
endif
endif
u = u//' '//trim(adjustl(ch50))
enddo
u=trim(adjustl(u))
end function to_char_r
subroutine grow_s ( list, one )
use hpp_string, only : string
use dbg_dbg, only : dbg_object
implicit none
type(dbg_object) :: list
type(string) , intent(in) :: one
type(string) ,allocatable :: buff(:)
if (.not.allocated(list%words)) then
allocate(list%words(1)); list%words(1) = one ;
else
call move_alloc(list%words, buff)
allocate(list%words(size(buff)+1))
list%words( 1:size(buff) ) = buff ( 1:size(buff) )
list%words( 1 + size(buff) ) = one
endif
end subroutine grow_s
subroutine grow_s_b ( list, one )
use hpp_string, only : string
implicit none
type(string) ,allocatable :: list(:)
type(string) , intent(in) :: one
type(string) ,allocatable :: buff(:)
if (.not.allocated(list)) then
allocate(list(1)); list(1) = one ;
else
call move_alloc(list, buff)
allocate(list(size(buff)+1))
list( 1:size(buff) ) = buff ( 1:size(buff) )
list( 1 + size(buff) ) = one
endif
end subroutine grow_s_b
subroutine grow_s_b_larger_buffer ( list, append_several )
use hpp_string, only : string
implicit none
type(string) ,allocatable :: list(:)
type(string) , intent(in) :: append_several(:)
type(string) ,allocatable :: buff(:)
if (.not.allocated(list)) then
allocate(list(size(append_several))); list = append_several ;
else
call move_alloc(list, buff)
allocate(list(size(buff)+size(append_several)))
list( 1:size(buff) ) = buff ( 1:size(buff) )
list( 1+size(buff) : size(buff)+size(append_several) ) = append_several
endif
if(allocated(buff))deallocate(buff)! not necesary
end subroutine grow_s_b_larger_buffer

subroutine grow_c1 ( list, one )
use hpp_1ch, only : c1list
use dbg_dbg, only : c1dbg_object
implicit none
type(c1dbg_object) :: list
type(c1list) , intent(in) :: one
type(c1list) ,allocatable :: buff(:)
if (.not.allocated(list%c1)) then
allocate(list%c1(1)); list%c1(1) = one ;
else
call move_alloc(list%c1, buff)
allocate(list%c1(size(buff)+1))
list%c1( 1:size(buff) ) = buff ( 1:size(buff) )
list%c1( 1 + size(buff) ) = one
endif
end subroutine grow_c1
subroutine grow_c1_b ( list, one )
use hpp_1ch, only : c1list
implicit none
type(c1list) , allocatable :: list(:)
type(c1list) , intent(in) :: one
type(c1list) , allocatable :: buff(:)
if (.not.allocated(list)) then
allocate(list(1)); list(1) = one ;
else
call move_alloc(list, buff)
allocate(list(size(buff)+1))
list( 1:size(buff) ) = buff ( 1:size(buff) )
list( 1 + size(buff) ) = one
endif
end subroutine grow_c1_b
subroutine grow_c1_b_larger_buffer ( list, append_several )
use hpp_1ch, only : c1list
implicit none
type(c1list) ,allocatable :: list(:)
type(c1list) , intent(in) :: append_several(:)
type(c1list) ,allocatable :: buff(:)
if (.not.allocated(list)) then
allocate(list(size(append_several))); list = append_several ;
else
call move_alloc(list, buff)
allocate(list(size(buff)+size(append_several)))
list( 1:size(buff) ) = buff ( 1:size(buff) )
list( 1+size(buff) : size(buff)+size(append_several) ) = append_several
endif
if(allocated(buff))deallocate(buff)! not necesary
end subroutine grow_c1_b_larger_buffer

function huh0 ( u1 , u2 ) result ( u )
character(*), intent(in) :: u1,u2
character(:),allocatable :: u
if (trim(u1)==trim(u2)) then ! trim is not necesary
u=''
else
u = ' ==>> NOT GOOD !!!!!!'
endif
end function huh0
function huh1(u1, u2) result(u)
character(1), intent(in) :: u1(:)
character(*), intent(in) :: u2
character(:),allocatable :: u
character(:),allocatable :: line
integer i
allocate(character(size(u1))::line)
do i =1, size(u1)
line(i:i)=u1(i)(1:1)
enddo
u = huh0(line, u2)
end function huh1
function huh2(u1, u2) result(u)
character(1), intent(in) :: u2(:)
character(*), intent(in) :: u1
character(:),allocatable :: u
character(:),allocatable :: line
integer i
allocate(character(size(u2))::line)
do i =1, size(u2)
line(i:i)=u2(i)(1:1)
enddo
u = huh0(u1, line)
end function huh2
function huh3(u1, u2) result(u)
character(1), intent(in) :: u1(:),u2(:)
character(:),allocatable :: u
character(:),allocatable :: line1,line2
integer i
allocate(character(size(u2))::line2)
allocate(character(size(u1))::line1)
do i =1, size(u2)
line2(i:i)=u2(i)(1:1)
enddo
do i =1, size(u1)
line1(i:i)=u1(i)(1:1)
enddo
u = huh0(line1, line2)
end function huh3
end module opps

! main code
program m1
use dbg_dbg , only : dbg_object, idbg_object,c1dbg_object,rdbg_object
use hpp_string , only : string
use hpp_ilist , only : list
use hpp_1ch , only : c1list
use hpp_rlist , only : rlist
use opps , only : to_char, grow, huh
implicit none
integer i,j,k, ijk, VARIANT,ierr,N3
character(32) ch32
type (dbg_object) :: rn, rn_biss
type (idbg_object) :: irn
type (c1dbg_object ) :: cc1 , cc1_biss
type (rdbg_object) :: rr

type (string) , allocatable :: test(:), pd_reference(:) ! list of allocatable characters
type( list ) , allocatable :: itest(:), ipd_ref(:) ! list of integer
type (c1list) , allocatable :: ctest(:), cpd_ref(:) ! list of char(1)
type (rlist) , allocatable :: rtest(:) , rpd_ref(:) ! list of real*8

N3=3
VARIANT = -1 !2 ! 1-2=user defined grow() ; 3+ or <1 = in built [, ] operator
! i = IARGC() !
i = command_argument_count()
print*,i
if (i > 0 ) then
ch32=repeat(' ',len(ch32))
!call getarg(1, ch32)
CALL get_command_argument(1, ch32)
read(ch32,*,iostat=ierr) j
if (ierr==0)VARIANT = j
endif

print*,' ::: with '//to_char((/VARIANT/))//' -> '//lmsg(VARIANT)

! initialiozations
allocate(pd_reference(N3),ipd_ref(N3),cpd_ref(N3),rpd_ref(N3))
pd_reference(1)%s = '&id' ! set up for the list with allocatable chars
pd_reference(2)%s = '&234name'
pd_reference(3)%s = '&Nxyz'
ipd_ref(1)%i = [1,2,3] ! set up for the list with integers
ipd_ref(2)%i = [5,6,7,8,9,10,11,12]
ipd_ref(3)%i = [100,101,102,103]
cpd_ref(1)%c1 = ['&','i','d'] ! set up for the list with chars(1)
cpd_ref(2)%c1 = ['&','2','3','4','n','a','m','e']
cpd_ref(3)%c1 = ['&','N','x','y','z']
rpd_ref(1)%r = [1.0d0,2.0d0,3.0d0] ! set up for the list with integers
rpd_ref(2)%r = [5.0d0,6.d0,7.0d0,8.0d0,9.0d0,10.0d0,11.0d0,12.0d0]
rpd_ref(3)%r = [100.0d0,101.0d0,102.0d0,103.0d0]

!

allocate(rn%words(0),rn_biss%words(0),test(0),itest(0),ctest(0),rtest(0),irn%iw(0),cc1%c1(0),cc1_biss%c1(0),rr%r8(0))

do ijk = 1,3

do i = 1, N3 !size(pd_reference)a
if (VARIANT == 1) then
call grow ( rn , pd_reference(i) )
call grow ( cc1 , cpd_ref(i) )
else if (VARIANT == 2 ) then
call grow ( rn%words , pd_reference(i) )
call grow ( cc1%c1 , cpd_ref(i) )
else
rn%words = [ rn%words, pd_reference(i) ]
cc1%c1 = [ cc1%c1 , cpd_ref(i) ]
endif
irn%iw = [ irn%iw, ipd_ref(i) ] ! integer list within a derived type
rr%r8 = [ rr%r8 , rpd_ref(i) ] ! real*8 list within a derived type
test = [ test , pd_reference(i) ] ! string list
itest = [ itest , ipd_ref(i) ] ! integer list
ctest = [ ctest , cpd_ref(i) ] ! char(1) list
rtest = [ rtest , rpd_ref(i) ] ! real*8 list
if(ijk==1)print*,size(rn%words),'++++++',rn%words(size(rn%words))%s, ' __ ',cc1%c1(size(cc1%c1))%c1
enddo

if (VARIANT == 1.or. VARIANT==2)then ! increasing the list of a larger buffer (3 in this example)
call grow ( rn_biss%words , pd_reference ) ! buffer more than 1 for efficiency
call grow ( cc1_biss%c1 , cpd_ref )
else
rn_biss%words = [ rn_biss%words , [ pd_reference(1),pd_reference(2),pd_reference(3) ] ]
cc1_biss%c1 = [ cc1_biss%c1 , [ cpd_ref(1), cpd_ref(2), cpd_ref(3) ] ]
endif

call l_print

print*,' ~~~ Press ENTER to continue ~~~~'
read(*,*)

enddo ! ijk

contains
subroutine l_print
print*,'=================== '//to_char((/ijk/))//' variant = '//to_char((/VARIANT/))//' -> '//lmsg(VARIANT)
print*,'------------------- strings (allocatable chars) :'
do i = 1, size(test) !size(rn%words)
print*,i,' >',rn%words(i)%s, ' > ',test(i)%s, huh(rn%words(i)%s, test(i)%s)
enddo
print*,'------------------- allocatable list of static char(1) :'
do i = 1, size(ctest) !size(rn%words)
print*,i,'>>',cc1%c1(i)%c1, ' > ',ctest(i)%c1, huh(cc1%c1(i)%c1, test(i)%s)
enddo
print*,'------------------- APPEND SEVERAL strings :'
do i = 1, size(test) !size(rn%words)
print*,i,' >',rn_biss%words(i)%s, ' > ',test(i)%s, huh(rn_biss%words(i)%s, test(i)%s)
enddo
print*,'------------------- APPEND SEVERAL list of static char(1) :'
do i = 1, size(ctest) !size(rn%words)
print*,i,'>>',cc1_biss%c1(i)%c1, ' > ',ctest(i)%c1, huh(test(i)%s, cc1_biss%c1(i)%c1)!, test(i)%s)
enddo

! skip integer and real*8; verified to be ok.
if(0==1)then !skip them;
print*,'------------------- allocatable list of integers :'
do i = 1, size(itest) !size(rn%words)
print*,i,'>i>',to_char(irn%iw(i)%i), ' > ',to_char(itest(i)%i)
enddo
print*,'------------------- allocatable list of real*8 :'
do i = 1, size(rtest) !size(rn%words)
print*,i,'>i>',to_char(rr%r8(i)%r, fmt='(F6.2)'), ' > ',to_char(rtest(i)%r, fmt='(F6.2)' )
enddo
endif!
end subroutine l_print

function lmsg(i_) result (u_)
integer, intent(in) :: i_
character(:),allocatable :: u_
if(i_==1) then
u_=' with user-defined "grow" method ; passing whole object '
else if (i_==2) then
u_=' with user-defined "grow" method ; passing a subset of the object '
else
u_ = ' using [ , ]'
endif
end function lmsg
end program m1

[/code]

[andrew_4619]

When positing code there is a ... option on the tool bar which shows more options, The </> option thus exposed allows you to have a block formatted as Fortran (or other types) which is better to read and stops problems like certain character combinations being converted to imojis. 

I suggest you file ticket of this with a reproducer code.