diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index 3be6130bf..ee9ce6932 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -16,8 +16,6 @@ module subroutine rmvs_util_append_pl(self, source, lsource_mask) select type(source) class is (rmvs_pl) associate(nold => self%nbody, nsrc => source%nbody) - call whm_util_append_pl(self, source, lsource_mask) - call util_append(self%nenc, source%nenc, nold, nsrc, lsource_mask) call util_append(self%tpenc1P, source%tpenc1P, nold, nsrc, lsource_mask) call util_append(self%plind, source%plind, nold, nsrc, lsource_mask) @@ -27,6 +25,8 @@ module subroutine rmvs_util_append_pl(self, source, lsource_mask) !call util_append(self%outer, source%outer, nold, nsrc, lsource_mask) !call util_append(self%inner, source%inner, nold, nsrc, lsource_mask) !call util_append(self%planetocentric, source%planetocentric, nold, nsrc, lsource_mask) + + call whm_util_append_pl(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class rmvs_pl or its descendents!" @@ -51,11 +51,11 @@ module subroutine rmvs_util_append_tp(self, source, lsource_mask) select type(source) class is (rmvs_tp) associate(nold => self%nbody, nsrc => source%nbody) - call util_append_tp(self, source, lsource_mask) ! Note: whm_tp does not have its own append method, so we skip back to the base class - call util_append(self%lperi, source%lperi, nold, nsrc, lsource_mask) call util_append(self%plperP, source%plperP, nold, nsrc, lsource_mask) call util_append(self%plencP, source%plencP, nold, nsrc, lsource_mask) + + call util_append_tp(self, source, lsource_mask) ! Note: whm_tp does not have its own append method, so we skip back to the base class end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class rmvs_tp or its descendents!" @@ -143,8 +143,6 @@ module subroutine rmvs_util_resize_pl(self, nnew) class(rmvs_pl), intent(inout) :: self !! RMVS massive body object integer(I4B), intent(in) :: nnew !! New size neded - call whm_util_resize_pl(self, nnew) - call util_resize(self%nenc, nnew) call util_resize(self%tpenc1P, nnew) call util_resize(self%plind, nnew) @@ -155,6 +153,7 @@ module subroutine rmvs_util_resize_pl(self, nnew) !call util_resize(self%inner, nnew) !call util_resize(self%planetocentric, nnew) + call whm_util_resize_pl(self, nnew) return end subroutine rmvs_util_resize_pl @@ -168,13 +167,13 @@ module subroutine rmvs_util_resize_tp(self, nnew) class(rmvs_tp), intent(inout) :: self !! RMVS test particle object integer(I4B), intent(in) :: nnew !! New size neded - call util_resize_tp(self, nnew) - call util_resize(self%lperi, nnew) call util_resize(self%plperP, nnew) call util_resize(self%plencP, nnew) call util_resize(self%xheliocentric, nnew) + call util_resize_tp(self, nnew) + return end subroutine rmvs_util_resize_tp diff --git a/src/symba/symba_fragmentation.f90 b/src/symba/symba_fragmentation.f90 index f7ce51432..9fb11b6ae 100644 --- a/src/symba/symba_fragmentation.f90 +++ b/src/symba/symba_fragmentation.f90 @@ -140,10 +140,6 @@ module function symba_fragmentation_casedisruption(system, param, family, x, v, nstart = pl_adds%nbody + 1 nend = pl_adds%nbody + plnew%nbody call pl_adds%append(plnew, lsource_mask=[(.true., i=1, plnew%nbody)]) - do i = 1, plnew%nbody - write(*,*) i, pl_adds%xb(:,i) - end do - pl_adds%ncomp(nstart:nend) = plnew%nbody call plnew%setup(0, param) deallocate(plnew) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 9816ab4a2..90f5a06e5 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -66,8 +66,6 @@ module subroutine symba_util_append_pl(self, source, lsource_mask) select type(source) class is (symba_pl) associate(nold => self%nbody, nsrc => source%nbody) - call util_append_pl(self, source, lsource_mask) ! Note: helio_pl does not have its own append method, so we skip back to the base class - call util_append(self%lcollision, source%lcollision, nold, nsrc, lsource_mask) call util_append(self%lencounter, source%lencounter, nold, nsrc, lsource_mask) call util_append(self%lmtiny, source%lmtiny, nold, nsrc, lsource_mask) @@ -80,6 +78,8 @@ module subroutine symba_util_append_pl(self, source, lsource_mask) call util_append(self%atp, source%atp, nold, nsrc, lsource_mask) call util_append(self%kin, source%kin, nold, nsrc, lsource_mask) call util_append(self%info, source%info, nold, nsrc, lsource_mask) + + call util_append_pl(self, source, lsource_mask) ! Note: helio_pl does not have its own append method, so we skip back to the base class end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class symba_pl or its descendents!" @@ -102,22 +102,26 @@ 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 - associate(nold => self%nbody, nsrc => source%nbody) - select type(source) - class is (symba_merger) - call symba_util_append_pl(self, source, lsource_mask) - call util_append(self%ncomp, source%ncomp, nold, nsrc, lsource_mask) - class is (symba_pl) - call symba_util_append_pl(self, source, lsource_mask) - allocate(ncomp_tmp, mold=source%id) - ncomp_tmp(:) = 0 - call util_append(self%ncomp, ncomp_tmp, nold, nsrc, lsource_mask) - class default - write(*,*) "Invalid object passed to the append method. Source must be of class symba_pl or its descendents!" - call util_exit(FAILURE) - end select - end associate + nold = self%nbody + nsrc = source%nbody + select type(source) + class is (symba_merger) + call util_append(self%ncomp, source%ncomp, nold, nsrc, lsource_mask) + call symba_util_append_pl(self, source, lsource_mask) + class is (symba_pl) + allocate(ncomp_tmp, mold=source%id) + ncomp_tmp(:) = 0 + call util_append(self%ncomp, ncomp_tmp, nold, nsrc, lsource_mask) + call symba_util_append_pl(self, source, lsource_mask) + class default + write(*,*) "Invalid object passed to the append method. Source must be of class symba_pl or its descendents!" + call util_exit(FAILURE) + end select + + ! Save the number of appended bodies + self%ncomp(nold+1:nold+nsrc) = nsrc return end subroutine symba_util_append_merger @@ -137,11 +141,11 @@ module subroutine symba_util_append_tp(self, source, lsource_mask) select type(source) class is (symba_tp) associate(nold => self%nbody, nsrc => source%nbody) - call util_append_tp(self, source, lsource_mask) ! Note: helio_tp does not have its own append method, so we skip back to the base class - call util_append(self%nplenc, source%nplenc, nold, nsrc, lsource_mask) call util_append(self%levelg, source%levelg, nold, nsrc, lsource_mask) call util_append(self%levelm, source%levelm, nold, nsrc, lsource_mask) + + call util_append_tp(self, source, lsource_mask) ! Note: helio_tp does not have its own append method, so we skip back to the base class end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class symba_tp or its descendents!" @@ -468,10 +472,10 @@ module subroutine symba_util_resize_merger(self, nnew) class(symba_merger), intent(inout) :: self !! SyMBA massive body object integer(I4B), intent(in) :: nnew !! New size neded - call symba_util_resize_pl(self, nnew) - call util_resize(self%ncomp, nnew) + call symba_util_resize_pl(self, nnew) + return end subroutine symba_util_resize_merger @@ -485,8 +489,6 @@ module subroutine symba_util_resize_pl(self, nnew) class(symba_pl), intent(inout) :: self !! SyMBA massive body object integer(I4B), intent(in) :: nnew !! New size neded - call util_resize_pl(self, nnew) - call util_resize(self%lcollision, nnew) call util_resize(self%lencounter, nnew) call util_resize(self%lmtiny, nnew) @@ -500,6 +502,8 @@ module subroutine symba_util_resize_pl(self, nnew) call util_resize(self%kin, nnew) call util_resize(self%info, nnew) + call util_resize_pl(self, nnew) + return end subroutine symba_util_resize_pl @@ -513,12 +517,12 @@ module subroutine symba_util_resize_tp(self, nnew) class(symba_tp), intent(inout) :: self !! SyMBA test particle object integer(I4B), intent(in) :: nnew !! New size neded - call util_resize_tp(self, nnew) - call util_resize(self%nplenc, nnew) call util_resize(self%levelg, nnew) call util_resize(self%levelm, nnew) + call util_resize_tp(self, nnew) + return end subroutine symba_util_resize_tp diff --git a/src/util/util_append.f90 b/src/util/util_append.f90 index 221888e4b..dc48f9861 100644 --- a/src/util/util_append.f90 +++ b/src/util/util_append.f90 @@ -185,8 +185,6 @@ module subroutine util_append_pl(self, source, lsource_mask) select type(source) class is (swiftest_pl) associate(nold => self%nbody, nsrc => source%nbody) - call util_append_body(self, source, lsource_mask) - call util_append(self%mass, source%mass, nold, nsrc, lsource_mask) call util_append(self%Gmass, source%Gmass, nold, nsrc, lsource_mask) call util_append(self%rhill, source%rhill, nold, nsrc, lsource_mask) @@ -200,6 +198,8 @@ module subroutine util_append_pl(self, source, lsource_mask) call util_append(self%k2, source%k2, nold, nsrc, lsource_mask) call util_append(self%Q, source%Q, nold, nsrc, lsource_mask) call util_append(self%tlag, source%tlag, nold, nsrc, lsource_mask) + + call util_append_body(self, source, lsource_mask) end associate call self%eucl_index() @@ -226,11 +226,11 @@ module subroutine util_append_tp(self, source, lsource_mask) select type(source) class is (swiftest_tp) associate(nold => self%nbody, nsrc => source%nbody) - call util_append_body(self, source, lsource_mask) - call util_append(self%isperi, source%isperi, nold, nsrc, lsource_mask) call util_append(self%peri, source%peri, nold, nsrc, lsource_mask) call util_append(self%atp, source%atp, nold, nsrc, lsource_mask) + + call util_append_body(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_tp or its descendents" diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index 777925889..cc84ba3d5 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -16,13 +16,13 @@ module subroutine whm_util_append_pl(self, source, lsource_mask) select type(source) class is (whm_pl) associate(nold => self%nbody, nsrc => source%nbody) - call util_append_pl(self, source, lsource_mask) - call util_append(self%eta, source%eta, nold, nsrc, lsource_mask) call util_append(self%muj, source%muj, nold, nsrc, lsource_mask) call util_append(self%ir3j, source%ir3j, nold, nsrc, lsource_mask) call util_append(self%xj, source%xj, nold, nsrc, lsource_mask) call util_append(self%vj, source%vj, nold, nsrc, lsource_mask) + + call util_append_pl(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class whm_pl or its descendents" @@ -76,14 +76,14 @@ module subroutine whm_util_resize_pl(self, nnew) class(whm_pl), intent(inout) :: self !! WHM massive body object integer(I4B), intent(in) :: nnew !! New size neded - call util_resize_pl(self, nnew) - call util_resize(self%eta, nnew) call util_resize(self%xj, nnew) call util_resize(self%vj, nnew) call util_resize(self%muj, nnew) call util_resize(self%ir3j, nnew) + call util_resize_pl(self, nnew) + return end subroutine whm_util_resize_pl