diff --git a/src/modules/rmvs_classes.f90 b/src/modules/rmvs_classes.f90 index 4c3bac64f..49794b1ef 100644 --- a/src/modules/rmvs_classes.f90 +++ b/src/modules/rmvs_classes.f90 @@ -72,6 +72,7 @@ module rmvs_classes !! if the test particle is undergoing a close encounter or not procedure :: setup => rmvs_setup_tp !! Constructor method - Allocates space for number of particles procedure :: fill => rmvs_util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) + procedure :: resize => rmvs_util_resize_tp !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. procedure :: sort => rmvs_util_sort_tp !! Sorts body arrays by a sortable componen procedure :: rearrange => rmvs_util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => rmvs_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) @@ -92,9 +93,10 @@ module rmvs_classes logical :: lplanetocentric = .false. !! Flag that indicates that the object is a planetocentric set of masive bodies used for close encounter calculations contains procedure :: setup => rmvs_setup_pl !! Constructor method - Allocates space for number of particles + procedure :: fill => rmvs_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) + procedure :: resize => rmvs_util_resize_pl !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. procedure :: sort => rmvs_util_sort_pl !! Sorts body arrays by a sortable componen procedure :: rearrange => rmvs_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods - procedure :: fill => rmvs_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: spill => rmvs_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) end type rmvs_pl @@ -170,6 +172,18 @@ module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps end subroutine rmvs_util_fill_tp + module subroutine rmvs_util_resize_pl(self, nnew) + implicit none + class(rmvs_pl), intent(inout) :: self !! RMVS massive body object + integer(I4B), intent(in) :: nnew !! New size neded + end subroutine rmvs_util_resize_pl + + module subroutine rmvs_util_resize_tp(self, nnew) + implicit none + class(rmvs_tp), intent(inout) :: self !! RMVS test particle object + integer(I4B), intent(in) :: nnew !! New size neded + end subroutine rmvs_util_resize_tp + module subroutine rmvs_util_sort_pl(self, sortby, ascending) implicit none class(rmvs_pl), intent(inout) :: self !! RMVS massive body object diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index be342756e..00802f3fa 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -127,6 +127,8 @@ module swiftest_classes integer(I4B), dimension(:), allocatable :: id !! External identifier (unique) integer(I4B), dimension(:), allocatable :: status !! An integrator-specific status indicator logical, dimension(:), allocatable :: ldiscard !! Body should be discarded + logical, dimension(:), allocatable :: lmask !! Logical mask used to select a subset of bodies when performing certain operations (drift, kick, accel, etc.) + real(DP), dimension(:), allocatable :: mu !! G * (Mcb + [m]) real(DP), dimension(:,:), allocatable :: xh !! Heliocentric position real(DP), dimension(:,:), allocatable :: vh !! Heliocentric velocity real(DP), dimension(:,:), allocatable :: xb !! Barycentric position @@ -142,8 +144,6 @@ module swiftest_classes real(DP), dimension(:), allocatable :: capom !! Longitude of ascending node real(DP), dimension(:), allocatable :: omega !! Argument of pericenter real(DP), dimension(:), allocatable :: capm !! Mean anomaly - real(DP), dimension(:), allocatable :: mu !! G * (Mcb + [m]) - logical, dimension(:), allocatable :: lmask !! Logical mask used to select a subset of bodies when performing certain operations (drift, kick, accel, etc.) !! Note to developers: If you add components to this class, be sure to update methods and subroutines that traverse the !! component list, such as setup_body and util_spill contains @@ -209,6 +209,7 @@ module swiftest_classes procedure :: h2b => util_coord_h2b_pl !! Convert massive bodies from heliocentric to barycentric coordinates (position and velocity) procedure :: b2h => util_coord_b2h_pl !! Convert massive bodies from barycentric to heliocentric coordinates (position and velocity) procedure :: fill => util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) + procedure :: resize => util_resize_pl !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. procedure :: set_beg_end => util_set_beg_end_pl !! Sets the beginning and ending positions and velocities of planets. procedure :: set_mu => util_set_mu_pl !! Method used to construct the vectorized form of the central body mass procedure :: set_rhill => util_set_rhill !! Calculates the Hill's radii for each body @@ -239,6 +240,7 @@ module swiftest_classes procedure :: b2h => util_coord_b2h_tp !! Convert test particles from barycentric to heliocentric coordinates (position and velocity) procedure :: fill => util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: get_peri => util_peri_tp !! Determine system pericenter passages for test particles + procedure :: resize => util_resize_tp !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. procedure :: set_mu => util_set_mu_tp !! Method used to construct the vectorized form of the central body mass procedure :: sort => util_sort_tp !! Sorts body arrays by a sortable component procedure :: rearrange => util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods @@ -847,14 +849,59 @@ module subroutine util_peri_tp(self, system, param) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine util_peri_tp + end interface + + interface util_resize + module subroutine util_resize_arr_char_string(arr, nnew) + implicit none + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine util_resize_arr_char_string + + module subroutine util_resize_arr_DP(arr, nnew) + implicit none + real(DP), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine util_resize_arr_DP + + module subroutine util_resize_arr_DPvec(arr, nnew) + implicit none + real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine util_resize_arr_DPvec + + module subroutine util_resize_arr_I4B(arr, nnew) + implicit none + integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine util_resize_arr_I4B + + module subroutine util_resize_arr_logical(arr, nnew) + implicit none + logical, dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine util_resize_arr_logical + end interface - module subroutine util_resize_body(self, nrequested, param) + interface + module subroutine util_resize_body(self, nnew) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - integer(I4B), intent(in) :: nrequested !! New size neded - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_body), intent(inout) :: self !! Swiftest body object + integer(I4B), intent(in) :: nnew !! New size neded end subroutine util_resize_body + module subroutine util_resize_pl(self, nnew) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + integer(I4B), intent(in) :: nnew !! New size neded + end subroutine util_resize_pl + + module subroutine util_resize_tp(self, nnew) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + integer(I4B), intent(in) :: nnew !! New size neded + end subroutine util_resize_tp + module subroutine util_set_beg_end_pl(self, xbeg, xend, vbeg) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index eb6a74482..712b98f65 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -92,10 +92,11 @@ module symba_classes procedure :: encounter_check => symba_encounter_check_pl !! Checks if massive bodies are going through close encounters with each other procedure :: accel => symba_kick_getacch_pl !! Compute heliocentric accelerations of massive bodies procedure :: setup => symba_setup_pl !! Constructor method - Allocates space for number of particle - procedure :: fill => symba_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) + procedure :: fill => symba_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) + procedure :: resize => symba_util_resize_pl !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. procedure :: sort => symba_util_sort_pl !! Sorts body arrays by a sortable componen procedure :: rearrange => symba_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods - procedure :: spill => symba_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + procedure :: spill => symba_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) end type symba_pl !******************************************************************************************************************************** @@ -111,10 +112,11 @@ module symba_classes procedure :: encounter_check => symba_encounter_check_tp !! Checks if any test particles are undergoing a close encounter with a massive body procedure :: accel => symba_kick_getacch_tp !! Compute heliocentric accelerations of test particles procedure :: setup => symba_setup_tp !! Constructor method - Allocates space for number of particle - procedure :: fill => symba_util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) + procedure :: fill => symba_util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) + procedure :: resize => symba_util_resize_tp !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. procedure :: sort => symba_util_sort_tp !! Sorts body arrays by a sortable componen procedure :: rearrange => symba_util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods - procedure :: spill => symba_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + procedure :: spill => symba_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) end type symba_tp !******************************************************************************************************************************** @@ -163,12 +165,12 @@ module symba_classes class(symba_pl), allocatable :: pl_discards !! Discarded test particle data structure integer(I4B) :: irec !! System recursion level contains - procedure :: initialize => symba_setup_initialize_system !! Performs SyMBA-specific initilization steps - procedure :: step => symba_step_system !! Advance the SyMBA nbody system forward in time by one step - procedure :: interp => symba_step_interp_system !! Perform an interpolation step on the SymBA nbody system - procedure :: set_recur_levels => symba_step_set_recur_levels_system !! Sets recursion levels of bodies and encounter lists to the current system level - procedure :: recursive_step => symba_step_recur_system !! Step interacting planets and active test particles ahead in democratic heliocentric coordinates at the current recursion level, if applicable, and descend to the next deeper level if necessary - procedure :: reset => symba_step_reset_system !! Resets pl, tp,and encounter structures at the start of a new step + procedure :: initialize => symba_setup_initialize_system !! Performs SyMBA-specific initilization steps + procedure :: step => symba_step_system !! Advance the SyMBA nbody system forward in time by one step + procedure :: interp => symba_step_interp_system !! Perform an interpolation step on the SymBA nbody system + procedure :: set_recur_levels => symba_step_set_recur_levels_system !! Sets recursion levels of bodies and encounter lists to the current system level + procedure :: recursive_step => symba_step_recur_system !! Step interacting planets and active test particles ahead in democratic heliocentric coordinates at the current recursion level, if applicable, and descend to the next deeper level if necessary + procedure :: reset => symba_step_reset_system !! Resets pl, tp,and encounter structures at the start of a new step end type symba_nbody_system interface @@ -439,12 +441,12 @@ module subroutine symba_util_fill_arr_char_info(keeps, inserts, lfill_list) logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps end subroutine symba_util_fill_arr_char_info - module subroutine symba_util_fill_arr_char_kin(keeps, inserts, lfill_list) + module subroutine symba_util_fill_arr_kin(keeps, inserts, lfill_list) implicit none type(symba_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep type(symba_kinship), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - end subroutine symba_util_fill_arr_char_kin + end subroutine symba_util_fill_arr_kin end interface interface @@ -463,13 +465,41 @@ module subroutine symba_util_fill_tp(self, inserts, lfill_list) class(swiftest_body), intent(in) :: inserts !! Inserted object logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps end subroutine symba_util_fill_tp + end interface + + interface util_resize + module subroutine symba_util_resize_arr_info(arr, nnew) + implicit none + type(symba_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine symba_util_resize_arr_info - module subroutine symba_util_resize_pltpenc(self, nrequested) + module subroutine symba_util_resize_arr_kin(arr, nnew) + implicit none + type(symba_kinship), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine symba_util_resize_arr_kin + end interface + + interface + module subroutine symba_util_resize_pl(self, nnew) + implicit none + class(symba_pl), intent(inout) :: self !! SyMBA massive body object + integer(I4B), intent(in) :: nnew !! New size neded + end subroutine symba_util_resize_pl + + module subroutine symba_util_resize_pltpenc(self, nnew) implicit none class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter list - integer(I4B), intent(in) :: nrequested !! New size of list needed + integer(I4B), intent(in) :: nnew !! New size of list needed end subroutine symba_util_resize_pltpenc + module subroutine symba_util_resize_tp(self, nnew) + implicit none + class(symba_tp), intent(inout) :: self !! SyMBA massive body object + integer(I4B), intent(in) :: nnew !! New size neded + end subroutine symba_util_resize_tp + module subroutine symba_util_sort_pl(self, sortby, ascending) implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object diff --git a/src/modules/whm_classes.f90 b/src/modules/whm_classes.f90 index 626c0a974..0f67c9432 100644 --- a/src/modules/whm_classes.f90 +++ b/src/modules/whm_classes.f90 @@ -34,18 +34,19 @@ module whm_classes procedure :: j2h => whm_coord_j2h_pl !! Convert position and velcoity vectors from Jacobi to helliocentric coordinates procedure :: vh2vj => whm_coord_vh2vj_pl !! Convert velocity vectors from heliocentric to Jacobi coordinates procedure :: drift => whm_drift_pl !! Loop through massive bodies and call Danby drift routine to jacobi coordinates - procedure :: fill => whm_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) - procedure :: accel => whm_kick_getacch_pl !! Compute heliocentric accelerations of massive bodies - procedure :: kick => whm_kick_vh_pl !! Kick heliocentric velocities of massive bodies procedure :: accel_gr => whm_gr_kick_getacch_pl !! Acceleration term arising from the post-Newtonian correction procedure :: gr_pos_kick => whm_gr_p4_pl !! Position kick due to p**4 term in the post-Newtonian correction - procedure :: setup => whm_setup_pl !! Constructor method - Allocates space for number of particles - procedure :: set_mu => whm_util_set_mu_eta_pl !! Sets the Jacobi mass value for all massive bodies. + procedure :: accel => whm_kick_getacch_pl !! Compute heliocentric accelerations of massive bodies + procedure :: kick => whm_kick_vh_pl !! Kick heliocentric velocities of massive bodies + procedure :: fill => whm_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) + procedure :: resize => whm_util_resize_pl !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. procedure :: set_ir3 => whm_util_set_ir3j !! Sets both the heliocentric and jacobi inverse radius terms (1/rj**3 and 1/rh**3) + procedure :: set_mu => whm_util_set_mu_eta_pl !! Sets the Jacobi mass value for all massive bodies. procedure :: sort => whm_util_sort_pl !! Sort a WHM massive body object in-place. procedure :: rearrange => whm_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods - procedure :: step => whm_step_pl !! Steps the body forward one stepsize procedure :: spill => whm_util_spill_pl !!"Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + procedure :: setup => whm_setup_pl !! Constructor method - Allocates space for number of particles + procedure :: step => whm_step_pl !! Steps the body forward one stepsize end type whm_pl !******************************************************************************************************************************** @@ -57,10 +58,10 @@ module whm_classes !! Note to developers: If you add componenets to this class, be sure to update methods and subroutines that traverse the !! component list, such as whm_util_spill_tp contains - procedure :: accel => whm_kick_getacch_tp !! Compute heliocentric accelerations of test particles - procedure :: kick => whm_kick_vh_tp !! Kick heliocentric velocities of test particles procedure :: accel_gr => whm_gr_kick_getacch_tp !! Acceleration term arising from the post-Newtonian correction procedure :: gr_pos_kick => whm_gr_p4_tp !! Position kick due to p**4 term in the post-Newtonian correction + procedure :: accel => whm_kick_getacch_tp !! Compute heliocentric accelerations of test particles + procedure :: kick => whm_kick_vh_tp !! Kick heliocentric velocities of test particles procedure :: step => whm_step_tp !! Steps the particle forward one stepsize end type whm_tp @@ -106,14 +107,6 @@ module subroutine whm_drift_pl(self, system, param, dt) real(DP), intent(in) :: dt !! Stepsize end subroutine whm_drift_pl - module subroutine whm_util_fill_pl(self, inserts, lfill_list) - use swiftest_classes, only : swiftest_body - implicit none - class(whm_pl), intent(inout) :: self !! WHM massive body object - class(swiftest_body), intent(in) :: inserts !! inserted object - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - end subroutine whm_util_fill_pl - !> Get heliocentric accelration of massive bodies module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) use swiftest_classes, only : swiftest_cb, swiftest_parameters @@ -197,31 +190,6 @@ module subroutine whm_setup_pl(self, n, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine whm_setup_pl - module subroutine whm_util_set_ir3j(self) - implicit none - class(whm_pl), intent(inout) :: self !! WHM massive body object - end subroutine whm_util_set_ir3j - - module subroutine whm_util_set_mu_eta_pl(self, cb) - use swiftest_classes, only : swiftest_cb - implicit none - class(whm_pl), intent(inout) :: self !! WHM massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - end subroutine whm_util_set_mu_eta_pl - - module subroutine whm_util_sort_pl(self, sortby, ascending) - implicit none - class(whm_pl), intent(inout) :: self !! WHM 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 - end subroutine whm_util_sort_pl - - module subroutine whm_util_sort_rearrange_pl(self, ind) - implicit none - class(whm_pl), intent(inout) :: self !! WHM 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) - end subroutine whm_util_sort_rearrange_pl - module subroutine whm_setup_initialize_system(self, param) use swiftest_classes, only : swiftest_parameters implicit none @@ -258,7 +226,6 @@ module subroutine whm_util_spill_pl(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 whm_util_spill_pl - !> Steps the Swiftest nbody system forward in time one stepsize module subroutine whm_step_system(self, param, t, dt) use swiftest_classes, only : swiftest_parameters implicit none @@ -267,6 +234,45 @@ module subroutine whm_step_system(self, param, t, dt) real(DP), intent(in) :: t !! Simulation time real(DP), intent(in) :: dt !! Current stepsize end subroutine whm_step_system + + module subroutine whm_util_fill_pl(self, inserts, lfill_list) + use swiftest_classes, only : swiftest_body + implicit none + class(whm_pl), intent(inout) :: self !! WHM massive body object + class(swiftest_body), intent(in) :: inserts !! inserted object + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + end subroutine whm_util_fill_pl + + module subroutine whm_util_resize_pl(self, nnew) + implicit none + class(whm_pl), intent(inout) :: self !! WHM massive body object + integer(I4B), intent(in) :: nnew !! New size neded + end subroutine whm_util_resize_pl + + module subroutine whm_util_set_ir3j(self) + implicit none + class(whm_pl), intent(inout) :: self !! WHM massive body object + end subroutine whm_util_set_ir3j + + module subroutine whm_util_set_mu_eta_pl(self, cb) + use swiftest_classes, only : swiftest_cb + implicit none + class(whm_pl), intent(inout) :: self !! WHM massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + end subroutine whm_util_set_mu_eta_pl + + module subroutine whm_util_sort_pl(self, sortby, ascending) + implicit none + class(whm_pl), intent(inout) :: self !! WHM 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 + end subroutine whm_util_sort_pl + + module subroutine whm_util_sort_rearrange_pl(self, ind) + implicit none + class(whm_pl), intent(inout) :: self !! WHM 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) + end subroutine whm_util_sort_rearrange_pl end interface end module whm_classes diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index 2f7e5f374..dcf0de473 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -62,6 +62,52 @@ module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) return end subroutine rmvs_util_fill_tp + + module subroutine rmvs_util_resize_pl(self, nnew) + !! author: David A. Minton + !! + !! Checks the current size of a massive body object against the requested size and resizes it if it is too small. + implicit none + ! Arguments + class(rmvs_pl), intent(inout) :: self !! RMVS massive body object + integer(I4B), intent(in) :: nnew !! New size neded + + call whm_util_resize_pl(self, nnew) + + call util_resize(self%nenc, nnew) + call util_resize(self%tpenc1P, nnew) + call util_resize(self%plind, nnew) + + ! The following are not implemented as RMVS doesn't make use of resize operations on pl type + ! So they are here as a placeholder in case someone wants to extend the RMVS class for some reason + !call util_resize(self%outer, nnew) + !call util_resize(self%inner, nnew) + !call util_resize(self%planetocentric, nnew) + + return + end subroutine rmvs_util_resize_pl + + + module subroutine rmvs_util_resize_tp(self, nnew) + !! author: David A. Minton + !! + !! 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(rmvs_tp), intent(inout) :: self !! RMVS test particle object + integer(I4B), intent(in) :: nnew !! New size neded + + call util_resize_tp(self, nnew) + + call util_resize(self%lperi, nnew) + call util_resize(self%plperP, nnew) + call util_resize(self%plencP, nnew) + call util_resize(self%xheliocentric, nnew) + + return + end subroutine rmvs_util_resize_tp + + module subroutine rmvs_util_sort_pl(self, sortby, ascending) !! author: David A. Minton !! diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 70941555d..f2f72d12d 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -68,7 +68,7 @@ module subroutine symba_util_fill_arr_char_info(keeps, inserts, lfill_list) end subroutine symba_util_fill_arr_char_info - module subroutine symba_util_fill_arr_char_kin(keeps, inserts, lfill_list) + module subroutine symba_util_fill_arr_kin(keeps, inserts, lfill_list) !! author: David A. Minton !! !! Performs a fill operation on a single array of particle kinship types @@ -85,7 +85,7 @@ module subroutine symba_util_fill_arr_char_kin(keeps, inserts, lfill_list) keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) return - end subroutine symba_util_fill_arr_char_kin + end subroutine symba_util_fill_arr_kin module subroutine symba_util_fill_pl(self, inserts, lfill_list) @@ -155,7 +155,122 @@ module subroutine symba_util_fill_tp(self, inserts, lfill_list) end subroutine symba_util_fill_tp - module subroutine symba_util_resize_pltpenc(self, nrequested) + module subroutine symba_util_resize_arr_info(arr, nnew) + !! author: David A. Minton + !! + !! Resizes an array component of type character string. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. + implicit none + ! Arguments + type(symba_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + ! Internals + type(symba_particle_info), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold !! Old size + + if (.not. allocated(arr) .or. nnew < 0) return + + nold = size(arr) + if (nnew == nold) return + + if (nnew == 0) then + deallocate(arr) + return + end if + + allocate(tmp(nnew)) + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + else + tmp(1:nnew) = arr(1:nnew) + end if + call move_alloc(tmp, arr) + + return + end subroutine symba_util_resize_arr_info + + + module subroutine symba_util_resize_arr_kin(arr, nnew) + !! author: David A. Minton + !! + !! Resizes an array component of type character string. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. + implicit none + ! Arguments + type(symba_kinship), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + ! Internals + type(symba_kinship), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold !! Old size + + if (.not. allocated(arr) .or. nnew < 0) return + + nold = size(arr) + if (nnew == nold) return + + if (nnew == 0) then + deallocate(arr) + return + end if + + allocate(tmp(nnew)) + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + else + tmp(1:nnew) = arr(1:nnew) + end if + call move_alloc(tmp, arr) + + return + end subroutine symba_util_resize_arr_kin + + + module subroutine symba_util_resize_pl(self, nnew) + !! author: David A. Minton + !! + !! Checks the current size of a 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 + + call util_resize_pl(self, nnew) + + call util_resize(self%lcollision, nnew) + call util_resize(self%lencounter, nnew) + call util_resize(self%lmtiny, nnew) + call util_resize(self%nplenc, nnew) + call util_resize(self%ntpenc, nnew) + call util_resize(self%levelg, nnew) + call util_resize(self%levelm, nnew) + call util_resize(self%isperi, nnew) + call util_resize(self%peri, nnew) + call util_resize(self%atp, nnew) + call util_resize(self%kin, nnew) + call util_resize(self%info, nnew) + + return + end subroutine symba_util_resize_pl + + + module subroutine symba_util_resize_tp(self, nnew) + !! author: David A. Minton + !! + !! 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 + + call util_resize_tp(self, nnew) + + call util_resize(self%nplenc, nnew) + call util_resize(self%levelg, nnew) + call util_resize(self%levelm, nnew) + + return + end subroutine symba_util_resize_tp + + + module subroutine symba_util_resize_pltpenc(self, nnew) !! author: David A. Minton !! !! Checks the current size of the encounter list against the required size and extends it by a factor of 2 more than requested if it is too small. @@ -163,7 +278,7 @@ module subroutine symba_util_resize_pltpenc(self, nrequested) implicit none ! Arguments class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter list - integer(I4B), intent(in) :: nrequested !! New size of list needed + integer(I4B), intent(in) :: nnew !! New size of list needed ! Internals class(symba_pltpenc), allocatable :: enc_temp integer(I4B) :: nold @@ -175,17 +290,17 @@ module subroutine symba_util_resize_pltpenc(self, nrequested) else nold = 0 end if - if (nrequested > nold) then + if (nnew > nold) then if (lmalloc) allocate(enc_temp, source=self) - call self%setup(2 * nrequested) + call self%setup(2 * nnew) if (lmalloc) then call self%copy(enc_temp) deallocate(enc_temp) end if else - self%status(nrequested+1:nold) = INACTIVE + self%status(nnew+1:nold) = INACTIVE end if - self%nenc = nrequested + self%nenc = nnew return end subroutine symba_util_resize_pltpenc diff --git a/src/util/util_append.f90 b/src/util/util_append.f90 index 3a5b3ba81..854220a89 100644 --- a/src/util/util_append.f90 +++ b/src/util/util_append.f90 @@ -15,7 +15,7 @@ module subroutine util_append_body(self, source, param, lsource_mask) logical, dimension(:), optional, intent(in) :: lsource_mask !! Logical mask indicating which elements to append to associate(nold => self%nbody, nnew => source%nbody) - if (nnew > size(self%status)) call self%resize(nnew, param) + if (nnew > size(self%status)) call self%resize(nnew) end associate return diff --git a/src/util/util_copy.f90 b/src/util/util_copy.f90 index bc8cdcf43..b21f061f4 100644 --- a/src/util/util_copy.f90 +++ b/src/util/util_copy.f90 @@ -26,7 +26,7 @@ module subroutine util_copy_into_body(self, source, param, lsource_mask) lfill_list = .false. lfill_list(1:nnew) = .true. associate(nold => self%nbody) - if (nnew > size(self%status)) call self%resize(nnew, param) + if (nnew > size(self%status)) call self%resize(nnew) call self%fill(source, lfill_list) end associate return diff --git a/src/util/util_resize.f90 b/src/util/util_resize.f90 index 986053546..53df2bd73 100644 --- a/src/util/util_resize.f90 +++ b/src/util/util_resize.f90 @@ -1,40 +1,258 @@ submodule (swiftest_classes) s_util_resize use swiftest contains + module subroutine util_resize_arr_char_string(arr, nnew) + !! author: David A. Minton + !! + !! Resizes an array component of type character string. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. + implicit none + ! Arguments + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + ! Internals + character(len=STRMAX), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold !! Old size + + if (.not. allocated(arr) .or. nnew < 0) return + + nold = size(arr) + if (nnew == nold) return + + if (nnew == 0) then + deallocate(arr) + return + end if + + allocate(tmp(nnew)) + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + else + tmp(1:nnew) = arr(1:nnew) + end if + call move_alloc(tmp, arr) + + return + end subroutine util_resize_arr_char_string + - module subroutine util_resize_body(self, nrequested, param) + module subroutine util_resize_arr_DP(arr, nnew) !! author: David A. Minton !! - !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. + !! Resizes an array component of double precision type. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. + implicit none + ! Arguments + real(DP), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + ! Internals + real(DP), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold !! Old size + + if (.not. allocated(arr) .or. nnew < 0) return + + nold = size(arr) + if (nnew == nold) return + + if (nnew == 0) then + deallocate(arr) + return + end if + + allocate(tmp(nnew)) + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + else + tmp(1:nnew) = arr(1:nnew) + end if + call move_alloc(tmp, arr) + + return + end subroutine util_resize_arr_DP + + + module subroutine util_resize_arr_DPvec(arr, nnew) + !! author: David A. Minton + !! + !! Resizes an array component of double precision vectors of size (NDIM, n). Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. implicit none ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest body object - integer(I4B), intent(in) :: nrequested !! New size neded - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size ! Internals - class(swiftest_body), allocatable :: temp - integer(I4B) :: nold - logical :: lmalloc + real(DP), dimension(:,:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold !! Old size - lmalloc = allocated(self%status) - if (lmalloc) then - nold = size(self%status) + if (.not. allocated(arr) .or. nnew < 0) return + + nold = size(arr, dim=2) + if (nnew == nold) return + + if (nnew == 0) then + deallocate(arr) + return + end if + + allocate(tmp(NDIM, nnew)) + if (nnew > nold) then + tmp(:, 1:nold) = arr(:, 1:nold) else - nold = 0 - end if - if (nrequested > nold) then - if (lmalloc) allocate(temp, source=self) - call self%setup(nrequested, param) - if (lmalloc) then - call self%copy_into(temp, param) - deallocate(temp) - end if + tmp(:, 1:nnew) = arr(:, 1:nnew) + end if + call move_alloc(tmp, arr) + + return + end subroutine util_resize_arr_DPvec + + + module subroutine util_resize_arr_I4B(arr, nnew) + !! author: David A. Minton + !! + !! Resizes an array component of integer type. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. + implicit none + ! Arguments + integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + ! Internals + integer(I4B), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold !! Old size + + if (.not. allocated(arr) .or. nnew < 0) return + + nold = size(arr) + if (nnew == nold) return + + if (nnew == 0) then + deallocate(arr) + return + end if + + allocate(tmp(nnew)) + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) else - self%status(nrequested+1:nold) = INACTIVE + tmp(1:nnew) = arr(1:nnew) end if - self%nbody = nrequested + call move_alloc(tmp, arr) + + return + end subroutine util_resize_arr_I4B + + + module subroutine util_resize_arr_logical(arr, nnew) + !! author: David A. Minton + !! + !! Resizes an array component of logical type. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. + implicit none + ! Arguments + logical, dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + ! Internals + logical, dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold !! Old size + + if (.not. allocated(arr) .or. nnew < 0) return + + nold = size(arr) + if (nnew == nold) return + + if (nnew == 0) then + deallocate(arr) + return + end if + + allocate(tmp(nnew)) + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + else + tmp(1:nnew) = arr(1:nnew) + end if + call move_alloc(tmp, arr) + + return + end subroutine util_resize_arr_logical + + + module subroutine util_resize_body(self, nnew) + !! author: David A. Minton + !! + !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! Swiftest body object + integer(I4B), intent(in) :: nnew !! New size neded + + call util_resize(self%name, nnew) + call util_resize(self%status, nnew) + call util_resize(self%ldiscard, nnew) + call util_resize(self%lmask, nnew) + call util_resize(self%mu, nnew) + call util_resize(self%xh, nnew) + call util_resize(self%vh, nnew) + call util_resize(self%xb, nnew) + call util_resize(self%vb, nnew) + call util_resize(self%ah, nnew) + call util_resize(self%aobl, nnew) + call util_resize(self%atide, nnew) + call util_resize(self%agr, nnew) + call util_resize(self%ir3h, nnew) + call util_resize(self%a, nnew) + call util_resize(self%e, nnew) + call util_resize(self%inc, nnew) + call util_resize(self%capom, nnew) + call util_resize(self%omega, nnew) + call util_resize(self%capm, nnew) + self%nbody = count(self%status(1:nnew) == ACTIVE) return end subroutine util_resize_body + + module subroutine util_resize_pl(self, nnew) + !! author: David A. Minton + !! + !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + integer(I4B), intent(in) :: nnew !! New size neded + + call util_resize_body(self, nnew) + + call util_resize(self%mass, nnew) + call util_resize(self%Gmass, nnew) + call util_resize(self%rhill, nnew) + call util_resize(self%radius, nnew) + call util_resize(self%xbeg, nnew) + call util_resize(self%xend, nnew) + call util_resize(self%vbeg, nnew) + call util_resize(self%density, nnew) + call util_resize(self%Ip, nnew) + call util_resize(self%rot, nnew) + call util_resize(self%k2, nnew) + call util_resize(self%Q, nnew) + call util_resize(self%tlag, nnew) + call self%eucl_index() + + return + end subroutine util_resize_pl + + + module subroutine util_resize_tp(self, nnew) + !! author: David A. Minton + !! + !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest massive body object + integer(I4B), intent(in) :: nnew !! New size neded + + call util_resize_body(self, nnew) + + call util_resize(self%isperi, nnew) + call util_resize(self%peri, nnew) + call util_resize(self%atp, nnew) + + return + end subroutine util_resize_tp + + end submodule s_util_resize \ No newline at end of file diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index deb5dde5a..c0f3a021b 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -69,6 +69,27 @@ module subroutine whm_util_fill_pl(self, inserts, lfill_list) end subroutine whm_util_fill_pl + module subroutine whm_util_resize_pl(self, nnew) + !! author: David A. Minton + !! + !! Checks the current size of a massive body against the requested size and resizes it if it is too small. + implicit none + ! Arguments + class(whm_pl), intent(inout) :: self !! WHM massive body object + integer(I4B), intent(in) :: nnew !! New size neded + + call util_resize_pl(self, nnew) + + call util_resize(self%eta, nnew) + call util_resize(self%xj, nnew) + call util_resize(self%vj, nnew) + call util_resize(self%muj, nnew) + call util_resize(self%ir3j, nnew) + + return + end subroutine whm_util_resize_pl + + module subroutine whm_util_set_ir3j(self) !! author: David A. Minton !!