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 
Consolidated fill operations into a set of simple array subroutines that helps simplify the implementations a lot
  • Loading branch information
@daminton
daminton committed Aug 1, 2021
1 parent d48cc78 commit ba91ddb
Show file tree
Hide file tree
Showing 6 changed files with 284 additions and 309 deletions.
41 changes: 40 additions & 1 deletion src/modules/swiftest_classes.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -85,7 +85,7 @@ module swiftest_classes
!********************************************************************************************************************************
!> A concrete lass for the central body in a Swiftest simulation
type, abstract, extends(swiftest_base) :: swiftest_cb
character(len=STRMAX) :: name !! Non-unique name
character(len=STRMAX) :: name !! Non-unique name
integer(I4B) :: id = 0 !! External identifier (unique)
real(DP) :: mass = 0.0_DP !! Central body mass (units MU)
real(DP) :: Gmass = 0.0_DP !! Central mass gravitational term G * mass (units GU * MU)
Expand Down Expand Up @@ -801,7 +801,46 @@ module subroutine util_copy_fill_tp(self, inserts, lfill_list)
class(swiftest_body), intent(in) :: inserts !! Swiftest body object to be inserted
logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps
end subroutine util_copy_fill_tp
end interface

interface util_fill
module subroutine util_fill_arr_char_string(keeps, inserts, lfill_list)
implicit none
character(len=STRMAX), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep
character(len=STRMAX), dimension(:), allocatable, intent(in) :: inserts !! Array of arrays to insert into keep
logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps
end subroutine util_fill_arr_char_string

module subroutine util_fill_arr_DP(keeps, inserts, lfill_list)
implicit none
real(DP), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep
real(DP), dimension(:), allocatable, intent(in) :: inserts !! Array of arrays to insert into keep
logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps
end subroutine util_fill_arr_DP

module subroutine util_fill_arr_DPvec(keeps, inserts, lfill_list)
implicit none
real(DP), dimension(:,:), allocatable, intent(inout) :: keeps !! Array of values to keep
real(DP), dimension(:,:), allocatable, intent(in) :: inserts !! Array of arrays to insert into keep
logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps
end subroutine util_fill_arr_DPvec

module subroutine util_fill_arr_I4B(keeps, inserts, lfill_list)
implicit none
integer(I4B), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep
integer(I4B), dimension(:), allocatable, intent(in) :: inserts !! Array of arrays to insert into keep
logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps
end subroutine util_fill_arr_I4B

module subroutine util_fill_arr_logical(keeps, inserts, lfill_list)
implicit none
logical, dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep
logical, dimension(:), allocatable, intent(in) :: inserts !! Array of arrays to insert into keep
logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps
end subroutine util_fill_arr_logical
end interface

interface
module subroutine util_peri_tp(self, system, param)
implicit none
class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object
Expand Down
18 changes: 7 additions & 11 deletions src/rmvs/rmvs_util.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,9 +20,10 @@ module subroutine rmvs_util_copy_fill_pl(self, inserts, lfill_list)
select type(inserts)
class is (rmvs_pl)

keeps%nenc(:) = unpack(keeps%nenc(:), .not.lfill_list(:), keeps%nenc(:))
keeps%nenc(:) = unpack(inserts%nenc(:), lfill_list(:), keeps%nenc(:))

call util_fill(keeps%nenc, inserts%nenc, lfill_list)
call util_fill(keeps%tpenc1P, inserts%tpenc1P, lfill_list)
call util_fill(keeps%plind, inserts%plind, lfill_list)

call whm_util_copy_fill_pl(keeps, inserts, lfill_list)
class default
write(*,*) 'Error! spill method called for incompatible return type on rmvs_pl'
Expand All @@ -49,14 +50,9 @@ module subroutine rmvs_util_copy_fill_tp(self, inserts, lfill_list)
select type(inserts)
class is (rmvs_tp)

keeps%lperi(:) = unpack(keeps%lperi(:), .not.lfill_list(:), keeps%lperi(:))
keeps%lperi(:) = unpack(inserts%lperi(:), lfill_list(:), keeps%lperi(:))

keeps%plperP(:) = unpack(keeps%plperP(:), .not.lfill_list(:), keeps%plperP(:))
keeps%plperP(:) = unpack(inserts%plperP(:), lfill_list(:), keeps%plperP(:))

keeps%plencP(:) = unpack(keeps%plencP(:), .not.lfill_list(:), keeps%plencP(:))
keeps%plencP(:) = unpack(inserts%plencP(:), lfill_list(:), keeps%plencP(:))
call util_fill(keeps%lperi, inserts%lperi, lfill_list)
call util_fill(keeps%plperP, inserts%plperP, lfill_list)
call util_fill(keeps%plencP, inserts%plencP, lfill_list)

call util_copy_fill_tp(keeps, inserts, lfill_list)
class default
Expand Down
50 changes: 13 additions & 37 deletions src/symba/symba_util.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,35 +17,16 @@ module subroutine symba_util_copy_fill_pl(self, inserts, lfill_list)
associate(keeps => self)
select type(inserts)
class is (symba_pl)
keeps%lcollision(:) = unpack(keeps%lcollision(:), .not.lfill_list(:), keeps%lcollision(:))
keeps%lcollision(:) = unpack(inserts%lcollision(:), lfill_list(:), keeps%lcollision(:))

keeps%lencounter(:) = unpack(keeps%lencounter(:), .not.lfill_list(:), keeps%lencounter(:))
keeps%lencounter(:) = unpack(inserts%lencounter(:), lfill_list(:), keeps%lencounter(:))

keeps%lmtiny(:) = unpack(keeps%lmtiny(:), .not.lfill_list(:), keeps%lmtiny(:))
keeps%lmtiny(:) = unpack(inserts%lmtiny(:), lfill_list(:), keeps%lmtiny(:))

keeps%nplenc(:) = unpack(keeps%nplenc(:), .not.lfill_list(:), keeps%nplenc(:))
keeps%nplenc(:) = unpack(inserts%nplenc(:), lfill_list(:), keeps%nplenc(:))

keeps%nplenc(:) = unpack(keeps%nplenc(:), .not.lfill_list(:), keeps%nplenc(:))
keeps%ntpenc(:) = unpack(inserts%ntpenc(:), lfill_list(:), keeps%ntpenc(:))

keeps%levelg(:) = unpack(keeps%levelg(:), .not.lfill_list(:), keeps%levelg(:))
keeps%levelg(:) = unpack(inserts%levelg(:), lfill_list(:), keeps%levelg(:))

keeps%levelm(:) = unpack(keeps%levelm(:), .not.lfill_list(:), keeps%levelm(:))
keeps%levelm(:) = unpack(inserts%levelm(:), lfill_list(:), keeps%levelm(:))

keeps%isperi(:) = unpack(keeps%isperi(:), .not.lfill_list(:), keeps%isperi(:))
keeps%isperi(:) = unpack(inserts%isperi(:), lfill_list(:), keeps%isperi(:))

keeps%peri(:) = unpack(keeps%peri(:), .not.lfill_list(:), keeps%peri(:))
keeps%peri(:) = unpack(inserts%peri(:), lfill_list(:), keeps%peri(:))

keeps%atp(:) = unpack(keeps%atp(:), .not.lfill_list(:), keeps%atp(:))
keeps%atp(:) = unpack(inserts%atp(:), lfill_list(:), keeps%atp(:))
call util_fill(keeps%lcollision, inserts%lcollision, lfill_list)
call util_fill(keeps%lencounter, inserts%lencounter, lfill_list)
call util_fill(keeps%lmtiny, inserts%lmtiny, lfill_list)
call util_fill(keeps%nplenc, inserts%nplenc, lfill_list)
call util_fill(keeps%ntpenc, inserts%ntpenc, lfill_list)
call util_fill(keeps%levelg, inserts%levelg, lfill_list)
call util_fill(keeps%levelm, inserts%levelm, lfill_list)
call util_fill(keeps%isperi, inserts%isperi, lfill_list)
call util_fill(keeps%peri, inserts%peri, lfill_list)
call util_fill(keeps%atp, inserts%atp, lfill_list)

keeps%kin(:) = unpack(keeps%kin(:), .not.lfill_list(:), keeps%kin(:))
keeps%kin(:) = unpack(inserts%kin(:), lfill_list(:), keeps%kin(:))
Expand Down Expand Up @@ -77,14 +58,9 @@ module subroutine symba_util_copy_fill_tp(self, inserts, lfill_list)
associate(keeps => self)
select type(inserts)
class is (symba_tp)
keeps%nplenc(:) = unpack(keeps%nplenc(:), .not.lfill_list(:), keeps%nplenc(:))
keeps%nplenc(:) = unpack(inserts%nplenc(:), lfill_list(:), keeps%nplenc(:))

keeps%levelg(:) = unpack(keeps%levelg(:), .not.lfill_list(:), keeps%levelg(:))
keeps%levelg(:) = unpack(inserts%levelg(:), lfill_list(:), keeps%levelg(:))

keeps%levelm(:) = unpack(keeps%levelm(:), .not.lfill_list(:), keeps%levelm(:))
keeps%levelm(:) = unpack(inserts%levelm(:), lfill_list(:), keeps%levelm(:))
call util_fill(keeps%nplenc, inserts%nplenc, lfill_list)
call util_fill(keeps%levelg, inserts%levelg, lfill_list)
call util_fill(keeps%levelm, inserts%levelm, lfill_list)

call util_copy_fill_tp(keeps, inserts, lfill_list)
class default
Expand Down
Loading

0 comments on commit ba91ddb

Please sign in to comment.