Skip to content
This repository was archived by the owner on Aug 28, 2024. It is now read-only.

Commit

Permalink
Fixed append methods with correct array extents
Browse files Browse the repository at this point in the history
  • Loading branch information
@daminton
daminton committed Aug 11, 2021
1 parent f033af9 commit f611c5d
Show file tree
Hide file tree
Showing 2 changed files with 48 additions and 25 deletions.
24 changes: 16 additions & 8 deletions src/symba/symba_util.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,16 +12,19 @@ module subroutine symba_util_append_arr_info(arr, source, nold, nsrc, lsource_ma
type(symba_particle_info), dimension(:), allocatable, intent(in) :: source !! Array to append
integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively
logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
! Internals
integer(I4B) :: nnew

if (.not. allocated(source)) return

nnew = count(lsource_mask(1:nsrc))
if (.not.allocated(arr)) then
allocate(arr(nold+nsrc))
allocate(arr(nold+nnew))
else
call util_resize(arr, nold + nsrc)
call util_resize(arr, nold + nnew)
end if

arr(nold + 1:nold + nsrc) = pack(source(1:nsrc), lsource_mask(1:nsrc))
arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc))

return
end subroutine symba_util_append_arr_info
Expand All @@ -37,16 +40,19 @@ module subroutine symba_util_append_arr_kin(arr, source, nold, nsrc, lsource_mas
type(symba_kinship), dimension(:), allocatable, intent(in) :: source !! Array to append
integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively
logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
! Internals
integer(I4B) :: nnew

if (.not. allocated(source)) return

nnew = count(lsource_mask(1:nsrc))
if (.not.allocated(arr)) then
allocate(arr(nold+nsrc))
allocate(arr(nold+nnew))
else
call util_resize(arr, nold + nsrc)
call util_resize(arr, nold + nnew)
end if

arr(nold + 1:nold + nsrc) = pack(source(1:nsrc), lsource_mask(1:nsrc))
arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc))

return
end subroutine symba_util_append_arr_kin
Expand Down Expand Up @@ -102,10 +108,12 @@ module subroutine symba_util_append_merger(self, source, lsource_mask)
logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
! Internals
integer(I4B), dimension(:), allocatable :: ncomp_tmp !! Temporary placeholder for ncomp incase we are appending a symba_pl object to a symba_merger
integer(I4B) :: nold, nsrc
integer(I4B) :: nold, nsrc, nnew

nold = self%nbody
nsrc = source%nbody
nnew = count(lsource_mask)

select type(source)
class is (symba_merger)
call util_append(self%ncomp, source%ncomp, nold, nsrc, lsource_mask)
Expand All @@ -121,7 +129,7 @@ module subroutine symba_util_append_merger(self, source, lsource_mask)
end select

! Save the number of appended bodies
self%ncomp(nold+1:nold+nsrc) = nsrc
self%ncomp(nold+1:nold+nnew) = nnew

return
end subroutine symba_util_append_merger
Expand Down
49 changes: 32 additions & 17 deletions src/util/util_append.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,16 +12,19 @@ module subroutine util_append_arr_char_string(arr, source, nold, nsrc, lsource_m
character(len=STRMAX), dimension(:), allocatable, intent(in) :: source !! Array to append
integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively
logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
! Internals
integer(I4B) :: nnew

if (.not. allocated(source)) return

nnew = count(lsource_mask(1:nsrc))
if (.not.allocated(arr)) then
allocate(arr(nold+nsrc))
allocate(arr(nold+nnew))
else
call util_resize(arr, nold + nsrc)
call util_resize(arr, nold + nnew)
end if

arr(nold + 1:nold + nsrc) = pack(source(1:nsrc), lsource_mask(1:nsrc))
arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc))

return
end subroutine util_append_arr_char_string
Expand All @@ -37,16 +40,19 @@ module subroutine util_append_arr_DP(arr, source, nold, nsrc, lsource_mask)
real(DP), dimension(:), allocatable, intent(in) :: source !! Array to append
integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively
logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
! Internals
integer(I4B) :: nnew

if (.not. allocated(source)) return

nnew = count(lsource_mask(1:nsrc))
if (.not.allocated(arr)) then
allocate(arr(nold+nsrc))
allocate(arr(nold+nnew))
else
call util_resize(arr, nold + nsrc)
call util_resize(arr, nold + nnew)
end if

arr(nold + 1:nold + nsrc) = pack(source(1:nsrc), lsource_mask(1:nsrc))
arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc))

return
end subroutine util_append_arr_DP
Expand All @@ -62,18 +68,21 @@ module subroutine util_append_arr_DPvec(arr, source, nold, nsrc, lsource_mask)
real(DP), dimension(:,:), allocatable, intent(in) :: source !! Array to append
integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively
logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
! Internals
integer(I4B) :: nnew

if (.not. allocated(source)) return

nnew = count(lsource_mask(1:nsrc))
if (.not.allocated(arr)) then
allocate(arr(NDIM, nold+nsrc))
allocate(arr(NDIM,nold+nnew))
else
call util_resize(arr, nold + nsrc)
call util_resize(arr, nold + nnew)
end if

arr(1, nold + 1:nold + nsrc) = pack(source(1,1:nsrc), lsource_mask(1:nsrc))
arr(2, nold + 1:nold + nsrc) = pack(source(2,1:nsrc), lsource_mask(1:nsrc))
arr(3, nold + 1:nold + nsrc) = pack(source(3,1:nsrc), lsource_mask(1:nsrc))
arr(1, nold + 1:nold + nnew) = pack(source(1,1:nsrc), lsource_mask(1:nsrc))
arr(2, nold + 1:nold + nnew) = pack(source(2,1:nsrc), lsource_mask(1:nsrc))
arr(3, nold + 1:nold + nnew) = pack(source(3,1:nsrc), lsource_mask(1:nsrc))

return
end subroutine util_append_arr_DPvec
Expand All @@ -89,16 +98,19 @@ module subroutine util_append_arr_I4B(arr, source, nold, nsrc, lsource_mask)
integer(I4B), dimension(:), allocatable, intent(in) :: source !! Array to append
integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively
logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
! Internals
integer(I4B) :: nnew

if (.not. allocated(source)) return

nnew = count(lsource_mask(1:nsrc))
if (.not.allocated(arr)) then
allocate(arr(nold+nsrc))
allocate(arr(nold+nnew))
else
call util_resize(arr, nold + nsrc)
call util_resize(arr, nold + nnew)
end if

arr(nold + 1:nold + nsrc) = pack(source(1:nsrc), lsource_mask(1:nsrc))
arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc))

return
end subroutine util_append_arr_I4B
Expand All @@ -114,16 +126,19 @@ module subroutine util_append_arr_logical(arr, source, nold, nsrc, lsource_mask)
logical, dimension(:), allocatable, intent(in) :: source !! Array to append
integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively
logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
! Internals
integer(I4B) :: nnew

if (.not. allocated(source)) return

nnew = count(lsource_mask(1:nsrc))
if (.not.allocated(arr)) then
allocate(arr(nold+nsrc))
allocate(arr(nold+nnew))
else
call util_resize(arr, nold + nsrc)
call util_resize(arr, nold + nnew)
end if

arr(nold + 1:nold + nsrc) = pack(source(1:nsrc), lsource_mask(1:nsrc))
arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc))

return
end subroutine util_append_arr_logical
Expand Down

0 comments on commit f611c5d

Please sign in to comment.