diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index 0ba86c7e8..9f9cf0037 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -15,6 +15,8 @@ module subroutine rmvs_util_append_pl(self, source, lsource_mask) select type(source) class is (rmvs_pl) + call whm_util_append_pl(self, source, lsource_mask) + call util_append(self%nenc, source%nenc, lsource_mask) call util_append(self%tpenc1P, source%tpenc1P, lsource_mask) call util_append(self%plind, source%plind, lsource_mask) @@ -24,8 +26,6 @@ module subroutine rmvs_util_append_pl(self, source, lsource_mask) !call util_append(self%outer, source%outer, lsource_mask) !call util_append(self%inner, source%inner, lsource_mask) !call util_append(self%planetocentric, source%planetocentric, lsource_mask) - - call whm_util_append_pl(self, source, lsource_mask) class default write(*,*) "Invalid object passed to the append method. Source must be of class rmvs_pl or its descendents!" call util_exit(FAILURE) @@ -48,11 +48,11 @@ module subroutine rmvs_util_append_tp(self, source, lsource_mask) select type(source) class is (rmvs_tp) + 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, lsource_mask) call util_append(self%plperP, source%plperP, lsource_mask) call util_append(self%plencP, source%plencP, 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 class default write(*,*) "Invalid object passed to the append method. Source must be of class rmvs_tp or its descendents!" call util_exit(FAILURE) diff --git a/src/symba/symba_setup.f90 b/src/symba/symba_setup.f90 index dab92f3ca..f2c8e63dd 100644 --- a/src/symba/symba_setup.f90 +++ b/src/symba/symba_setup.f90 @@ -18,8 +18,6 @@ module subroutine symba_setup_initialize_system(self, param) ! Call parent method associate(system => self) call whm_setup_initialize_system(system, param) - call system%mergeadd_list%setup(1, param) - call system%mergesub_list%setup(1, param) call system%pltpenc_list%setup(0) call system%plplenc_list%setup(0) select type(pl => system%pl) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index e8badd577..41e7a3a74 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -265,8 +265,8 @@ module subroutine symba_step_reset_system(self) pltpenc_list%nenc = 0 end if - mergeadd_list%nbody = 0 - mergesub_list%nbody = 0 + call mergeadd_list%resize(0) + call mergesub_list%resize(0) end select end select end associate diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 19ac9cd3f..bdfbea86c 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -29,10 +29,12 @@ module subroutine symba_util_append_arr_info(arr, source, lsource_mask) narr = 0 end if + call util_resize(arr, narr + nsrc) + if (present(lsource_mask)) then - arr(narr+1:nsrc) = pack(source(:), lsource_mask(:)) + arr(narr + 1:narr + nsrc) = pack(source(:), lsource_mask(:)) else - arr(narr+1:nsrc) = source(:) + arr(narr + 1:narr + nsrc) = source(:) end if return @@ -66,10 +68,12 @@ module subroutine symba_util_append_arr_kin(arr, source, lsource_mask) narr = 0 end if + call util_resize(arr, narr + nsrc) + if (present(lsource_mask)) then - arr(narr+1:nsrc) = pack(source(:), lsource_mask(:)) + arr(narr + 1:narr + nsrc) = pack(source(:), lsource_mask(:)) else - arr(narr+1:nsrc) = source(:) + arr(narr + 1:narr + nsrc) = source(:) end if return @@ -89,6 +93,8 @@ module subroutine symba_util_append_pl(self, source, lsource_mask) select type(source) class is (symba_pl) + 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, lsource_mask) call util_append(self%lencounter, source%lencounter, lsource_mask) call util_append(self%lmtiny, source%lmtiny, lsource_mask) @@ -101,8 +107,6 @@ module subroutine symba_util_append_pl(self, source, lsource_mask) call util_append(self%atp, source%atp, lsource_mask) call util_append(self%kin, source%kin, lsource_mask) call util_append(self%info, source%info, 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 class default write(*,*) "Invalid object passed to the append method. Source must be of class symba_pl or its descendents!" call util_exit(FAILURE) @@ -125,11 +129,11 @@ module subroutine symba_util_append_tp(self, source, lsource_mask) select type(source) class is (symba_tp) + 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, lsource_mask) call util_append(self%levelg, source%levelg, lsource_mask) call util_append(self%levelm, source%levelm, 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 class default write(*,*) "Invalid object passed to the append method. Source must be of class symba_tp or its descendents!" call util_exit(FAILURE) diff --git a/src/util/util_append.f90 b/src/util/util_append.f90 index 0ca112eb9..a13103cfa 100644 --- a/src/util/util_append.f90 +++ b/src/util/util_append.f90 @@ -29,10 +29,12 @@ module subroutine util_append_arr_char_string(arr, source, lsource_mask) narr = 0 end if + call util_resize(arr, narr + nsrc) + if (present(lsource_mask)) then - arr(narr+1:nsrc) = pack(source(:), lsource_mask(:)) + arr(narr + 1:narr + nsrc) = pack(source(:), lsource_mask(:)) else - arr(narr+1:nsrc) = source(:) + arr(narr + 1:narr + nsrc) = source(:) end if return @@ -66,10 +68,12 @@ module subroutine util_append_arr_DP(arr, source, lsource_mask) narr = 0 end if + call util_resize(arr, narr + nsrc) + if (present(lsource_mask)) then - arr(narr+1:nsrc) = pack(source(:), lsource_mask(:)) + arr(narr + 1:narr + nsrc) = pack(source(:), lsource_mask(:)) else - arr(narr+1:nsrc) = source(:) + arr(narr + 1:narr + nsrc) = source(:) end if return @@ -103,12 +107,14 @@ module subroutine util_append_arr_DPvec(arr, source, lsource_mask) narr = 0 end if + call util_resize(arr, narr + nsrc) + if (present(lsource_mask)) then - arr(1, narr+1:nsrc) = pack(source(1,:), lsource_mask(:)) - arr(2, narr+1:nsrc) = pack(source(2,:), lsource_mask(:)) - arr(3, narr+1:nsrc) = pack(source(3,:), lsource_mask(:)) + arr(1, narr + 1:narr + nsrc) = pack(source(1,:), lsource_mask(:)) + arr(2, narr + 1:narr + nsrc) = pack(source(2,:), lsource_mask(:)) + arr(3, narr + 1:narr + nsrc) = pack(source(3,:), lsource_mask(:)) else - arr(:, narr+1:nsrc) = source(:,:) + arr(:, narr + 1:narr + nsrc) = source(:,:) end if return @@ -142,13 +148,14 @@ module subroutine util_append_arr_I4B(arr, source, lsource_mask) narr = 0 end if + call util_resize(arr, narr + nsrc) + if (present(lsource_mask)) then - arr(narr+1:nsrc) = pack(source(:), lsource_mask(:)) + arr(narr + 1:narr + nsrc) = pack(source(:), lsource_mask(:)) else - arr(narr+1:nsrc) = source(:) + arr(narr + 1:narr + nsrc) = source(:) end if - return end subroutine util_append_arr_I4B @@ -180,10 +187,12 @@ module subroutine util_append_arr_logical(arr, source, lsource_mask) nsrc = size(source) end if + call util_resize(arr, narr + nsrc) + if (present(lsource_mask)) then - arr(narr+1:nsrc) = pack(source(:), lsource_mask(:)) + arr(narr + 1:narr + nsrc) = pack(source(:), lsource_mask(:)) else - arr(narr+1:nsrc) = source(:) + arr(narr + 1:narr + nsrc) = source(:) end if return @@ -202,6 +211,7 @@ module subroutine util_append_body(self, source, lsource_mask) logical, dimension(:), optional, intent(in) :: lsource_mask !! Logical mask indicating which elements to append to call util_append(self%name, source%name, lsource_mask) + call util_append(self%id, source%id, lsource_mask) call util_append(self%status, source%status, lsource_mask) call util_append(self%ldiscard, source%ldiscard, lsource_mask) call util_append(self%lmask, source%lmask, lsource_mask) @@ -242,6 +252,8 @@ module subroutine util_append_pl(self, source, lsource_mask) select type(source) class is (swiftest_pl) + call util_append_body(self, source, lsource_mask) + call util_append(self%mass, source%mass, lsource_mask) call util_append(self%Gmass, source%Gmass, lsource_mask) call util_append(self%rhill, source%rhill, lsource_mask) @@ -256,8 +268,6 @@ module subroutine util_append_pl(self, source, lsource_mask) call util_append(self%Q, source%Q, lsource_mask) call util_append(self%tlag, source%tlag, lsource_mask) - call util_append_body(self, source, lsource_mask) - call self%eucl_index() class default write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_pl or its descendents" @@ -281,11 +291,11 @@ module subroutine util_append_tp(self, source, lsource_mask) select type(source) class is (swiftest_tp) + call util_append_body(self, source, lsource_mask) + call util_append(self%isperi, source%isperi, lsource_mask) call util_append(self%peri, source%peri, lsource_mask) call util_append(self%atp, source%atp, lsource_mask) - - call util_append_body(self, source, lsource_mask) class default write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_tp or its descendents" call util_exit(FAILURE) diff --git a/src/util/util_resize.f90 b/src/util/util_resize.f90 index 53df2bd73..4a84a003b 100644 --- a/src/util/util_resize.f90 +++ b/src/util/util_resize.f90 @@ -181,6 +181,7 @@ module subroutine util_resize_body(self, nnew) integer(I4B), intent(in) :: nnew !! New size neded call util_resize(self%name, nnew) + call util_resize(self%id, nnew) call util_resize(self%status, nnew) call util_resize(self%ldiscard, nnew) call util_resize(self%lmask, nnew) diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index 4dbc81fb7..f3dc15d3e 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -15,13 +15,13 @@ module subroutine whm_util_append_pl(self, source, lsource_mask) select type(source) class is (whm_pl) + call util_append_pl(self, source, lsource_mask) + call util_append(self%eta, source%eta, lsource_mask) call util_append(self%muj, source%muj, lsource_mask) call util_append(self%ir3j, source%ir3j, lsource_mask) call util_append(self%xj, source%xj, lsource_mask) call util_append(self%vj, source%vj, lsource_mask) - - call util_append_pl(self, source, lsource_mask) class default write(*,*) "Invalid object passed to the append method. Source must be of class whm_pl or its descendents" call util_exit(FAILURE)