Changed id validation code to by type-bound to the system object, and…

… include cb ids in the validation

Makefile.Defines

@@ -70,8 +70,8 @@ FFLAGS  = $(IDEBUG) $(HEAPARR)
 FORTRAN = ifort
 #AR     = xiar
 
-#FORTRAN = gfortran
-#FFLAGS =  -ffree-line-length-none $(GDEBUG) $(GMEM)
+FORTRAN = gfortran
+FFLAGS =  -ffree-line-length-none $(GDEBUG) $(GMEM)
 AR     = ar
 
 # DO NOT include in CFLAGS the "-c" option to compile object only

src/fragmentation/fragmentation.f90

@@ -336,8 +336,12 @@ subroutine calculate_system_energy(linclude_fragments)
             call setup_construct_system(tmpsys, param)
             deallocate(tmpsys%cb)
             allocate(tmpsys%cb, source=cb)
-            allocate(ltmp(npl))
-            ltmp(:) = .true.
+            allocate(ltmp, mold=pl%ldiscard)
+            ltmp(:) = .false.
+            ltmp(1:npl) = .true.
+            write(*,*) 'npl    : ',npl
+            write(*,*) 'npl_new: ',npl_new
+            write(*,*) 'ltmp: ',ltmp
             call tmpsys%pl%setup(npl_new, param)
             call tmpsys%pl%fill(pl, ltmp)
             deallocate(ltmp)

src/modules/swiftest_classes.f90

@@ -306,6 +306,7 @@ module swiftest_classes
       procedure :: step_spin               => tides_step_spin_system          !! Steps the spins of the massive & central bodies due to tides.
       procedure :: set_msys                => util_set_msys                   !! Sets the value of msys from the masses of system bodies.
       procedure :: get_energy_and_momentum => util_get_energy_momentum_system !! Calculates the total system energy and momentum
+      procedure :: validate_ids            => util_valid_id_system            !! Validate the numerical ids passed to the system and save the maximum value
    end type swiftest_nbody_system
 
    type :: swiftest_encounter
@@ -1292,11 +1293,11 @@ module subroutine util_spill_tp(self, discards, lspill_list, ldestructive)
          logical,               intent(in)    :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not
       end subroutine util_spill_tp
 
-      module subroutine util_valid(pl, tp)
+      module subroutine util_valid_id_system(self, param)
          implicit none
-         class(swiftest_pl), intent(in) :: pl
-         class(swiftest_tp), intent(in) :: tp
-      end subroutine util_valid
+         class(swiftest_nbody_system), intent(inout) :: self  !! Swiftest nbody system object
+         class(swiftest_parameters),   intent(in)    :: param !! Current run configuration parameters
+      end subroutine util_valid_id_system
 
       module subroutine util_version()
          implicit none

src/setup/setup.f90

@@ -127,14 +127,12 @@ module subroutine setup_initialize_system(self, param)
       call self%cb%initialize(param)
       call self%pl%initialize(param)
       call self%tp%initialize(param)
-      call util_valid(self%pl, self%tp)
-      self%maxid = maxval([self%pl%id(:), self%tp%id(:)])
+      call self%validate_ids(param)
       call self%set_msys()
       call self%pl%set_mu(self%cb) 
       call self%tp%set_mu(self%cb) 
       call self%pl%eucl_index()
       if (.not.param%lrhill_present) call self%pl%set_rhill(self%cb)
-      !if (param%lfirstenergy) then
       return
    end subroutine setup_initialize_system
 

src/util/util_valid.f90

@@ -2,7 +2,7 @@
    use swiftest
 contains
 
-   module subroutine util_valid(pl, tp)
+   module subroutine util_valid_id_system(self, param)
       !! author: David A. Minton
       !!
       !! Validate massive body and test particle ids
@@ -11,31 +11,33 @@ module subroutine util_valid(pl, tp)
       !! Adapted from David E. Kaufmann's Swifter routine: util_valid.f90
       implicit none
       ! Arguments
-      class(swiftest_pl), intent(in) :: pl
-      class(swiftest_tp), intent(in) :: tp
+      class(swiftest_nbody_system), intent(inout) :: self   !! Swiftest nbody system object
+      class(swiftest_parameters),   intent(in)    :: param  !! Current run configuration parameters
       ! Internals
       integer(I4B)                  :: i
       integer(I4B), dimension(:), allocatable :: idarr
 
-      associate(npl => pl%nbody, ntp => tp%nbody)
-         allocate(idarr(npl+ntp))
+      associate(cb => self%cb, pl => self%pl, npl => self%pl%nbody, tp => self%tp, ntp => self%tp%nbody)
+         allocate(idarr(1+npl+ntp))
+         idarr(1) = cb%id
          do i = 1, npl
-            idarr(i) = pl%id(i)
+            idarr(1+i) = pl%id(i)
          end do
          do i = 1, ntp
-            idarr(npl+i) = tp%id(i)
+            idarr(1+npl+i) = tp%id(i)
          end do
          call util_sort(idarr)
-         do i = 1, npl + ntp - 1
+         do i = 1, npl + ntp 
             if (idarr(i) == idarr(i+1)) then
                write(*, *) "Swiftest error:"
                write(*, *) "   more than one body/particle has id = ", idarr(i)
                call util_exit(FAILURE)
             end if
          end do
+         self%maxid = maxval(idarr)
       end associate
 
       return
-   end subroutine util_valid
+   end subroutine util_valid_id_system
 
 end submodule s_util_valid