diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 913d678eb..64a6e8778 100644 --- a/src/modules/swiftest_classes.f90 +++ b/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 diff --git a/src/rmvs/rmvs_setup.f90 b/src/rmvs/rmvs_setup.f90 index 778ba3714..92043e0fe 100644 --- a/src/rmvs/rmvs_setup.f90 +++ b/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 diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 50da6ce1c..f1e44f19c 100644 --- a/src/setup/setup.f90 +++ b/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,6 +200,8 @@ 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 @@ -187,6 +209,8 @@ module subroutine setup_pl(self, n, param) 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 @@ -194,6 +218,9 @@ module subroutine setup_pl(self, n, param) 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)) diff --git a/src/symba/symba_setup.f90 b/src/symba/symba_setup.f90 index e240be778..dab92f3ca 100644 --- a/src/symba/symba_setup.f90 +++ b/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 diff --git a/src/util/util_copy.f90 b/src/util/util_copy.f90 new file mode 100644 index 000000000..fcbd0d5da --- /dev/null +++ b/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 \ No newline at end of file diff --git a/src/util/util_resize.f90 b/src/util/util_resize.f90 new file mode 100644 index 000000000..cde0428d4 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/src/util/util_spill_and_fill.f90 b/src/util/util_spill_and_fill.f90 index 8ea85f654..89f8bb095 100644 --- a/src/util/util_spill_and_fill.f90 +++ b/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 diff --git a/src/whm/whm_setup.f90 b/src/whm/whm_setup.f90 index 0de03ec2c..cbf36cc90 100644 --- a/src/whm/whm_setup.f90 +++ b/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))