Skip to content
This repository was archived by the owner on Aug 28, 2024. It is now read-only.

Commit

Permalink
Browse files Browse the repository at this point in the history 
Added beginnings of an append method that SyMBA will use to make add and subtract lists
  • Loading branch information
@daminton
daminton committed Aug 2, 2021
1 parent 4372de7 commit cedfc4c
Show file tree
Hide file tree
Showing 2 changed files with 216 additions and 5 deletions.
42 changes: 40 additions & 2 deletions src/modules/swiftest_classes.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -736,12 +736,50 @@ module subroutine user_kick_getacch_body(self, system, param, t, lbeg)
real(DP), intent(in) :: t !! Current time
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
end interface

interface util_append
module subroutine util_append_arr_char_string(arr, source, lsource_mask)
implicit none
character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Destination array
character(len=STRMAX), dimension(:), allocatable, intent(inout) :: source !! Array to append
logical, dimension(:), optional, intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
end subroutine util_append_arr_char_string

module subroutine util_append_arr_DP(arr, source, lsource_mask)
implicit none
real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array
real(DP), dimension(:), allocatable, intent(inout) :: source !! Array to append
logical, dimension(:), optional, intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
end subroutine util_append_arr_DP

module subroutine util_append_arr_DPvec(arr, source, lsource_mask)
implicit none
real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array
real(DP), dimension(:,:), allocatable, intent(inout) :: source !! Array to append
logical, dimension(:), optional, intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
end subroutine util_append_arr_DPvec

module subroutine util_append_body(self, source, param, lsource_mask)
module subroutine util_append_arr_I4B(arr, source, lsource_mask)
implicit none
integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array
integer(I4B), dimension(:), allocatable, intent(inout) :: source !! Array to append
logical, dimension(:), optional, intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
end subroutine util_append_arr_I4B

module subroutine util_append_arr_logical(arr, source, lsource_mask)
implicit none
logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array
logical, dimension(:), allocatable, intent(inout) :: source !! Array to append
logical, dimension(:), optional, intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
end subroutine util_append_arr_logical
end interface

interface
module subroutine util_append_body(self, source, lsource_mask)
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) :: lsource_mask !! Logical mask indicating which elements to append to
end subroutine util_append_body

Expand Down
179 changes: 176 additions & 3 deletions src/util/util_append.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,182 @@
use swiftest
contains

module subroutine util_append_body(self, source, param, lsource_mask)
module subroutine util_append_arr_char_string(arr, source, lsource_mask)
!! author: David A. Minton
!!
!! Append a single array of character string type onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it.
implicit none
! Arguments
character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Destination array
character(len=STRMAX), dimension(:), allocatable, intent(inout) :: source !! Array to append
logical, dimension(:), optional, intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
! Internals
integer(I4B) :: narr, nsrc

if (.not. allocated(source)) return

if (present(lsource_mask)) then
nsrc = count(lsource_mask)
else
nsrc = size(source)
end if

if (allocated(arr)) then
narr = size(arr)
else
allocate(arr(nsrc))
narr = 0
end if

call util_resize(arr, narr+nsrc)

arr(narr+1:nsrc) = source(:)

return
end subroutine util_append_arr_char_string


module subroutine util_append_arr_DP(arr, source, lsource_mask)
!! author: David A. Minton
!!
!! Append a single array of double precision type onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it.
implicit none
! Arguments
real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array
real(DP), dimension(:), allocatable, intent(inout) :: source !! Array to append
logical, dimension(:), optional, intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
! Internals
integer(I4B) :: narr, nsrc

if (.not. allocated(source)) return

if (present(lsource_mask)) then
nsrc = count(lsource_mask)
else
nsrc = size(source)
end if

if (allocated(arr)) then
narr = size(arr)
else
allocate(arr(nsrc))
narr = 0
end if

call util_resize(arr, narr+nsrc)

arr(narr+1:nsrc) = source(:)

return
end subroutine util_append_arr_DP


module subroutine util_append_arr_DPvec(arr, source, lsource_mask)
!! author: David A. Minton
!!
!! Append a single array of double precision vector type of size (NDIM, n) onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it.
implicit none
! Arguments
real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array
real(DP), dimension(:,:), allocatable, intent(inout) :: source !! Array to append
logical, dimension(:), optional, intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
! Internals
integer(I4B) :: narr, nsrc

if (.not. allocated(source)) return

if (present(lsource_mask)) then
nsrc = count(lsource_mask)
else
nsrc = size(source, dim=2)
end if

if (allocated(arr)) then
narr = size(arr, dim=2)
else
allocate(arr(NDIM,nsrc))
narr = 0
end if

call util_resize(arr, narr+nsrc)

arr(:,narr+1:nsrc) = source(:,:)

return
end subroutine util_append_arr_DPvec


module subroutine util_append_arr_I4B(arr, source, lsource_mask)
!! author: David A. Minton
!!
!! Append a single array of integer(I4B) onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it.
implicit none
! Arguments
integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array
integer(I4B), dimension(:), allocatable, intent(inout) :: source !! Array to append
logical, dimension(:), optional, intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
! Internals
integer(I4B) :: narr, nsrc

if (.not. allocated(source)) return

if (present(lsource_mask)) then
nsrc = count(lsource_mask)
else
nsrc = size(source)
end if

if (allocated(arr)) then
narr = size(arr)
else
allocate(arr(nsrc))
narr = 0
end if

call util_resize(arr, narr+nsrc)

arr(narr+1:nsrc) = source(:)

return
end subroutine util_append_arr_I4B


module subroutine util_append_arr_logical(arr, source, lsource_mask)
!! author: David A. Minton
!!
!! Append a single array of logical type onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it.
implicit none
! Arguments
logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array
logical, dimension(:), allocatable, intent(inout) :: source !! Array to append
logical, dimension(:), optional, intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
! Internals
integer(I4B) :: narr, nsrc

if (.not. allocated(source)) return

if (present(lsource_mask)) then
nsrc = count(lsource_mask)
else
nsrc = size(source)
end if

if (allocated(arr)) then
narr = size(arr)
else
allocate(arr(nsrc))
narr = 0
end if

call util_resize(arr, narr+nsrc)

arr(narr+1:nsrc) = source(:)

return
end subroutine util_append_arr_logical


module subroutine util_append_body(self, source, lsource_mask)
!! author: David A. Minton
!!
!! Append components from one Swiftest body object to another.
Expand All @@ -11,11 +186,9 @@ module subroutine util_append_body(self, source, param, lsource_mask)
! 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) :: 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)

end associate
return
Expand Down

0 comments on commit cedfc4c

Please sign in to comment.