Switched out more associates with integers for number of bodies/event…

…s in subroutines where those numbers may change.

src/discard/discard.f90

@@ -73,9 +73,12 @@ module subroutine discard_tp(self, system, param)
       class(swiftest_parameters),   intent(inout) :: param  !! Current run configuration parameter
       ! Internals
       logical, dimension(:), allocatable :: ldiscard
+      integer(I4B) :: npl, ntp
 
-      associate(tp => self, ntp => self%nbody, cb => system%cb, pl => system%pl, npl => system%pl%nbody)
+      associate(tp => self, cb => system%cb, pl => system%pl)
          if ((ntp == 0) .or. (npl ==0)) return 
+         ntp = tp%nbody
+         npl = pl%nbody
 
          if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. &
              (param%rmaxu >= 0.0_DP) .or. ((param%qmin >= 0.0_DP) .and. (param%qmin_coord == "BARY"))) then

src/symba/symba_collision.f90

@@ -745,11 +745,12 @@ module subroutine symba_collision_encounter_extract_collisions(self, system, par
       logical,      dimension(:), allocatable :: lplpl_unique_parent
       integer(I4B), dimension(:), pointer     :: plparent
       integer(I4B), dimension(:), allocatable :: collision_idx, unique_parent_idx
-      integer(I4B)                            :: i, index_coll, ncollisions, nunique_parent
+      integer(I4B)                            :: i, index_coll, ncollisions, nunique_parent, nplplenc
 
       select type (pl => system%pl)
       class is (symba_pl)
-         associate(plplenc_list => self, nplplenc => self%nenc, idx1 => self%index1, idx2 => self%index2, plparent => pl%kin%parent)
+         associate(plplenc_list => self, idx1 => self%index1, idx2 => self%index2, plparent => pl%kin%parent)
+            nplplenc = plplenc_list%nenc
             allocate(lplpl_collision(nplplenc))
             lplpl_collision(:) = plplenc_list%status(1:nplplenc) == COLLISION
             if (.not.any(lplpl_collision)) return 

src/symba/symba_discard.f90

@@ -322,6 +322,9 @@ module subroutine symba_discard_pl(self, system, param)
 
                call symba_discard_nonplpl_conservation(self, system, param)
 
+               ! Save the add/discard information to file
+               call system%write_discard(param)
+
                call pl%rearray(system, param)
 
                if (param%lenergy) then

src/symba/symba_encounter_check.f90

@@ -178,7 +178,7 @@ module function symba_encounter_check_tp(self, system, dt, irec) result(lany_enc
       logical                                   :: lany_encounter !! Returns true if there is at least one close encounter      
       ! Internals
       real(DP)                                  :: r2crit, vdotr, r2, v2, tmin, r2min, term2
-      integer(I4B)                              :: i, j, k,nenc
+      integer(I4B)                              :: i, j, k,nenc, plind, tpind
       real(DP),     dimension(NDIM)             :: xr, vr
       logical,      dimension(:,:), allocatable :: lencounter, loc_lvdotr
 
@@ -212,15 +212,15 @@ module function symba_encounter_check_tp(self, system, dt, irec) result(lany_enc
                class is (symba_pl)
                   pl%lencounter(1:npl) = .false.
                   do k = 1, nenc
-                     associate(plind => pltpenc_list%index1(k), tpind => pltpenc_list%index2(k))
-                        pl%lencounter(plind) = .true.
-                        pl%levelg(plind) = irec
-                        pl%levelm(plind) = irec
-                        tp%levelg(tpind) = irec
-                        tp%levelm(tpind) = irec
-                        pl%ntpenc(plind) = pl%ntpenc(plind) + 1
-                        tp%nplenc(tpind) = tp%nplenc(tpind) + 1
-                     end associate
+                     plind = pltpenc_list%index1(k)
+                     tpind = pltpenc_list%index2(k)
+                     pl%lencounter(plind) = .true.
+                     pl%levelg(plind) = irec
+                     pl%levelm(plind) = irec
+                     tp%levelg(tpind) = irec
+                     tp%levelm(tpind) = irec
+                     pl%ntpenc(plind) = pl%ntpenc(plind) + 1
+                     tp%nplenc(tpind) = tp%nplenc(tpind) + 1
                   end do
                end select
             end associate

src/symba/symba_kick.f90

@@ -77,7 +77,7 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg)
       real(DP),                     intent(in)    :: t      !! Current time
       logical,                      intent(in)    :: lbeg   !! Logical flag that determines whether or not this is the beginning or end of the step
       ! Internals
-      integer(I4B)              :: k
+      integer(I4B)              :: i, j, k
       real(DP)                  :: rjj, fac, rlim2
       real(DP), dimension(NDIM) :: dx
 
@@ -88,18 +88,18 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg)
             call helio_kick_getacch_tp(tp, system, param, t, lbeg)
             ! Remove accelerations from encountering pairs
             do k = 1, npltpenc
-               associate(i => pltpenc_list%index1(k), j => pltpenc_list%index2(k))
-                  if (tp%lmask(j)) THEN
-                     if (lbeg) then
-                        dx(:) = tp%xh(:,j) - pl%xbeg(:,i)
-                     else
-                        dx(:) = tp%xh(:,j) - pl%xend(:,i)
-                     end if
-                     rjj = dot_product(dx(:), dx(:))
-                     fac = pl%Gmass(i) / (rjj * sqrt(rjj))
-                     tp%ah(:,j) = tp%ah(:,j) + fac * dx(:)
-                  end IF
-               end associate
+               i = pltpenc_list%index1(k)
+               j = pltpenc_list%index2(k)
+               if (tp%lmask(j)) THEN
+                  if (lbeg) then
+                     dx(:) = tp%xh(:,j) - pl%xbeg(:,i)
+                  else
+                     dx(:) = tp%xh(:,j) - pl%xend(:,i)
+                  end if
+                  rjj = dot_product(dx(:), dx(:))
+                  fac = pl%Gmass(i) / (rjj * sqrt(rjj))
+                  tp%ah(:,j) = tp%ah(:,j) + fac * dx(:)
+               end IF
             end do
          end associate
       end select

src/symba/symba_util.f90

@@ -285,19 +285,19 @@ module subroutine symba_util_index_eucl_plpl(self, param)
       class(symba_pl),            intent(inout) :: self  !! SyMBA massive body object
       class(swiftest_parameters), intent(in)    :: param !! Current run configuration parameters
       ! Internals
-      integer(I8B) :: i, j, counter, npl, nplm
+      integer(I8B) :: i, j, counter, npl, nplm, nplpl, nplplm
 
-      associate(pl => self, nplpl => self%nplpl, nplplm => self%nplplm)
+      associate(pl => self)
          npl = int(self%nbody, kind=I8B)
          call pl%sort("mass", ascending=.false.)
 
          nplm = count(.not. pl%lmtiny(1:npl))
          pl%nplm = int(nplm, kind=I4B)
 
-         nplpl = (npl * (npl - 1) / 2) ! number of entries in a strict lower triangle, npl x npl, minus first column
-         nplplm = nplm * npl - nplm * (nplm + 1) / 2 ! number of entries in a strict lower triangle, npl x npl, minus first column including only mutually interacting bodies
+         pl%nplpl = (npl * (npl - 1) / 2) ! number of entries in a strict lower triangle, npl x npl, minus first column
+         pl%nplplm = nplm * npl - nplm * (nplm + 1) / 2 ! number of entries in a strict lower triangle, npl x npl, minus first column including only mutually interacting bodies
          if (allocated(self%k_plpl)) deallocate(self%k_plpl) ! Reset the index array if it's been set previously
-         allocate(self%k_plpl(2, nplpl))
+         allocate(self%k_plpl(2, pl%nplpl))
          do i = 1, npl
             counter = (i - 1_I8B) * npl - i * (i - 1_I8B) / 2_I8B + 1_I8B
             do j = i + 1_I8B, npl
@@ -418,7 +418,7 @@ module subroutine symba_util_rearray_pl(self, system, param)
       associate(pl => self, pl_adds => system%pl_adds)
 
          npl = pl%nbody
-         nadd = pl_adds%nbody)
+         nadd = pl_adds%nbody
          if (npl == 0) return
          ! Deallocate any temporary variables
          if (allocated(pl%xbeg)) deallocate(pl%xbeg)
@@ -431,7 +431,7 @@ module subroutine symba_util_rearray_pl(self, system, param)
          call pl%spill(tmp, lspill_list=lmask, ldestructive=.true.)
          npl = pl%nbody
          call tmp%setup(0,param)
-         if (allocated(tmp)) deallocate(tmp)
+         deallocate(tmp)
          deallocate(lmask)
 
          ! Store the original plplenc list so we don't remove any of the original encounters
@@ -869,8 +869,6 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive)
       class(swiftest_body),  intent(inout) :: discards    !! Discarded object 
       logical, dimension(:), intent(in)    :: lspill_list !! Logical array of bodies to spill into the discards
       logical,               intent(in)    :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list
-      ! Internals
-      integer(I4B) :: i
 
       ! For each component, pack the discarded bodies into the discard object and do the inverse with the keeps
       !> Spill all the common components
@@ -911,10 +909,8 @@ module subroutine symba_util_spill_encounter(self, discards, lspill_list, ldestr
       class(swiftest_encounter), intent(inout) :: discards     !! Discarded object 
       logical, dimension(:),     intent(in)    :: lspill_list  !! Logical array of bodies to spill into the discards
       logical,                   intent(in)    :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list
-      ! Internals
-      integer(I4B) :: i
 
-      associate(keeps => self, nenc => self%nenc)
+      associate(keeps => self)
          select type(discards)
          class is (symba_encounter)
             call util_spill(keeps%level, discards%level, lspill_list, ldestructive)
@@ -940,8 +936,6 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive)
       class(swiftest_body),  intent(inout) :: discards     !! Discarded object 
       logical, dimension(:), intent(in)    :: lspill_list  !! Logical array of bodies to spill into the discards
       logical,               intent(in)    :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list
-      ! Internals
-      integer(I4B) :: i
 
       ! For each component, pack the discarded bodies into the discard object and do the inverse with the keeps
       !> Spill all the common components