From 3f292fa387ec77081d8dda8348358b78fa50806f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 31 Aug 2021 16:22:29 -0400 Subject: [PATCH] Restructured util_resize subroutines for the various data types. Now it can handle resizing of not-previously allocated arrays --- src/symba/symba_collision.f90 | 12 +-- src/symba/symba_util.f90 | 15 +-- src/util/util_resize.f90 | 177 +++++++++++++++++++++++----------- 3 files changed, 136 insertions(+), 68 deletions(-) diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 39d09970a..e1bbe02da 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -922,15 +922,15 @@ subroutine symba_collision_mergeaddsub(system, param, family, id_frag, Ip_frag, plnew%vb(:, 1:nfrag) = vb_frag(:, 1:nfrag) call pl%vb2vh(cb) call pl%xh2xb(cb) - ! write(54,*) "Fragment properties" - ! write(54,*) "xbcb : ", cb%xb(:) - ! write(54,*) "vbcb : ", cb%vb(:) + write(54,*) "Fragment properties" + write(54,*) "xbcb : ", cb%xb(:) + write(54,*) "vbcb : ", cb%vb(:) do i = 1, nfrag plnew%xh(:,i) = xb_frag(:, i) - cb%xb(:) plnew%vh(:,i) = vb_frag(:, i) - cb%vb(:) - ! write(54,*) "index, id: ", i, plnew%id(i) - ! write(54,*) "xb : ", xb_frag(:,i) - ! write(54,*) "vb : ", vb_frag(:,i) + write(54,*) "index, id: ", i, plnew%id(i) + write(54,*) "xb : ", xb_frag(:,i) + write(54,*) "vb : ", vb_frag(:,i) end do plnew%mass(1:nfrag) = m_frag(1:nfrag) plnew%Gmass(1:nfrag) = param%GU * m_frag(1:nfrag) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 2ff7dbf18..91f9549ab 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -568,18 +568,21 @@ module subroutine symba_util_resize_arr_kin(arr, nnew) integer(I4B), intent(in) :: nnew !! New size ! Internals type(symba_kinship), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated - integer(I4B) :: nold !! Old size + integer(I4B) :: nold !! Old size - if (.not. allocated(arr) .or. nnew < 0) return - - nold = size(arr) - if (nnew == nold) return + if (nnew < 0) return if (nnew == 0) then - deallocate(arr) + if (allocated(arr)) deallocate(arr) return end if + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + allocate(tmp(nnew)) if (nnew > nold) then tmp(1:nold) = arr(1:nold) diff --git a/src/util/util_resize.f90 b/src/util/util_resize.f90 index 889703ac8..dfef8771b 100644 --- a/src/util/util_resize.f90 +++ b/src/util/util_resize.f90 @@ -5,7 +5,7 @@ module subroutine util_resize_arr_char_string(arr, nnew) !! author: David A. Minton !! - !! Resizes an array component of type character string. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. + !! Resizes an array component of type character string. nnew = 0 will deallocate. implicit none ! Arguments character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Array to resize @@ -14,21 +14,31 @@ module subroutine util_resize_arr_char_string(arr, nnew) character(len=STRMAX), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated integer(I4B) :: nold !! Old size - if (.not. allocated(arr) .or. nnew < 0) return - - nold = size(arr) - if (nnew == nold) return + if (nnew < 0) return if (nnew == 0) then - deallocate(arr) + if (allocated(arr)) deallocate(arr) return end if + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + + if (nnew == nold) return + allocate(tmp(nnew)) - if (nnew > nold) then - tmp(1:nold) = arr(1:nold) + if (nold > 0) then + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + tmp(nold+1:nnew) = "" + else + tmp(1:nnew) = arr(1:nnew) + end if else - tmp(1:nnew) = arr(1:nnew) + tmp(1:nnew) = "" end if call move_alloc(tmp, arr) @@ -39,7 +49,7 @@ end subroutine util_resize_arr_char_string module subroutine util_resize_arr_DP(arr, nnew) !! author: David A. Minton !! - !! Resizes an array component of double precision type. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. + !! Resizes an array component of double precision type. Passing nnew = 0 will deallocate. implicit none ! Arguments real(DP), dimension(:), allocatable, intent(inout) :: arr !! Array to resize @@ -47,22 +57,33 @@ module subroutine util_resize_arr_DP(arr, nnew) ! Internals real(DP), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated integer(I4B) :: nold !! Old size + real(DP), parameter :: init_val = 0.0_DP - if (.not. allocated(arr) .or. nnew < 0) return - - nold = size(arr) - if (nnew == nold) return + if (nnew < 0) return if (nnew == 0) then - deallocate(arr) + if (allocated(arr)) deallocate(arr) return end if + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + + if (nnew == nold) return + allocate(tmp(nnew)) - if (nnew > nold) then - tmp(1:nold) = arr(1:nold) + if (nold > 0) then + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + tmp(nold+1:nnew) = init_val + else + tmp(1:nnew) = arr(1:nnew) + end if else - tmp(1:nnew) = arr(1:nnew) + tmp(1:nnew) = init_val end if call move_alloc(tmp, arr) @@ -73,7 +94,7 @@ end subroutine util_resize_arr_DP module subroutine util_resize_arr_DPvec(arr, nnew) !! author: David A. Minton !! - !! Resizes an array component of double precision vectors of size (NDIM, n). Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. + !! Resizes an array component of double precision vectors of size (NDIM, n). Passing nnew = 0 will deallocate. implicit none ! Arguments real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Array to resize @@ -81,33 +102,51 @@ module subroutine util_resize_arr_DPvec(arr, nnew) ! Internals real(DP), dimension(:,:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated integer(I4B) :: nold !! Old size + real(DP), dimension(NDIM), parameter :: init_val = 0.0_DP + integer(I4B) :: i - if (.not. allocated(arr) .or. nnew < 0) return - - nold = size(arr, dim=2) - if (nnew == nold) return + if (nnew < 0) return if (nnew == 0) then - deallocate(arr) + if (allocated(arr)) deallocate(arr) return end if + if (allocated(arr)) then + nold = size(arr, dim=2) + else + nold = 0 + end if + + if (nnew == nold) return + allocate(tmp(NDIM, nnew)) - if (nnew > nold) then - tmp(:, 1:nold) = arr(:, 1:nold) + if (nold > 0) then + if (nnew > nold) then + tmp(:,1:nold) = arr(:,1:nold) + do i = nold+1, nnew + tmp(:,i) = init_val(:) + end do + else + tmp(:,1:nnew) = arr(:,1:nnew) + end if else - tmp(:, 1:nnew) = arr(:, 1:nnew) + do i = 1, nnew + tmp(:, i) = init_val(:) + end do end if call move_alloc(tmp, arr) return + + return end subroutine util_resize_arr_DPvec module subroutine util_resize_arr_I4B(arr, nnew) !! author: David A. Minton !! - !! Resizes an array component of integer type. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. + !! Resizes an array component of integer type. Passing nnew = 0 will deallocate. implicit none ! Arguments integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Array to resize @@ -115,22 +154,33 @@ module subroutine util_resize_arr_I4B(arr, nnew) ! Internals integer(I4B), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated integer(I4B) :: nold !! Old size + integer(I4B), parameter :: init_val = -1 - if (.not. allocated(arr) .or. nnew < 0) return - - nold = size(arr) - if (nnew == nold) return + if (nnew < 0) return if (nnew == 0) then - deallocate(arr) + if (allocated(arr)) deallocate(arr) return end if + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + + if (nnew == nold) return + allocate(tmp(nnew)) - if (nnew > nold) then - tmp(1:nold) = arr(1:nold) + if (nold > 0) then + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + tmp(nold+1:nnew) = init_val + else + tmp(1:nnew) = arr(1:nnew) + end if else - tmp(1:nnew) = arr(1:nnew) + tmp(1:nnew) = init_val end if call move_alloc(tmp, arr) @@ -149,18 +199,22 @@ module subroutine util_resize_arr_info(arr, nnew) ! Internals type(swiftest_particle_info), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated integer(I4B) :: nold !! Old size - logical :: is_symba - - if (.not. allocated(arr) .or. nnew < 0) return - nold = size(arr) - if (nnew == nold) return + if (nnew < 0) return if (nnew == 0) then - deallocate(arr) + if (allocated(arr)) deallocate(arr) return end if + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + + if (nnew == nold) return + allocate(tmp(nnew)) if (nnew > nold) then call util_copy_particle_info_arr(arr(1:nold), tmp(1:nold)) @@ -177,7 +231,7 @@ end subroutine util_resize_arr_info module subroutine util_resize_arr_logical(arr, nnew) !! author: David A. Minton !! - !! Resizes an array component of logical type. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. + !! Resizes an array component of logical type. Passing nnew = 0 will deallocate. implicit none ! Arguments logical, dimension(:), allocatable, intent(inout) :: arr !! Array to resize @@ -185,22 +239,33 @@ module subroutine util_resize_arr_logical(arr, nnew) ! Internals logical, dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated integer(I4B) :: nold !! Old size + logical, parameter :: init_val = .false. - if (.not. allocated(arr) .or. nnew < 0) return - - nold = size(arr) - if (nnew == nold) return + if (nnew < 0) return if (nnew == 0) then - deallocate(arr) + if (allocated(arr)) deallocate(arr) return end if + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + + if (nnew == nold) return + allocate(tmp(nnew)) - if (nnew > nold) then - tmp(1:nold) = arr(1:nold) + if (nold > 0) then + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + tmp(nold+1:nnew) = init_val + else + tmp(1:nnew) = arr(1:nnew) + end if else - tmp(1:nnew) = arr(1:nnew) + tmp(1:nnew) = init_val end if call move_alloc(tmp, arr) @@ -214,8 +279,8 @@ module subroutine util_resize_body(self, nnew) !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. implicit none ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest body object - integer(I4B), intent(in) :: nnew !! New size neded + class(swiftest_body), intent(inout) :: self !! Swiftest body object + integer(I4B), intent(in) :: nnew !! New size neded call util_resize(self%info, nnew) call util_resize(self%id, nnew) @@ -285,7 +350,7 @@ end subroutine util_resize_encounter module subroutine util_resize_pl(self, nnew) !! author: David A. Minton !! - !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. + !! Checks the current size of a Swiftest massive body against the requested size and resizes it if it is too small. implicit none ! Arguments class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object @@ -316,10 +381,10 @@ end subroutine util_resize_pl module subroutine util_resize_tp(self, nnew) !! author: David A. Minton !! - !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. + !! Checks the current size of a Swiftest test particle against the requested size and resizes it if it is too small. implicit none ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest massive body object + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object integer(I4B), intent(in) :: nnew !! New size neded call util_resize_body(self, nnew)