From 77ee9ccdb892192c12aebf99ee7c6efdcce44323 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 6 Aug 2021 16:33:13 -0400 Subject: [PATCH] Changed id validation code to by type-bound to the system object, and include cb ids in the validation --- Makefile.Defines | 4 ++-- src/fragmentation/fragmentation.f90 | 8 ++++++-- src/modules/swiftest_classes.f90 | 9 +++++---- src/setup/setup.f90 | 4 +--- src/util/util_valid.f90 | 20 +++++++++++--------- 5 files changed, 25 insertions(+), 20 deletions(-) diff --git a/Makefile.Defines b/Makefile.Defines index 291f2c604..9fe6c3cbb 100644 --- a/Makefile.Defines +++ b/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 diff --git a/src/fragmentation/fragmentation.f90 b/src/fragmentation/fragmentation.f90 index 60572e99d..99daff3b7 100644 --- a/src/fragmentation/fragmentation.f90 +++ b/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) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index e8d273f1c..7f4fd140e 100644 --- a/src/modules/swiftest_classes.f90 +++ b/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 diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 9346e8c12..8f96c48a1 100644 --- a/src/setup/setup.f90 +++ b/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 diff --git a/src/util/util_valid.f90 b/src/util/util_valid.f90 index c5923b38e..f05c81f35 100644 --- a/src/util/util_valid.f90 +++ b/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