From f611c5de1832c4dc0a9840fe5582dc81411ee65a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 11 Aug 2021 19:48:07 -0400 Subject: [PATCH] Fixed append methods with correct array extents --- src/symba/symba_util.f90 | 24 +++++++++++++------- src/util/util_append.f90 | 49 ++++++++++++++++++++++++++-------------- 2 files changed, 48 insertions(+), 25 deletions(-) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 1335272fe..8ee7da8ea 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -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 @@ -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 @@ -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) @@ -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 diff --git a/src/util/util_append.f90 b/src/util/util_append.f90 index dc48f9861..979da7a19 100644 --- a/src/util/util_append.f90 +++ b/src/util/util_append.f90 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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