diff --git a/src/rmvs/rmvs_setup.f90 b/src/rmvs/rmvs_setup.f90 index 92043e0fe..e59202cd9 100644 --- a/src/rmvs/rmvs_setup.f90 +++ b/src/rmvs/rmvs_setup.f90 @@ -19,7 +19,13 @@ module subroutine rmvs_setup_pl(self, n, param) !> Call allocation method for parent class associate(pl => self) call whm_setup_pl(pl, n, param) - if (n <= 0) return + if (n < 0) return + + if (allocated(pl%outer)) deallocate(pl%outer) + if (allocated(pl%inner)) deallocate(pl%inner) + if (allocated(pl%nenc)) deallocate(pl%nenc) + + if (n == 0) return allocate(pl%outer(0:NTENC)) allocate(pl%inner(0:NTPHENC)) @@ -145,12 +151,14 @@ module subroutine rmvs_setup_tp(self, n, param) !> Call allocation method for parent class. In this case, whm does not have its own setup method, so we use the base method for swiftest_tp call setup_tp(self, n, param) - if (n <= 0) return + 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) + if (n == 0) return + allocate(self%lperi(n)) allocate(self%plperP(n)) allocate(self%plencP(n)) diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 82e549ce5..976e73956 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -82,7 +82,7 @@ module subroutine setup_encounter(self, n) integer(I4B), intent(in) :: n !! Number of encounters to allocate space for self%nenc = n - if (n == 0) return + if (n < 0) return if (allocated(self%lvdotr)) deallocate(self%lvdotr) if (allocated(self%status)) deallocate(self%status) @@ -97,6 +97,8 @@ module subroutine setup_encounter(self, n) if (allocated(self%v2)) deallocate(self%v2) if (allocated(self%t)) deallocate(self%t) + if (n == 0) return + allocate(self%lvdotr(n)) allocate(self%status(n)) allocate(self%kidx(n)) @@ -205,7 +207,8 @@ module subroutine setup_body(self, n, param) integer(I4B) :: i self%nbody = n - if (n <= 0) return + if (n < 0) return + self%lfirst = .true. if (allocated(self%id)) deallocate(self%id) @@ -220,6 +223,11 @@ module subroutine setup_body(self, n, param) if (allocated(self%ir3h)) deallocate(self%ir3h) if (allocated(self%mu)) deallocate(self%mu) if (allocated(self%lmask)) deallocate(self%lmask) + if (allocated(self%aobl)) deallocate(self%aobl) + if (allocated(self%atide)) deallocate(self%lmask) + if (allocated(self%agr)) deallocate(self%lmask) + + if (n == 0) return allocate(self%id(n)) allocate(self%info(n)) @@ -263,17 +271,14 @@ 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 @@ -296,14 +301,21 @@ module subroutine setup_pl(self, n, param) !> Call allocation method for parent class !> The parent class here is the abstract swiftest_body class, so we can't use the type-bound procedure call setup_body(self, n, param) - if (n <= 0) return + if (n < 0) return - if (allocated(self%info)) deallocate(self%info) if (allocated(self%mass)) deallocate(self%mass) if (allocated(self%Gmass)) deallocate(self%Gmass) if (allocated(self%rhill)) deallocate(self%rhill) + if (allocated(self%radius)) deallocate(self%radius) + if (allocated(self%density)) deallocate(self%density) + if (allocated(self%rot)) deallocate(self%rot) + if (allocated(self%Ip)) deallocate(self%Ip) + if (allocated(self%k2)) deallocate(self%k2) + if (allocated(self%Q)) deallocate(self%Q) + if (allocated(self%tlag)) deallocate(self%tlag) + + if (n == 0) return - allocate(swiftest_particle_info :: self%info(n)) allocate(self%mass(n)) allocate(self%Gmass(n)) allocate(self%rhill(n)) @@ -315,8 +327,6 @@ 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 @@ -324,8 +334,6 @@ module subroutine setup_pl(self, n, param) end if if (param%lrotation) then - if (allocated(self%rot)) deallocate(self%rot) - if (allocated(self%Ip)) deallocate(self%Ip) allocate(self%rot(NDIM, n)) allocate(self%Ip(NDIM, n)) self%rot(:,:) = 0.0_DP @@ -333,9 +341,6 @@ module subroutine setup_pl(self, n, param) end if if (param%ltides) then - if (allocated(self%k2)) deallocate(self%k2) - if (allocated(self%Q)) deallocate(self%Q) - if (allocated(self%tlag)) deallocate(self%tlag) allocate(self%k2(n)) allocate(self%Q(n)) allocate(self%tlag(n)) @@ -362,19 +367,18 @@ module subroutine setup_tp(self, n, param) !> Call allocation method for parent class !> The parent class here is the abstract swiftest_body class, so we can't use the type-bound procedure call setup_body(self, n, param) - if (n <= 0) return + if (n < 0) return - if (allocated(self%info)) deallocate(self%info) if (allocated(self%isperi)) deallocate(self%isperi) if (allocated(self%peri)) deallocate(self%peri) if (allocated(self%atp)) deallocate(self%atp) - allocate(swiftest_particle_info :: self%info(n)) + if (n == 0) return + allocate(self%isperi(n)) allocate(self%peri(n)) allocate(self%atp(n)) - self%info(:)%particle_type = TP_TYPE_NAME self%isperi(:) = 0 self%peri(:) = 0.0_DP self%atp(:) = 0.0_DP diff --git a/src/symba/symba_setup.f90 b/src/symba/symba_setup.f90 index 9eff6bf6c..9c1fdb343 100644 --- a/src/symba/symba_setup.f90 +++ b/src/symba/symba_setup.f90 @@ -43,9 +43,12 @@ module subroutine symba_setup_merger(self, n, param) !> Call allocation method for parent class. In this case, helio_pl does not have its own setup method so we use the base method for swiftest_pl call symba_setup_pl(self, n, param) - if (n <= 0) return + if (n < 0) return if (allocated(self%ncomp)) deallocate(self%ncomp) + + if (n == 0) return + allocate(self%ncomp(n)) self%ncomp(:) = 0 @@ -69,8 +72,7 @@ module subroutine symba_setup_pl(self, n, param) !> Call allocation method for parent class. In this case, helio_pl does not have its own setup method so we use the base method for swiftest_pl call setup_pl(self, n, param) - if (n <= 0) return - + if (n < 0) return if (allocated(self%lcollision)) deallocate(self%lcollision) if (allocated(self%lencounter)) deallocate(self%lencounter) @@ -84,6 +86,8 @@ module subroutine symba_setup_pl(self, n, param) if (allocated(self%atp)) deallocate(self%atp) if (allocated(self%kin)) deallocate(self%kin) + if (n == 0) return + allocate(self%lcollision(n)) allocate(self%lencounter(n)) allocate(self%lmtiny(n)) @@ -123,9 +127,12 @@ module subroutine symba_setup_encounter(self, n) integer(I4B), intent(in) :: n !! Number of encounters to allocate space for call setup_encounter(self, n) - if (n == 0) return + if (n < 0) return if (allocated(self%level)) deallocate(self%level) + + if (n ==0) return + allocate(self%level(n)) self%level(:) = -1 @@ -148,13 +155,15 @@ module subroutine symba_setup_tp(self, n, param) !> Call allocation method for parent class. In this case, helio_tp does not have its own setup method so we use the base method for swiftest_tp call setup_tp(self, n, param) - if (n <= 0) return + 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) if (allocated(self%info)) deallocate(self%info) + if (n == 0) return + allocate(self%nplenc(n)) allocate(self%levelg(n)) allocate(self%levelm(n)) diff --git a/src/whm/whm_setup.f90 b/src/whm/whm_setup.f90 index 3510769a7..8dee15982 100644 --- a/src/whm/whm_setup.f90 +++ b/src/whm/whm_setup.f90 @@ -16,7 +16,7 @@ module subroutine whm_setup_pl(self, n, param) !> Call allocation method for parent class call setup_pl(self, n, param) - if (n <= 0) return + if (n < 0) return if (allocated(self%eta)) deallocate(self%eta) if (allocated(self%muj)) deallocate(self%muj) @@ -24,6 +24,8 @@ module subroutine whm_setup_pl(self, n, param) if (allocated(self%vj)) deallocate(self%vj) if (allocated(self%ir3j)) deallocate(self%ir3j) + if (n == 0) return + allocate(self%eta(n)) allocate(self%muj(n)) allocate(self%xj(NDIM, n))