From 4bd3487366201dc1cf9698cd78ab3766bfa8f848 Mon Sep 17 00:00:00 2001 From: David Minton Date: Sat, 31 Jul 2021 08:14:44 -0400 Subject: [PATCH] Added templates for append and copy_into methods --- src/modules/swiftest_classes.f90 | 22 ++++++++++++++++------ src/util/util_append.f90 | 24 ++++++++++++++++++++++++ src/util/util_copy.f90 | 24 ++++++++++++++++++------ src/util/util_resize.f90 | 2 +- 4 files changed, 59 insertions(+), 13 deletions(-) create mode 100644 src/util/util_append.f90 diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 64a6e8778..ac7639bc4 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -164,7 +164,8 @@ module swiftest_classes procedure :: xv2el => orbel_xv2el_vec !! Convert position and velocity vectors to orbital elements procedure :: setup => setup_body !! A constructor that sets the number of bodies and allocates all allocatable arrays procedure :: accel_user => user_kick_getacch_body !! Add user-supplied heliocentric accelerations to planets - procedure :: copy => util_copy_body !! Copies elements from one structure to another + procedure :: append => util_append_body !! Appends elements from one structure to another + procedure :: copy_into => util_copy_into_body !! Copies elements from one Swiftest body object to another. procedure :: fill => util_fill_body !! "Fills" bodies from one object into another depending on the results of a mask (uses the MERGE intrinsic) procedure :: resize => util_resize_body !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. procedure :: set_ir3 => util_set_ir3h !! Sets the inverse heliocentric radius term (1/rh**3) @@ -735,6 +736,14 @@ module subroutine user_kick_getacch_body(self, system, param, t, lbeg) logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step end subroutine user_kick_getacch_body + module subroutine util_append_body(self, source, param, lmask) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_body), intent(in) :: source !! Source object to append + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + logical, dimension(:), optional, intent(in) :: lmask !! Logical mask indicating which elements to append to + end subroutine util_append_body + module subroutine util_coord_b2h_pl(self, cb) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object @@ -759,12 +768,13 @@ module subroutine util_coord_h2b_tp(self, cb) class(swiftest_cb), intent(in) :: cb !! Swiftest central body object end subroutine util_coord_h2b_tp - module subroutine util_copy_body(self, source, param) + module subroutine util_copy_into_body(self, source, param, lmask) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_body), intent(in) :: source !! Source object to copy - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine util_copy_body + class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_body), intent(in) :: source !! Source object to append + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + logical, dimension(:), optional, intent(in) :: lmask !! Logical mask indicating which elements to append to + end subroutine util_copy_into_body module subroutine util_exit(code) implicit none diff --git a/src/util/util_append.f90 b/src/util/util_append.f90 new file mode 100644 index 000000000..3541ed8e3 --- /dev/null +++ b/src/util/util_append.f90 @@ -0,0 +1,24 @@ +submodule (swiftest_classes) s_util_append + use swiftest +contains + + module subroutine util_append_body(self, source, param, lmask) + !! author: David A. Minton + !! + !! Append components from one Swiftest body object to another. + !! This method will automatically resize the destination body if it is too small + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_body), intent(in) :: source !! Source object to append + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + logical, dimension(:), optional, intent(in) :: lmask !! 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) + + end associate + return + end subroutine util_append_body + +end submodule s_util_append \ No newline at end of file diff --git a/src/util/util_copy.f90 b/src/util/util_copy.f90 index fcbd0d5da..4d85e7f0c 100644 --- a/src/util/util_copy.f90 +++ b/src/util/util_copy.f90 @@ -2,18 +2,30 @@ use swiftest contains - module subroutine util_copy_body(self, source, param) + module subroutine util_copy_into_body(self, source, param, lmask) !! author: David A. Minton !! - !! Non-destructively copy components from one Swiftest body object to another. + !! Copies elements from one Swiftest body object to another. !! This method will automatically resize the destination body if it is too small implicit none ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_body), intent(in) :: source !! Source object to copy - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_body), intent(in) :: source !! Source object to append + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + logical, dimension(:), optional, intent(in) :: lmask !! Logical mask indicating which elements to append to + ! Internals + integer(I4B) :: nnew + if (present(lmask)) then + nnew = count(lmask) + else + nnew = size(source%status) + end if + associate(nold => self%nbody) + if (nnew > size(self%status)) call self%resize(nnew, param) + + end associate return - end subroutine util_copy_body + end subroutine util_copy_into_body end submodule s_util_copy \ No newline at end of file diff --git a/src/util/util_resize.f90 b/src/util/util_resize.f90 index cde0428d4..986053546 100644 --- a/src/util/util_resize.f90 +++ b/src/util/util_resize.f90 @@ -26,7 +26,7 @@ module subroutine util_resize_body(self, nrequested, param) if (lmalloc) allocate(temp, source=self) call self%setup(nrequested, param) if (lmalloc) then - call self%copy(temp, param) + call self%copy_into(temp, param) deallocate(temp) end if else