Added copy and resize methods to swiftest_body

Changed the setup method so that it deallocates previously allocated arrays, and started the process of adding copy and resize methods

src/modules/swiftest_classes.f90

@@ -164,7 +164,9 @@ module swiftest_classes
       procedure :: xv2el       => orbel_xv2el_vec          !! Convert position and velocity vectors to orbital  elements 
       procedure :: setup       => setup_body               !! A constructor that sets the number of bodies and allocates all allocatable arrays
       procedure :: accel_user  => user_kick_getacch_body   !! Add user-supplied heliocentric accelerations to planets
+      procedure :: copy        => util_copy_body           !! Copies elements from one structure to another
       procedure :: fill        => util_fill_body           !! "Fills" bodies from one object into another depending on the results of a mask (uses the MERGE intrinsic)
+      procedure :: resize      => util_resize_body         !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small.
       procedure :: set_ir3     => util_set_ir3h            !! Sets the inverse heliocentric radius term (1/rh**3)
       procedure :: sort        => util_sort_body           !! Sorts body arrays by a sortable componen
       procedure :: rearrange   => util_sort_rearrange_body !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods
@@ -757,6 +759,13 @@ module subroutine util_coord_h2b_tp(self, cb)
          class(swiftest_cb), intent(in)    :: cb   !! Swiftest central body object
       end subroutine util_coord_h2b_tp
 
+      module subroutine util_copy_body(self, source, param)
+         implicit none
+         class(swiftest_body),       intent(inout) :: self   !! Swiftest body object
+         class(swiftest_body),       intent(in)    :: source !! Source object to copy
+         class(swiftest_parameters), intent(in)    :: param  !! Current run configuration parameters
+      end subroutine util_copy_body
+
       module subroutine util_exit(code)
          implicit none
          integer(I4B), intent(in) :: code !! Failure exit code
@@ -790,6 +799,13 @@ module subroutine util_peri_tp(self, system, param)
          class(swiftest_parameters),   intent(in)    :: param  !! Current run configuration parameters
       end subroutine util_peri_tp
 
+      module subroutine util_resize_body(self, nrequested, param)
+         implicit none
+         class(swiftest_body),       intent(inout) :: self       !! Swiftest body object
+         integer(I4B),               intent(in)    :: nrequested !! New size neded
+         class(swiftest_parameters), intent(in)    :: param      !! Current run configuration parameters
+      end subroutine util_resize_body
+
       module subroutine util_set_beg_end_pl(self, xbeg, xend, vbeg)
          implicit none
          class(swiftest_pl),       intent(inout)          :: self !! Swiftest massive body object

src/rmvs/rmvs_setup.f90

@@ -147,10 +147,16 @@ module subroutine rmvs_setup_tp(self, n, param)
       call setup_tp(self, n, param) 
       if (n <= 0) return
 
+      if (allocated(self%lperi)) deallocate(self%lperi)
+      if (allocated(self%plperP)) deallocate(self%plperP)
+      if (allocated(self%plencP)) deallocate(self%plencP)
+
       allocate(self%lperi(n))
       allocate(self%plperP(n))
       allocate(self%plencP(n))
+
       if (self%lplanetocentric) then
+         if (allocated(self%xheliocentric)) deallocate(self%xheliocentric)
          allocate(self%xheliocentric(NDIM, n))
       end if
 

src/setup/setup.f90

@@ -110,6 +110,19 @@ module subroutine setup_body(self, n, param)
       if (n <= 0) return
       self%lfirst = .true.
 
+      if (allocated(self%id)) deallocate(self%id)
+      if (allocated(self%name)) deallocate(self%name)
+      if (allocated(self%status)) deallocate(self%status)
+      if (allocated(self%ldiscard)) deallocate(self%ldiscard)
+      if (allocated(self%xh)) deallocate(self%xh)
+      if (allocated(self%vh)) deallocate(self%vh)
+      if (allocated(self%xb)) deallocate(self%xb)
+      if (allocated(self%vb)) deallocate(self%vb)
+      if (allocated(self%ah)) deallocate(self%ah)
+      if (allocated(self%ir3h)) deallocate(self%ir3h)
+      if (allocated(self%mu)) deallocate(self%mu)
+      if (allocated(self%lmask)) deallocate(self%lmask)
+
       allocate(self%id(n))
       allocate(self%name(n))
       allocate(self%status(n))
@@ -137,14 +150,17 @@ module subroutine setup_body(self, n, param)
       self%mu(:)     = 0.0_DP
 
       if (param%loblatecb) then
+         if (allocated(self%aobl)) deallocate(self%aobl)
          allocate(self%aobl(NDIM, n))
          self%aobl(:,:) = 0.0_DP
       end if
       if (param%ltides) then
+         if (allocated(self%atide)) deallocate(self%lmask)
          allocate(self%atide(NDIM, n))
          self%atide(:,:) = 0.0_DP
       end if
       if (param%lgr) then
+         if (allocated(self%agr)) deallocate(self%lmask)
          allocate(self%agr(NDIM, n))
          self%agr(:,:) = 0.0_DP
       end if
@@ -169,6 +185,10 @@ module subroutine setup_pl(self, n, param)
       call setup_body(self, n, param)
       if (n <= 0) return 
 
+      if (allocated(self%mass)) deallocate(self%mass)
+      if (allocated(self%Gmass)) deallocate(self%Gmass)
+      if (allocated(self%rhill)) deallocate(self%rhill)
+
       allocate(self%mass(n))
       allocate(self%Gmass(n))
       allocate(self%rhill(n))
@@ -180,20 +200,27 @@ module subroutine setup_pl(self, n, param)
       self%nplpl = 0   
 
       if (param%lclose) then
+         if (allocated(self%radius)) deallocate(self%radius)
+         if (allocated(self%density)) deallocate(self%density)
          allocate(self%radius(n))
          allocate(self%density(n))
          self%radius(:) = 0.0_DP
          self%density(:) = 1.0_DP
       end if
 
       if (param%lrotation) then
+         if (allocated(self%rot)) deallocate(self%rhill)
+         if (allocated(self%Ip)) deallocate(self%rhill)
          allocate(self%rot(NDIM, n))
          allocate(self%Ip(NDIM, n))
          self%rot(:,:) = 0.0_DP
          self%Ip(:,:) = 0.0_DP
       end if
 
       if (param%ltides) then
+         if (allocated(self%k2)) deallocate(self%rhill)
+         if (allocated(self%Q)) deallocate(self%rhill)
+         if (allocated(self%tlag)) deallocate(self%rhill)
          allocate(self%k2(n))
          allocate(self%Q(n))
          allocate(self%tlag(n))
@@ -222,6 +249,10 @@ module subroutine setup_tp(self, n, param)
       call setup_body(self, n, param)
       if (n <= 0) return
 
+      if (allocated(self%isperi)) deallocate(self%isperi)
+      if (allocated(self%peri)) deallocate(self%peri)
+      if (allocated(self%atp)) deallocate(self%atp)
+
       allocate(self%isperi(n))
       allocate(self%peri(n))
       allocate(self%atp(n))

src/symba/symba_setup.f90

@@ -55,6 +55,19 @@ module subroutine symba_setup_pl(self, n, param)
       call setup_pl(self, n, param) 
       if (n <= 0) return
 
+      if (allocated(self%lcollision)) deallocate(self%lcollision)
+      if (allocated(self%lencounter)) deallocate(self%lencounter)
+      if (allocated(self%lmtiny)) deallocate(self%lmtiny)
+      if (allocated(self%nplenc)) deallocate(self%nplenc)
+      if (allocated(self%ntpenc)) deallocate(self%ntpenc)
+      if (allocated(self%levelg)) deallocate(self%levelg)
+      if (allocated(self%levelm)) deallocate(self%levelm)
+      if (allocated(self%isperi)) deallocate(self%isperi)
+      if (allocated(self%peri)) deallocate(self%peri)
+      if (allocated(self%atp)) deallocate(self%atp)
+      if (allocated(self%kin)) deallocate(self%kin)
+      if (allocated(self%info)) deallocate(self%info)
+
       allocate(self%lcollision(n))
       allocate(self%lencounter(n))
       allocate(self%lmtiny(n))
@@ -102,11 +115,13 @@ module subroutine symba_setup_pltpenc(self, n)
       if (allocated(self%level)) deallocate(self%level)
       if (allocated(self%index1)) deallocate(self%index1)
       if (allocated(self%index2)) deallocate(self%index2)
+
       allocate(self%lvdotr(n))
       allocate(self%status(n))
       allocate(self%level(n))
       allocate(self%index1(n))
       allocate(self%index2(n))
+
       self%lvdotr(:) = .false.
       self%status(:) = INACTIVE
       self%level(:) = -1
@@ -134,10 +149,12 @@ module subroutine symba_setup_plplenc(self, n)
       if (allocated(self%xh2)) deallocate(self%xh2)
       if (allocated(self%vb1)) deallocate(self%vb1)
       if (allocated(self%vb2)) deallocate(self%vb2)
+
       allocate(self%xh1(NDIM,n))
       allocate(self%xh2(NDIM,n))
       allocate(self%vb1(NDIM,n))
       allocate(self%vb2(NDIM,n))
+
       self%xh1(:,:) = 0.0_DP
       self%xh2(:,:) = 0.0_DP
       self%vb1(:,:) = 0.0_DP
@@ -163,9 +180,14 @@ module subroutine symba_setup_tp(self, n, param)
       call setup_tp(self, n, param) 
       if (n <= 0) return
 
+      if (allocated(self%nplenc)) deallocate(self%nplenc)
+      if (allocated(self%levelg)) deallocate(self%levelg)
+      if (allocated(self%levelm)) deallocate(self%levelm)
+
       allocate(self%nplenc(n))
       allocate(self%levelg(n))
       allocate(self%levelm(n))
+
       self%nplenc(:) = 0
       self%levelg(:) = -1
       self%levelm(:) = -1

src/util/util_copy.f90

@@ -0,0 +1,19 @@
+submodule (swiftest_classes) s_util_copy
+   use swiftest
+contains
+
+   module subroutine util_copy_body(self, source, param)
+      !! author: David A. Minton
+      !!
+      !! Non-destructively copy components from one Swiftest body object to another. 
+      !! This method will automatically resize the destination body if it is too small
+      implicit none
+      ! Arguments
+      class(swiftest_body),       intent(inout) :: self   !! Swiftest body object
+      class(swiftest_body),       intent(in)    :: source !! Source object to copy
+      class(swiftest_parameters), intent(in)    :: param  !! Current run configuration parameters
+
+      return
+   end subroutine util_copy_body
+
+end submodule s_util_copy

src/util/util_resize.f90

@@ -0,0 +1,40 @@
+submodule (swiftest_classes) s_util_resize
+   use swiftest
+contains
+
+   module subroutine util_resize_body(self, nrequested, param)
+      !! author: David A. Minton
+      !!
+      !! 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)    :: nrequested !! New size neded
+      class(swiftest_parameters), intent(in)    :: param      !! Current run configuration parameters
+      ! Internals
+      class(swiftest_body), allocatable   :: temp
+      integer(I4B)                        :: nold
+      logical                             :: lmalloc
+
+      lmalloc = allocated(self%status)
+      if (lmalloc) then
+         nold = size(self%status)
+      else
+         nold = 0
+      end if
+      if (nrequested > nold) then
+         if (lmalloc) allocate(temp, source=self)
+         call self%setup(nrequested, param)
+         if (lmalloc) then
+            call self%copy(temp, param)
+            deallocate(temp)
+         end if
+      else
+         self%status(nrequested+1:nold) = INACTIVE
+      end if
+      self%nbody = nrequested
+
+      return
+   end subroutine util_resize_body
+
+end submodule s_util_resize

src/util/util_spill_and_fill.f90

@@ -231,7 +231,7 @@ module subroutine util_spill_pl(self, discards, lspill_list)
       ! Arguments
       class(swiftest_pl),    intent(inout) :: self        !! Swiftest massive body object
       class(swiftest_body),  intent(inout) :: discards    !! Discarded object 
-      logical, dimension(:), intent(in)    :: lspill_list !! Logical array of bodies to spill into the discardse
+      logical, dimension(:), intent(in)    :: lspill_list !! Logical array of bodies to spill into the discards
       ! Internals
       integer(I4B) :: i
 

src/whm/whm_setup.f90

@@ -18,6 +18,12 @@ module subroutine whm_setup_pl(self, n, param)
       call setup_pl(self, n, param) 
       if (n <= 0) return
 
+      if (allocated(self%eta)) deallocate(self%eta)
+      if (allocated(self%muj)) deallocate(self%muj)
+      if (allocated(self%xj)) deallocate(self%xj)
+      if (allocated(self%vj)) deallocate(self%vj)
+      if (allocated(self%ir3j)) deallocate(self%ir3j)
+
       allocate(self%eta(n))
       allocate(self%muj(n))
       allocate(self%xj(NDIM, n))