diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index e54a96f5c..d98e0f57d 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -19,16 +19,19 @@ module subroutine symba_util_append_pl(self, source, lsource_mask) !! This method will automatically resize the destination body if it is too small implicit none !! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_body), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + class(symba_pl), intent(inout) :: self + !! SyMBA massive body object + class(swiftest_body), intent(in) :: source + !! Source object to append + logical, dimension(:), intent(in) :: lsource_mask + !! Logical mask indicating which elements to append to select type(source) class is (symba_pl) call util_append(self%levelg, source%levelg, lsource_mask=lsource_mask) call util_append(self%levelm, source%levelm, lsource_mask=lsource_mask) - - call swiftest_util_append_pl(self, source, lsource_mask) ! Note: helio_pl does not have its own append method, so we skip back to the base class + ! Note: helio_pl does not have its own append method, so we skip back to the base class + call swiftest_util_append_pl(self, source, lsource_mask) class default write(*,*) "Invalid object passed to the append method. Source must be of class symba_pl or its descendents!" call base_util_exit(FAILURE) @@ -45,16 +48,19 @@ module subroutine symba_util_append_tp(self, source, lsource_mask) !! This method will automatically resize the destination body if it is too small implicit none !! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - class(swiftest_body), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + class(symba_tp), intent(inout) :: self + !! SyMBA test particle object + class(swiftest_body), intent(in) :: source + !! Source object to append + logical, dimension(:), intent(in) :: lsource_mask + !! Logical mask indicating which elements to append to select type(source) class is (symba_tp) call util_append(self%levelg, source%levelg, lsource_mask=lsource_mask) call util_append(self%levelm, source%levelm, lsource_mask=lsource_mask) - - call swiftest_util_append_tp(self, source, lsource_mask) ! Note: helio_tp does not have its own append method, so we skip back to the base class + ! Note: helio_tp does not have its own append method, so we skip back to the base class + call swiftest_util_append_tp(self, source, lsource_mask) class default write(*,*) "Invalid object passed to the append method. Source must be of class symba_tp or its descendents!" call base_util_exit(FAILURE) @@ -70,7 +76,8 @@ module subroutine symba_util_dealloc_pl(self) !! Deallocates all allocatabale arrays implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object + class(symba_pl), intent(inout) :: self + !! SyMBA massive body object if (allocated(self%levelg)) deallocate(self%levelg) if (allocated(self%levelm)) deallocate(self%levelm) @@ -88,6 +95,7 @@ module subroutine symba_util_dealloc_system(self) implicit none ! Arguments class(symba_nbody_system), intent(inout) :: self + !! SyMBA nbody_system object self%irec = -1 call self%helio_nbody_system%dealloc() @@ -102,7 +110,8 @@ module subroutine symba_util_dealloc_tp(self) !! Deallocates all allocatabale arrays implicit none ! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object + class(symba_tp), intent(inout) :: self + !! SyMBA test particle object if (allocated(self%levelg)) deallocate(self%levelg) if (allocated(self%levelm)) deallocate(self%levelm) @@ -150,17 +159,20 @@ module subroutine symba_util_fill_tp(self, inserts, lfill_list) !! implicit none ! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - class(swiftest_body), intent(in) :: inserts !! Inserted object - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + class(symba_tp), intent(inout) :: self + !! SyMBA test particle object + class(swiftest_body), intent(in) :: inserts + !! Inserted object + logical, dimension(:), intent(in) :: lfill_list + !! Logical array of bodies to merge into the keeps associate(keeps => self) select type(inserts) class is (symba_tp) call util_fill(keeps%levelg, inserts%levelg, lfill_list) call util_fill(keeps%levelm, inserts%levelm, lfill_list) - - call swiftest_util_fill_tp(keeps, inserts, lfill_list) ! Note: helio_tp does not have its own fill method, so we skip back to the base class + ! Note: helio_tp does not have its own fill method, so we skip back to the base class + call swiftest_util_fill_tp(keeps, inserts, lfill_list) class default write(*,*) "Invalid object passed to the fill method. Source must be of class symba_tp or its descendents!" call base_util_exit(FAILURE) @@ -184,11 +196,18 @@ module subroutine symba_util_flatten_eucl_plpl(self, param) !! 2019. hal-0204751 implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(symba_pl), intent(inout) :: self + !! SyMBA massive body object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters ! Internals integer(I8B) :: npl, nplm + if (self%nbody == 0) then + self%nplm = 0 + return + end if + associate(pl => self, nplplm => self%nplplm) npl = int(self%nbody, kind=I8B) if (param%lmtiny_pl) then @@ -198,7 +217,8 @@ module subroutine symba_util_flatten_eucl_plpl(self, param) nplm = npl end if pl%nplm = int(nplm, kind=I4B) - nplplm = nplm * npl - nplm * (nplm + 1_I8B) / 2_I8B ! number of entries in a strict lower triangle, npl x npl, minus first column including only mutually interacting bodies + ! number of entries in a strict lower triangle, npl x npl, minus first column including only mutually interacting bodies + nplplm = nplm * npl - nplm * (nplm + 1_I8B) / 2_I8B call swiftest_util_flatten_eucl_plpl(pl, param) end associate @@ -213,8 +233,10 @@ module subroutine symba_util_resize_pl(self, nnew) !! Checks the current size of a SyMBA massive body object against the requested size and resizes it if it is too small. implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), intent(in) :: nnew !! New size neded + class(symba_pl), intent(inout) :: self + !! SyMBA massive body object + integer(I4B), intent(in) :: nnew + !! New size neded call util_resize(self%levelg, nnew) call util_resize(self%levelm, nnew) @@ -230,8 +252,10 @@ module subroutine symba_util_resize_tp(self, nnew) !! Checks the current size of a test particle object against the requested size and resizes it if it is too small. implicit none ! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - integer(I4B), intent(in) :: nnew !! New size neded + class(symba_tp), intent(inout) :: self + !! SyMBA test particle object + integer(I4B), intent(in):: nnew + !! New size neded call util_resize(self%levelg, nnew) call util_resize(self%levelm, nnew) @@ -248,8 +272,10 @@ module subroutine symba_util_set_renc(self, scale) !! implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), intent(in) :: scale !! Current recursion depth + class(symba_pl), intent(inout) :: self + !! SyMBA massive body object + integer(I4B), intent(in) :: scale + !! Current recursion depth ! Internals integer(I4B) :: i real(DP) :: rshell_irec @@ -275,9 +301,12 @@ module subroutine symba_util_setup_initialize_system(self, system_history, param !! implicit none ! Arguments - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody_system object - class(swiftest_storage), allocatable, intent(inout) :: system_history !! Stores the system history between output dumps - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(symba_nbody_system), intent(inout) :: self + !! SyMBA nbody_system object + class(swiftest_storage),allocatable, intent(inout) :: system_history + !! Stores the system history between output dumps + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters ! Call parent method associate(nbody_system => self) @@ -312,11 +341,14 @@ module subroutine symba_util_setup_pl(self, n, param) !! Equivalent in functionality to David E. Kaufmann's Swifter routine symba_util_setup.f90 implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter - - !> Call allocation method for parent class. + class(symba_pl), intent(inout) :: self + !! SyMBA massive body object + integer(I4B), intent(in) :: n + !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameter + + ! Call allocation method for parent class. call self%helio_pl%setup(n, param) if (n == 0) return @@ -337,9 +369,12 @@ module subroutine symba_util_setup_tp(self, n, param) !! Equivalent in functionality to David E. Kaufmann's Swifter routine whm_util_setup.f90 implicit none ! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter + class(symba_tp), intent(inout) :: self + !! SyMBA test particle object + integer(I4B), intent(in) :: n + !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameter !> Call allocation method for parent class. call self%helio_tp%setup(n, param) @@ -362,9 +397,12 @@ module subroutine symba_util_sort_pl(self, sortby, ascending) !! sortby is a string indicating which array component to sort. implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - character(*), intent(in) :: sortby !! Sorting attribute - logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order + class(symba_pl), intent(inout) :: self + !! SyMBA massive body object + character(*), intent(in) :: sortby + !! Sorting attribute + logical, intent(in) :: ascending + !! Logical flag indicating whether or not the sorting should be in ascending or descending order ! Internals integer(I4B), dimension(:), allocatable :: ind integer(I4B) :: direction @@ -403,9 +441,12 @@ module subroutine symba_util_sort_tp(self, sortby, ascending) !! sortby is a string indicating which array component to sort. implicit none ! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - character(*), intent(in) :: sortby !! Sorting attribute - logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order + class(symba_tp), intent(inout) :: self + !! SyMBA test particle object + character(*), intent(in) :: sortby + !! Sorting attribute + logical, intent(in) :: ascending + !! Logical flag indicating whether or not the sorting should be in ascending or descending order ! Internals integer(I4B), dimension(:), allocatable :: ind integer(I4B) :: direction @@ -445,8 +486,10 @@ module subroutine symba_util_sort_rearrange_pl(self, ind) !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) + class(symba_pl), intent(inout) :: self ! + ! SyMBA massive body object + integer(I4B), dimension(:), intent(in) :: ind + !! Index array used to restructure the body (should contain all 1:n index values in the desired order) associate(pl => self, npl => self%nbody) call util_sort_rearrange(pl%levelg, ind, npl) @@ -465,8 +508,10 @@ module subroutine symba_util_sort_rearrange_tp(self, ind) !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. implicit none ! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) + class(symba_tp), intent(inout) :: self + !! SyMBA test particle object + integer(I4B), dimension(:), intent(in) :: ind + !! Index array used to restructure the body (should contain all 1:n index values in the desired order) associate(tp => self, ntp => self%nbody) call util_sort_rearrange(tp%nplenc, ind, ntp) @@ -487,10 +532,14 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) !! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90 implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - 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 + class(symba_pl), intent(inout) :: self + !! SyMBA massive body object + 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 ! For each component, pack the discarded bodies into the discard object and do the inverse with the keeps !> Spill all the common components @@ -518,10 +567,14 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) !! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90 implicit none ! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - 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 + class(symba_tp), intent(inout) :: self + !! SyMBA test particle object + 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 ! For each component, pack the discarded bodies into the discard object and do the inverse with the keeps !> Spill all the common components