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

Commit

Permalink
Fixed up append method to properly resize as needed
Browse files Browse the repository at this point in the history
  • Loading branch information
@daminton
daminton committed Aug 2, 2021
1 parent 025cd22 commit cc48db2
Show file tree
Hide file tree
Showing 7 changed files with 48 additions and 35 deletions.
8 changes: 4 additions & 4 deletions src/rmvs/rmvs_util.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,8 @@ module subroutine rmvs_util_append_pl(self, source, lsource_mask)

select type(source)
class is (rmvs_pl)
call whm_util_append_pl(self, source, lsource_mask)

call util_append(self%nenc, source%nenc, lsource_mask)
call util_append(self%tpenc1P, source%tpenc1P, lsource_mask)
call util_append(self%plind, source%plind, lsource_mask)
Expand All @@ -24,8 +26,6 @@ module subroutine rmvs_util_append_pl(self, source, lsource_mask)
!call util_append(self%outer, source%outer, lsource_mask)
!call util_append(self%inner, source%inner, lsource_mask)
!call util_append(self%planetocentric, source%planetocentric, lsource_mask)

call whm_util_append_pl(self, source, lsource_mask)
class default
write(*,*) "Invalid object passed to the append method. Source must be of class rmvs_pl or its descendents!"
call util_exit(FAILURE)
Expand All @@ -48,11 +48,11 @@ module subroutine rmvs_util_append_tp(self, source, lsource_mask)

select type(source)
class is (rmvs_tp)
call util_append_tp(self, source, lsource_mask) ! Note: whm_tp does not have its own append method, so we skip back to the base class

call util_append(self%lperi, source%lperi, lsource_mask)
call util_append(self%plperP, source%plperP, lsource_mask)
call util_append(self%plencP, source%plencP, lsource_mask)

call util_append_tp(self, source, lsource_mask) ! Note: whm_tp does not have its own append method, so we skip back to the base class
class default
write(*,*) "Invalid object passed to the append method. Source must be of class rmvs_tp or its descendents!"
call util_exit(FAILURE)
Expand Down
2 changes: 0 additions & 2 deletions src/symba/symba_setup.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,8 +18,6 @@ module subroutine symba_setup_initialize_system(self, param)
! Call parent method
associate(system => self)
call whm_setup_initialize_system(system, param)
call system%mergeadd_list%setup(1, param)
call system%mergesub_list%setup(1, param)
call system%pltpenc_list%setup(0)
call system%plplenc_list%setup(0)
select type(pl => system%pl)
Expand Down
4 changes: 2 additions & 2 deletions src/symba/symba_step.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -265,8 +265,8 @@ module subroutine symba_step_reset_system(self)
pltpenc_list%nenc = 0
end if

mergeadd_list%nbody = 0
mergesub_list%nbody = 0
call mergeadd_list%resize(0)
call mergesub_list%resize(0)
end select
end select
end associate
Expand Down
20 changes: 12 additions & 8 deletions src/symba/symba_util.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,10 +29,12 @@ module subroutine symba_util_append_arr_info(arr, source, lsource_mask)
narr = 0
end if

call util_resize(arr, narr + nsrc)

if (present(lsource_mask)) then
arr(narr+1:nsrc) = pack(source(:), lsource_mask(:))
arr(narr + 1:narr + nsrc) = pack(source(:), lsource_mask(:))
else
arr(narr+1:nsrc) = source(:)
arr(narr + 1:narr + nsrc) = source(:)
end if

return
Expand Down Expand Up @@ -66,10 +68,12 @@ module subroutine symba_util_append_arr_kin(arr, source, lsource_mask)
narr = 0
end if

call util_resize(arr, narr + nsrc)

if (present(lsource_mask)) then
arr(narr+1:nsrc) = pack(source(:), lsource_mask(:))
arr(narr + 1:narr + nsrc) = pack(source(:), lsource_mask(:))
else
arr(narr+1:nsrc) = source(:)
arr(narr + 1:narr + nsrc) = source(:)
end if

return
Expand All @@ -89,6 +93,8 @@ module subroutine symba_util_append_pl(self, source, lsource_mask)

select type(source)
class is (symba_pl)
call 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

call util_append(self%lcollision, source%lcollision, lsource_mask)
call util_append(self%lencounter, source%lencounter, lsource_mask)
call util_append(self%lmtiny, source%lmtiny, lsource_mask)
Expand All @@ -101,8 +107,6 @@ module subroutine symba_util_append_pl(self, source, lsource_mask)
call util_append(self%atp, source%atp, lsource_mask)
call util_append(self%kin, source%kin, lsource_mask)
call util_append(self%info, source%info, lsource_mask)

call 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
class default
write(*,*) "Invalid object passed to the append method. Source must be of class symba_pl or its descendents!"
call util_exit(FAILURE)
Expand All @@ -125,11 +129,11 @@ module subroutine symba_util_append_tp(self, source, lsource_mask)

select type(source)
class is (symba_tp)
call 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

call util_append(self%nplenc, source%nplenc, lsource_mask)
call util_append(self%levelg, source%levelg, lsource_mask)
call util_append(self%levelm, source%levelm, lsource_mask)

call 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
class default
write(*,*) "Invalid object passed to the append method. Source must be of class symba_tp or its descendents!"
call util_exit(FAILURE)
Expand Down
44 changes: 27 additions & 17 deletions src/util/util_append.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,10 +29,12 @@ module subroutine util_append_arr_char_string(arr, source, lsource_mask)
narr = 0
end if

call util_resize(arr, narr + nsrc)

if (present(lsource_mask)) then
arr(narr+1:nsrc) = pack(source(:), lsource_mask(:))
arr(narr + 1:narr + nsrc) = pack(source(:), lsource_mask(:))
else
arr(narr+1:nsrc) = source(:)
arr(narr + 1:narr + nsrc) = source(:)
end if

return
Expand Down Expand Up @@ -66,10 +68,12 @@ module subroutine util_append_arr_DP(arr, source, lsource_mask)
narr = 0
end if

call util_resize(arr, narr + nsrc)

if (present(lsource_mask)) then
arr(narr+1:nsrc) = pack(source(:), lsource_mask(:))
arr(narr + 1:narr + nsrc) = pack(source(:), lsource_mask(:))
else
arr(narr+1:nsrc) = source(:)
arr(narr + 1:narr + nsrc) = source(:)
end if

return
Expand Down Expand Up @@ -103,12 +107,14 @@ module subroutine util_append_arr_DPvec(arr, source, lsource_mask)
narr = 0
end if

call util_resize(arr, narr + nsrc)

if (present(lsource_mask)) then
arr(1, narr+1:nsrc) = pack(source(1,:), lsource_mask(:))
arr(2, narr+1:nsrc) = pack(source(2,:), lsource_mask(:))
arr(3, narr+1:nsrc) = pack(source(3,:), lsource_mask(:))
arr(1, narr + 1:narr + nsrc) = pack(source(1,:), lsource_mask(:))
arr(2, narr + 1:narr + nsrc) = pack(source(2,:), lsource_mask(:))
arr(3, narr + 1:narr + nsrc) = pack(source(3,:), lsource_mask(:))
else
arr(:, narr+1:nsrc) = source(:,:)
arr(:, narr + 1:narr + nsrc) = source(:,:)
end if

return
Expand Down Expand Up @@ -142,13 +148,14 @@ module subroutine util_append_arr_I4B(arr, source, lsource_mask)
narr = 0
end if

call util_resize(arr, narr + nsrc)

if (present(lsource_mask)) then
arr(narr+1:nsrc) = pack(source(:), lsource_mask(:))
arr(narr + 1:narr + nsrc) = pack(source(:), lsource_mask(:))
else
arr(narr+1:nsrc) = source(:)
arr(narr + 1:narr + nsrc) = source(:)
end if


return
end subroutine util_append_arr_I4B

Expand Down Expand Up @@ -180,10 +187,12 @@ module subroutine util_append_arr_logical(arr, source, lsource_mask)
nsrc = size(source)
end if

call util_resize(arr, narr + nsrc)

if (present(lsource_mask)) then
arr(narr+1:nsrc) = pack(source(:), lsource_mask(:))
arr(narr + 1:narr + nsrc) = pack(source(:), lsource_mask(:))
else
arr(narr+1:nsrc) = source(:)
arr(narr + 1:narr + nsrc) = source(:)
end if

return
Expand All @@ -202,6 +211,7 @@ module subroutine util_append_body(self, source, lsource_mask)
logical, dimension(:), optional, intent(in) :: lsource_mask !! Logical mask indicating which elements to append to

call util_append(self%name, source%name, lsource_mask)
call util_append(self%id, source%id, lsource_mask)
call util_append(self%status, source%status, lsource_mask)
call util_append(self%ldiscard, source%ldiscard, lsource_mask)
call util_append(self%lmask, source%lmask, lsource_mask)
Expand Down Expand Up @@ -242,6 +252,8 @@ module subroutine util_append_pl(self, source, lsource_mask)

select type(source)
class is (swiftest_pl)
call util_append_body(self, source, lsource_mask)

call util_append(self%mass, source%mass, lsource_mask)
call util_append(self%Gmass, source%Gmass, lsource_mask)
call util_append(self%rhill, source%rhill, lsource_mask)
Expand All @@ -256,8 +268,6 @@ module subroutine util_append_pl(self, source, lsource_mask)
call util_append(self%Q, source%Q, lsource_mask)
call util_append(self%tlag, source%tlag, lsource_mask)

call util_append_body(self, source, lsource_mask)

call self%eucl_index()
class default
write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_pl or its descendents"
Expand All @@ -281,11 +291,11 @@ module subroutine util_append_tp(self, source, lsource_mask)

select type(source)
class is (swiftest_tp)
call util_append_body(self, source, lsource_mask)

call util_append(self%isperi, source%isperi, lsource_mask)
call util_append(self%peri, source%peri, lsource_mask)
call util_append(self%atp, source%atp, lsource_mask)

call util_append_body(self, source, lsource_mask)
class default
write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_tp or its descendents"
call util_exit(FAILURE)
Expand Down
1 change: 1 addition & 0 deletions src/util/util_resize.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -181,6 +181,7 @@ module subroutine util_resize_body(self, nnew)
integer(I4B), intent(in) :: nnew !! New size neded

call util_resize(self%name, nnew)
call util_resize(self%id, nnew)
call util_resize(self%status, nnew)
call util_resize(self%ldiscard, nnew)
call util_resize(self%lmask, nnew)
Expand Down
4 changes: 2 additions & 2 deletions src/whm/whm_util.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,13 +15,13 @@ module subroutine whm_util_append_pl(self, source, lsource_mask)

select type(source)
class is (whm_pl)
call util_append_pl(self, source, lsource_mask)

call util_append(self%eta, source%eta, lsource_mask)
call util_append(self%muj, source%muj, lsource_mask)
call util_append(self%ir3j, source%ir3j, lsource_mask)
call util_append(self%xj, source%xj, lsource_mask)
call util_append(self%vj, source%vj, lsource_mask)

call util_append_pl(self, source, lsource_mask)
class default
write(*,*) "Invalid object passed to the append method. Source must be of class whm_pl or its descendents"
call util_exit(FAILURE)
Expand Down

0 comments on commit cc48db2

Please sign in to comment.