From 27af16a6be03e66135dc2a75f27544a56b53f270 Mon Sep 17 00:00:00 2001 From: David Minton Date: Mon, 2 Aug 2021 06:34:43 -0400 Subject: [PATCH] Corrected problem with the rmvs_pl rearrange code and added allocation checks to each component in the rearrange implementation --- src/rmvs/rmvs_util.f90 | 18 ++++++------- src/symba/symba_util.f90 | 40 +++++++++++++++-------------- src/util/util_sort.f90 | 55 ++++++++++++++++++++-------------------- src/whm/whm_util.f90 | 10 ++++---- 4 files changed, 61 insertions(+), 62 deletions(-) diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index e9804bff6..2f7e5f374 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -49,7 +49,6 @@ module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) associate(keeps => self) select type(inserts) class is (rmvs_tp) - call util_fill(keeps%lperi, inserts%lperi, lfill_list) call util_fill(keeps%plperP, inserts%plperP, lfill_list) call util_fill(keeps%plencP, inserts%plencP, lfill_list) @@ -162,11 +161,9 @@ module subroutine rmvs_util_sort_rearrange_pl(self, ind) associate(pl => self, npl => self%nbody) call util_sort_rearrange_pl(pl,ind) allocate(pl_sorted, source=self) - pl%eta(1:npl) = pl_sorted%eta(ind(1:npl)) - pl%xj(:,1:npl) = pl_sorted%xj(:,ind(1:npl)) - pl%vj(:,1:npl) = pl_sorted%vj(:,ind(1:npl)) - pl%muj(1:npl) = pl_sorted%muj(ind(1:npl)) - pl%ir3j(1:npl) = pl_sorted%ir3j(ind(1:npl)) + if (allocated(pl%nenc)) pl%nenc(1:npl) = pl_sorted%nenc(ind(1:npl)) + if (allocated(pl%tpenc1P)) pl%tpenc1P(1:npl) = pl_sorted%tpenc1P(ind(1:npl)) + if (allocated(pl%plind)) pl%plind(1:npl) = pl_sorted%plind(ind(1:npl)) deallocate(pl_sorted) end associate @@ -191,10 +188,10 @@ module subroutine rmvs_util_sort_rearrange_tp(self, ind) associate(tp => self, ntp => self%nbody) call util_sort_rearrange_tp(tp,ind) allocate(tp_sorted, source=self) - tp%lperi(1:ntp) = tp_sorted%lperi(ind(1:ntp)) - tp%plperP(1:ntp) = tp_sorted%plperP(ind(1:ntp)) - tp%plencP(1:ntp) = tp_sorted%plencP(ind(1:ntp)) - tp%xheliocentric(:,1:ntp) = tp_sorted%xheliocentric(:,ind(1:ntp)) + if (allocated(tp%lperi)) tp%lperi(1:ntp) = tp_sorted%lperi(ind(1:ntp)) + if (allocated(tp%plperP)) tp%plperP(1:ntp) = tp_sorted%plperP(ind(1:ntp)) + if (allocated(tp%plencP)) tp%plencP(1:ntp) = tp_sorted%plencP(ind(1:ntp)) + if (allocated(tp%xheliocentric)) tp%xheliocentric(:,1:ntp) = tp_sorted%xheliocentric(:,ind(1:ntp)) deallocate(tp_sorted) end associate @@ -223,6 +220,7 @@ module subroutine rmvs_util_spill_pl(self, discards, lspill_list, ldestructive) call util_spill(keeps%nenc, discards%nenc, lspill_list, ldestructive) call util_spill(keeps%tpenc1P, discards%tpenc1P, lspill_list, ldestructive) call util_spill(keeps%plind, discards%plind, lspill_list, ldestructive) + call whm_util_spill_pl(keeps, discards, lspill_list, ldestructive) class default write(*,*) 'Error! spill method called for incompatible return type on rmvs_pl' diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index d1d7fc59e..70941555d 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -299,23 +299,25 @@ module subroutine symba_util_sort_rearrange_pl(self, ind) associate(pl => self, npl => self%nbody) call util_sort_rearrange_pl(pl,ind) allocate(pl_sorted, source=self) - pl%lcollision(1:npl) = pl_sorted%lcollision(ind(1:npl)) - pl%lencounter(1:npl) = pl_sorted%lencounter(ind(1:npl)) - pl%lmtiny(1:npl) = pl_sorted%lmtiny(ind(1:npl)) - pl%nplenc(1:npl) = pl_sorted%nplenc(ind(1:npl)) - pl%ntpenc(1:npl) = pl_sorted%ntpenc(ind(1:npl)) - pl%levelg(1:npl) = pl_sorted%levelg(ind(1:npl)) - pl%levelm(1:npl) = pl_sorted%levelm(ind(1:npl)) - pl%isperi(1:npl) = pl_sorted%isperi(ind(1:npl)) - pl%peri(1:npl) = pl_sorted%peri(ind(1:npl)) - pl%atp(1:npl) = pl_sorted%atp(ind(1:npl)) - pl%info(1:npl) = pl_sorted%info(ind(1:npl)) - pl%kin(1:npl) = pl_sorted%kin(ind(1:npl)) - do i = 1, npl - do j = 1, pl%kin(i)%nchild - pl%kin(i)%child(j) = ind(pl%kin(i)%child(j)) + if (allocated(pl%lcollision)) pl%lcollision(1:npl) = pl_sorted%lcollision(ind(1:npl)) + if (allocated(pl%lencounter)) pl%lencounter(1:npl) = pl_sorted%lencounter(ind(1:npl)) + if (allocated(pl%lmtiny)) pl%lmtiny(1:npl) = pl_sorted%lmtiny(ind(1:npl)) + if (allocated(pl%nplenc)) pl%nplenc(1:npl) = pl_sorted%nplenc(ind(1:npl)) + if (allocated(pl%ntpenc)) pl%ntpenc(1:npl) = pl_sorted%ntpenc(ind(1:npl)) + if (allocated(pl%levelg)) pl%levelg(1:npl) = pl_sorted%levelg(ind(1:npl)) + if (allocated(pl%levelm)) pl%levelm(1:npl) = pl_sorted%levelm(ind(1:npl)) + if (allocated(pl%isperi)) pl%isperi(1:npl) = pl_sorted%isperi(ind(1:npl)) + if (allocated(pl%peri)) pl%peri(1:npl) = pl_sorted%peri(ind(1:npl)) + if (allocated(pl%atp)) pl%atp(1:npl) = pl_sorted%atp(ind(1:npl)) + if (allocated(pl%info)) pl%info(1:npl) = pl_sorted%info(ind(1:npl)) + if (allocated(pl%kin)) then + pl%kin(1:npl) = pl_sorted%kin(ind(1:npl)) + do i = 1, npl + do j = 1, pl%kin(i)%nchild + pl%kin(i)%child(j) = ind(pl%kin(i)%child(j)) + end do end do - end do + end if deallocate(pl_sorted) end associate @@ -338,9 +340,9 @@ module subroutine symba_util_sort_rearrange_tp(self, ind) associate(tp => self, ntp => self%nbody) call util_sort_rearrange_tp(tp,ind) allocate(tp_sorted, source=self) - tp%nplenc(1:ntp) = tp_sorted%nplenc(ind(1:ntp)) - tp%levelg(1:ntp) = tp_sorted%levelg(ind(1:ntp)) - tp%levelm(1:ntp) = tp_sorted%levelm(ind(1:ntp)) + if (allocated(tp%nplenc)) tp%nplenc(1:ntp) = tp_sorted%nplenc(ind(1:ntp)) + if (allocated(tp%levelg)) tp%levelg(1:ntp) = tp_sorted%levelg(ind(1:ntp)) + if (allocated(tp%levelm)) tp%levelm(1:ntp) = tp_sorted%levelm(ind(1:ntp)) deallocate(tp_sorted) end associate diff --git a/src/util/util_sort.f90 b/src/util/util_sort.f90 index 59f44c003..752e78ab7 100644 --- a/src/util/util_sort.f90 +++ b/src/util/util_sort.f90 @@ -161,28 +161,27 @@ module subroutine util_sort_rearrange_body(self, ind) associate(n => self%nbody) allocate(body_sorted, source=self) - self%id(1:n) = body_sorted%id(ind(1:n)) - self%name(1:n) = body_sorted%name(ind(1:n)) - self%status(1:n) = body_sorted%status(ind(1:n)) - self%ldiscard(1:n) = body_sorted%ldiscard(ind(1:n)) - self%xh(:,1:n) = body_sorted%xh(:,ind(1:n)) - self%vh(:,1:n) = body_sorted%vh(:,ind(1:n)) - self%xb(:,1:n) = body_sorted%xb(:,ind(1:n)) - self%vb(:,1:n) = body_sorted%vb(:,ind(1:n)) - self%ah(:,1:n) = body_sorted%ah(:,ind(1:n)) - self%ir3h(1:n) = body_sorted%ir3h(ind(1:n)) - self%mu(1:n) = body_sorted%mu(ind(1:n)) - self%lmask(1:n) = body_sorted%lmask(ind(1:n)) - - if (allocated(self%a)) self%a(1:n) = body_sorted%a(ind(1:n)) - if (allocated(self%e)) self%e(1:n) = body_sorted%e(ind(1:n)) - if (allocated(self%inc)) self%inc(1:n) = body_sorted%inc(ind(1:n)) - if (allocated(self%capom)) self%capom(1:n) = body_sorted%capom(ind(1:n)) - if (allocated(self%omega)) self%omega(1:n) = body_sorted%omega(ind(1:n)) - if (allocated(self%capm)) self%capm(1:n) = body_sorted%capm(ind(1:n)) - if (allocated(self%aobl)) self%aobl(:,1:n) = body_sorted%aobl(:,ind(1:n)) - if (allocated(self%atide)) self%atide(:,1:n) = body_sorted%atide(:,ind(1:n)) - if (allocated(self%agr)) self%agr(:,1:n) = body_sorted%agr(:,ind(1:n)) + if (allocated(self%id)) self%id(1:n) = body_sorted%id(ind(1:n)) + if (allocated(self%name)) self%name(1:n) = body_sorted%name(ind(1:n)) + if (allocated(self%status)) self%status(1:n) = body_sorted%status(ind(1:n)) + if (allocated(self%ldiscard)) self%ldiscard(1:n) = body_sorted%ldiscard(ind(1:n)) + if (allocated(self%xh)) self%xh(:,1:n) = body_sorted%xh(:,ind(1:n)) + if (allocated(self%vh)) self%vh(:,1:n) = body_sorted%vh(:,ind(1:n)) + if (allocated(self%xb)) self%xb(:,1:n) = body_sorted%xb(:,ind(1:n)) + if (allocated(self%vb)) self%vb(:,1:n) = body_sorted%vb(:,ind(1:n)) + if (allocated(self%ah)) self%ah(:,1:n) = body_sorted%ah(:,ind(1:n)) + if (allocated(self%ir3h)) self%ir3h(1:n) = body_sorted%ir3h(ind(1:n)) + if (allocated(self%mu)) self%mu(1:n) = body_sorted%mu(ind(1:n)) + if (allocated(self%lmask)) self%lmask(1:n) = body_sorted%lmask(ind(1:n)) + if (allocated(self%a)) self%a(1:n) = body_sorted%a(ind(1:n)) + if (allocated(self%e)) self%e(1:n) = body_sorted%e(ind(1:n)) + if (allocated(self%inc)) self%inc(1:n) = body_sorted%inc(ind(1:n)) + if (allocated(self%capom)) self%capom(1:n) = body_sorted%capom(ind(1:n)) + if (allocated(self%omega)) self%omega(1:n) = body_sorted%omega(ind(1:n)) + if (allocated(self%capm)) self%capm(1:n) = body_sorted%capm(ind(1:n)) + if (allocated(self%aobl)) self%aobl(:,1:n) = body_sorted%aobl(:,ind(1:n)) + if (allocated(self%atide)) self%atide(:,1:n) = body_sorted%atide(:,ind(1:n)) + if (allocated(self%agr)) self%agr(:,1:n) = body_sorted%agr(:,ind(1:n)) deallocate(body_sorted) end associate @@ -204,9 +203,9 @@ module subroutine util_sort_rearrange_pl(self, ind) associate(pl => self, npl => self%nbody) call util_sort_rearrange_body(pl,ind) allocate(pl_sorted, source=self) - pl%mass(1:npl) = pl_sorted%mass(ind(1:npl)) - pl%Gmass(1:npl) = pl_sorted%Gmass(ind(1:npl)) - pl%rhill(1:npl) = pl_sorted%rhill(ind(1:npl)) + if (allocated(pl%mass)) pl%mass(1:npl) = pl_sorted%mass(ind(1:npl)) + if (allocated(pl%Gmass)) pl%Gmass(1:npl) = pl_sorted%Gmass(ind(1:npl)) + if (allocated(pl%rhill)) pl%rhill(1:npl) = pl_sorted%rhill(ind(1:npl)) if (allocated(pl%xbeg)) pl%xbeg(:,1:npl) = pl_sorted%xbeg(:,ind(1:npl)) if (allocated(pl%xend)) pl%xend(:,1:npl) = pl_sorted%xend(:,ind(1:npl)) if (allocated(pl%vbeg)) pl%vbeg(:,1:npl) = pl_sorted%vbeg(:,ind(1:npl)) @@ -240,9 +239,9 @@ module subroutine util_sort_rearrange_tp(self, ind) associate(tp => self, ntp => self%nbody) call util_sort_rearrange_body(tp,ind) allocate(tp_sorted, source=self) - tp%isperi(1:ntp) = tp_sorted%isperi(ind(1:ntp)) - tp%peri(1:ntp) = tp_sorted%peri(ind(1:ntp)) - tp%atp(1:ntp) = tp_sorted%atp(ind(1:ntp)) + if (allocated(tp%isperi)) tp%isperi(1:ntp) = tp_sorted%isperi(ind(1:ntp)) + if (allocated(tp%peri)) tp%peri(1:ntp) = tp_sorted%peri(ind(1:ntp)) + if (allocated(tp%atp)) tp%atp(1:ntp) = tp_sorted%atp(ind(1:ntp)) deallocate(tp_sorted) end associate diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index dbcd9c916..deb5dde5a 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -155,11 +155,11 @@ module subroutine whm_util_sort_rearrange_pl(self, ind) associate(pl => self, npl => self%nbody) call util_sort_rearrange_pl(pl,ind) allocate(pl_sorted, source=self) - pl%eta(1:npl) = pl_sorted%eta(ind(1:npl)) - pl%xj(:,1:npl) = pl_sorted%xj(:,ind(1:npl)) - pl%vj(:,1:npl) = pl_sorted%vj(:,ind(1:npl)) - pl%muj(1:npl) = pl_sorted%muj(ind(1:npl)) - pl%ir3j(1:npl) = pl_sorted%ir3j(ind(1:npl)) + if (allocated(pl%eta)) pl%eta(1:npl) = pl_sorted%eta(ind(1:npl)) + if (allocated(pl%xj)) pl%xj(:,1:npl) = pl_sorted%xj(:,ind(1:npl)) + if (allocated(pl%vj)) pl%vj(:,1:npl) = pl_sorted%vj(:,ind(1:npl)) + if (allocated(pl%muj)) pl%muj(1:npl) = pl_sorted%muj(ind(1:npl)) + if (allocated(pl%ir3j)) pl%ir3j(1:npl) = pl_sorted%ir3j(ind(1:npl)) deallocate(pl_sorted) end associate