From 0896ffb2faaa5b5935e79f6bcb5f53ef2fa9dcb2 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 22 Dec 2022 08:17:34 -0500 Subject: [PATCH] Lots more restructuring, refactoring, and cleanup --- src/collision/collision_check.f90 | 36 ++-- src/collision/collision_generate.f90 | 139 ++++++++++-- src/collision/collision_io.f90 | 208 ++++++++++++------ src/collision/collision_module.f90 | 194 ++++++++--------- src/collision/collision_regime.f90 | 15 +- src/collision/collision_resolve.f90 | 302 +++++++++------------------ src/collision/collision_util.f90 | 68 +++--- src/encounter/encounter_io.f90 | 103 +++++---- src/encounter/encounter_module.f90 | 35 ++-- src/encounter/encounter_util.f90 | 26 +-- src/fraggle/fraggle_generate.f90 | 110 +++++----- src/fraggle/fraggle_io.f90 | 38 ---- src/fraggle/fraggle_module.f90 | 2 - src/fraggle/fraggle_resolve.f90 | 18 +- src/helio/helio_drift.f90 | 18 +- src/helio/helio_gr.f90 | 8 +- src/helio/helio_kick.f90 | 38 ++-- src/helio/helio_module.f90 | 46 ++-- src/helio/helio_step.f90 | 34 +-- src/misc/minimizer_module.f90 | 4 +- src/misc/solver_module.f90 | 4 +- src/netcdf_io/netcdf_io_module.f90 | 20 +- src/rmvs/rmvs_discard.f90 | 8 +- src/rmvs/rmvs_encounter_check.f90 | 6 +- src/rmvs/rmvs_kick.f90 | 16 +- src/rmvs/rmvs_module.f90 | 18 +- src/rmvs/rmvs_setup.f90 | 2 +- src/rmvs/rmvs_step.f90 | 44 ++-- src/rmvs/rmvs_util.f90 | 2 +- src/swiftest/swiftest_discard.f90 | 68 +++--- src/swiftest/swiftest_drift.f90 | 4 +- src/swiftest/swiftest_driver.f90 | 52 ++--- src/swiftest/swiftest_gr.f90 | 6 +- src/swiftest/swiftest_io.f90 | 100 ++++----- src/swiftest/swiftest_module.f90 | 154 +++++++------- src/swiftest/swiftest_obl.f90 | 28 +-- src/swiftest/swiftest_setup.f90 | 108 +++++----- src/swiftest/swiftest_user.f90 | 4 +- src/swiftest/swiftest_util.f90 | 182 ++++++++-------- src/symba/symba_discard.f90 | 138 ++++++------ src/symba/symba_drift.f90 | 20 +- src/symba/symba_encounter_check.f90 | 30 +-- src/symba/symba_gr.f90 | 20 +- src/symba/symba_kick.f90 | 36 ++-- src/symba/symba_module.f90 | 58 ++--- src/symba/symba_setup.f90 | 12 +- src/symba/symba_step.f90 | 112 +++++----- src/tides/tides_getacch_pl.f90 | 8 +- src/tides/tides_module.f90 | 4 +- src/tides/tides_spin_step.f90 | 2 +- src/whm/whm_drift.f90 | 4 +- src/whm/whm_gr.f90 | 8 +- src/whm/whm_kick.f90 | 42 ++-- src/whm/whm_module.f90 | 40 ++-- src/whm/whm_setup.f90 | 2 +- src/whm/whm_step.f90 | 42 ++-- 56 files changed, 1436 insertions(+), 1410 deletions(-) diff --git a/src/collision/collision_check.f90 b/src/collision/collision_check.f90 index 7dd35a658..fcf25f8e0 100644 --- a/src/collision/collision_check.f90 +++ b/src/collision/collision_check.f90 @@ -57,7 +57,7 @@ pure elemental subroutine collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, end subroutine collision_check_one - module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_collision) + module subroutine collision_check_plpl(self, nbody_system, param, t, dt, irec, lany_collision) !! author: David A. Minton !! !! Check for merger between massive bodies and test particles in SyMBA @@ -68,7 +68,7 @@ module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_co implicit none ! Arguments class(collision_list_plpl), intent(inout) :: self !! SyMBA pl-tp encounter list object - class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size @@ -86,9 +86,9 @@ module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_co lany_collision = .false. if (self%nenc == 0) return - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) - associate(pl => system%pl) + associate(pl => nbody_system%pl) nenc = self%nenc allocate(lmask(nenc)) @@ -118,18 +118,18 @@ module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_co if (lany_collision .or. lany_closest) then - call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary + call pl%rh2rb(nbody_system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary do k = 1, nenc if (.not.lcollision(k) .and. .not. self%lclosest(k)) cycle i = self%index1(k) j = self%index2(k) - self%r1(:,k) = pl%rh(:,i) + system%cb%rb(:) + self%r1(:,k) = pl%rh(:,i) + nbody_system%cb%rb(:) self%v1(:,k) = pl%vb(:,i) if (lcollision(k)) then self%status(k) = COLLIDED self%tcollision(k) = t end if - self%r2(:,k) = pl%rh(:,j) + system%cb%rb(:) + self%r2(:,k) = pl%rh(:,j) + nbody_system%cb%rb(:) self%v2(:,k) = pl%vb(:,j) if (lcollision(k)) then ! Check to see if either of these bodies has been involved with a collision before, and if so, make this a collider pair @@ -145,11 +145,11 @@ module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_co end do ! Extract the pl-pl encounter list and return the pl-pl collision_list - call self%extract_collisions(system, param) + call self%extract_collisions(nbody_system, param) end if ! Take snapshots of pairs of bodies at close approach (but not collision) if requested - if (lany_closest) call system%encounter_history%take_snapshot(param, system, t, "closest") + if (lany_closest) call nbody_system%encounter_history%take_snapshot(param, nbody_system, t, "closest") end associate end select @@ -157,7 +157,7 @@ module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_co end subroutine collision_check_plpl - module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_collision) + module subroutine collision_check_pltp(self, nbody_system, param, t, dt, irec, lany_collision) !! author: David A. Minton !! !! Check for merger between massive bodies and test particles in SyMBA @@ -168,7 +168,7 @@ module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_co implicit none ! Arguments class(collision_list_pltp), intent(inout) :: self !! SyMBA pl-tp encounter list object - class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size @@ -185,12 +185,12 @@ module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_co lany_collision = .false. if (self%nenc == 0) return - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) - associate(pl => system%pl, tp => system%tp) + associate(pl => nbody_system%pl, tp => nbody_system%tp) nenc = self%nenc allocate(lmask(nenc)) @@ -222,19 +222,19 @@ module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_co if (lany_collision .or. lany_closest) then - call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary + call pl%rh2rb(nbody_system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary do k = 1, nenc if (.not.lcollision(k) .and. .not. self%lclosest(k)) cycle i = self%index1(k) j = self%index2(k) - self%r1(:,k) = pl%rh(:,i) + system%cb%rb(:) + self%r1(:,k) = pl%rh(:,i) + nbody_system%cb%rb(:) self%v1(:,k) = pl%vb(:,i) if (lcollision(k)) then self%status(k) = COLLIDED self%tcollision(k) = t end if - self%r2(:,k) = tp%rh(:,j) + system%cb%rb(:) + self%r2(:,k) = tp%rh(:,j) + nbody_system%cb%rb(:) self%v2(:,k) = tp%vb(:,j) if (lcollision(k)) then tp%status(j) = DISCARDED_PLR @@ -246,7 +246,7 @@ module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_co write(message, *) "Particle " // trim(adjustl(tp%info(j)%name)) // " (" // trim(adjustl(idstrj)) // ")" & // " collided with massive body " // trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstri)) // ")" & // " at t = " // trim(adjustl(timestr)) - !call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) + !call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) end if end do @@ -256,7 +256,7 @@ module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_co end if ! Take snapshots of pairs of bodies at close approach (but not collision) if requested - if (lany_closest) call system%encounter_history%take_snapshot(param, system, t, "closest") + if (lany_closest) call nbody_system%encounter_history%take_snapshot(param, nbody_system, t, "closest") end associate end select end select diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index a849f69dc..281145797 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -12,29 +12,122 @@ use swiftest contains + module subroutine collision_generate_merge_system(self, nbody_system, param, t) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Merge massive bodies in a "MERGE" style collision model (only pure mergers) + implicit none + class(collision_merge), intent(inout) :: self !! Merge fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision - module subroutine collision_generate_merge_system(self, nbody_system, param, t) - implicit none - class(collision_merge), intent(inout) :: self !! Merge fragment system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_merge_system - - module subroutine collision_generate_bounce_system(self, nbody_system, param, t) - implicit none - class(collision_bounce), intent(inout) :: self !! Bounce fragment system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_bounce_system - - module subroutine collision_generate_simple_system(self, nbody_system, param, t) - implicit none - class(collision_simple), intent(inout) :: self !! Simple fragment system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_simple_system + call collision_generate_merge_any(self, nbody_system, param, t) + + return + end subroutine collision_generate_merge_system + + + module subroutine collision_generate_merge_any(self, nbody_system, param, t) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Merge massive bodies in any collisionals ystem. + !! + !! Adapted from David E. Kaufmann's Swifter routines symba_merge_pl.f90 and symba_discard_merge_pl.f90 + !! + !! Adapted from Hal Levison's Swift routines symba5_merge.f and discard_mass_merge.f + implicit none + ! Arguments + class(collision_system), intent(inout) :: self !! Merge fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + ! Internals + integer(I4B) :: i, j, k, ibiggest + real(DP), dimension(NDIM) :: Lspin_new + real(DP) :: dpe + character(len=STRMAX) :: message + + select type(nbody_system) + class is (swiftest_nbody_system) + associate(impactors => nbody_system%collider%impactors, fragments => nbody_system%collider%fragments) + message = "Merging" + call collision_io_collider_message(nbody_system%pl, impactors%id, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + + select type(pl => nbody_system%pl) + class is (swiftest_pl) + + !call self%set_mass_dist(param) + + ! Calculate the initial energy of the nbody_system without the collisional family + call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) + + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + fragments%id(1) = pl%id(ibiggest) + fragments%rb(:,1) = impactors%rbcom(:) + fragments%vb(:,1) = impactors%vbcom(:) + + if (param%lrotation) then + ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body + Lspin_new(:) = impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + impactors%Lspin(:,1) + impactors%Lspin(:,2) + + ! Assume prinicpal axis rotation on 3rd Ip axis + fragments%rot(:,1) = Lspin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) + else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable + nbody_system%Lescape(:) = nbody_system%Lescape(:) + impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + end if + + ! Keep track of the component of potential energy due to the pre-impact impactors%id for book-keeping + ! Get the energy of the system after the collision + call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) + dpe = self%pe(2) - self%pe(1) + nbody_system%Ecollisions = nbody_system%Ecollisions - dpe + nbody_system%Euntracked = nbody_system%Euntracked + dpe + + + ! Update any encounter lists that have the removed bodies in them so that they instead point to the new body + do k = 1, nbody_system%plpl_encounter%nenc + do j = 1, impactors%ncoll + i = impactors%id(j) + if (i == ibiggest) cycle + if (nbody_system%plpl_encounter%id1(k) == pl%id(i)) then + nbody_system%plpl_encounter%id1(k) = pl%id(ibiggest) + nbody_system%plpl_encounter%index1(k) = i + end if + if (nbody_system%plpl_encounter%id2(k) == pl%id(i)) then + nbody_system%plpl_encounter%id2(k) = pl%id(ibiggest) + nbody_system%plpl_encounter%index2(k) = i + end if + if (nbody_system%plpl_encounter%id1(k) == nbody_system%plpl_encounter%id2(k)) nbody_system%plpl_encounter%status(k) = INACTIVE + end do + end do + + self%status = MERGED + + call collision_resolve_mergeaddsub(nbody_system, param, t, self%status) + + end select + end associate + end select + return + end subroutine collision_generate_merge_any + + + module subroutine collision_generate_bounce_system(self, nbody_system, param, t) + implicit none + class(collision_bounce), intent(inout) :: self !! Bounce fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_bounce_system + + module subroutine collision_generate_simple_system(self, nbody_system, param, t) + implicit none + class(collision_simple), intent(inout) :: self !! Simple fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_simple_system end submodule s_collision_model \ No newline at end of file diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index 22de3f27c..0eccda309 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -7,12 +7,85 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(collision) s_collision_netcdf_io +submodule(collision) s_collision_io_netcdf use swiftest contains - module subroutine collision_netcdf_io_dump(self, param) + module subroutine collision_io_collider_message(pl, collidx, collider_message) + !! author: David A. Minton + !! + !! Prints a nicely formatted message about which bodies collided, including their names and ids. + !! This subroutine appends the body names and ids to an input message. + implicit none + ! Arguments + class(base_object), intent(in) :: pl !! Swiftest massive body object + integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional colliders%idx members + character(*), intent(inout) :: collider_message !! The message to print to the screen. + ! Internals + integer(I4B) :: i, n + character(len=STRMAX) :: idstr + + + n = size(collidx) + if (n == 0) return + + select type(pl) + class is (swiftest_pl) + do i = 1, n + if (i > 1) collider_message = trim(adjustl(collider_message)) // " and " + collider_message = " " // trim(adjustl(collider_message)) // " " // trim(adjustl(pl%info(collidx(i))%name)) + write(idstr, '(I10)') pl%id(collidx(i)) + collider_message = trim(adjustl(collider_message)) // " (" // trim(adjustl(idstr)) // ") " + end do + + end select + + return + end subroutine collision_io_collider_message + + + module subroutine collision_io_log_regime(self) + !! author: David A. Minton + !! + !! Writes a log of the results of the collisional regime determination + implicit none + ! Arguments + class(collision_system), intent(inout) :: self !! Collision system object + ! Internals + character(STRMAX) :: errmsg + + associate(fragments => self%fragments, impactors => self%impactors) + open(unit=LUN, file=COLLISION_LOG_OUT, status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) + write(LUN, *, err = 667, iomsg = errmsg) + write(LUN, *) "--------------------------------------------------------------------" + write(LUN, *) " Collisional regime determination results" + write(LUN, *) "--------------------------------------------------------------------" + write(LUN, *) "True number of impactors : ",impactors%ncoll + write(LUN, *) "Index list of true impactors : ",impactors%id(1:impactors%ncoll) + select case(impactors%regime) + case(COLLRESOLVE_REGIME_MERGE) + write(LUN, *) "Regime: Merge" + case(COLLRESOLVE_REGIME_DISRUPTION) + write(LUN, *) "Regime: Disruption" + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + write(LUN, *) "Regime: Supercatastrophic disruption" + case(COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + write(LUN, *) "Regime: Graze and merge" + case(COLLRESOLVE_REGIME_HIT_AND_RUN) + write(LUN, *) "Regime: Hit and run" + end select + write(LUN, *) "Energy loss : ", impactors%Qloss + write(LUN, *) "--------------------------------------------------------------------" + close(LUN) + end associate + return + 667 continue + write(*,*) "Error writing collision regime information to log file: " // trim(adjustl(errmsg)) + end subroutine collision_io_log_regime + + + module subroutine collision_io_netcdf_dump(self, param) !! author: David A. Minton !! !! Dumps the time history of an encounter to file. @@ -55,9 +128,10 @@ module subroutine collision_netcdf_io_dump(self, param) end select return - end subroutine collision_netcdf_io_dump + end subroutine collision_io_netcdf_dump - module subroutine collision_netcdf_io_initialize_output(self, param) + + module subroutine collision_io_netcdf_initialize_output(self, param) !! author: David A. Minton !! !! Initialize a NetCDF fragment history file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. @@ -98,94 +172,94 @@ module subroutine collision_netcdf_io_initialize_output(self, param) close(unit=LUN, status="delete") end if - call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "collision_netcdf_io_initialize_output nf90_create" ) + call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "collision_io_netcdf_initialize_output nf90_create" ) nc%lfile_is_open = .true. ! Dimensions - call netcdf_io_check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "collision_netcdf_io_initialize_output nf90_def_dim event_dimid" ) ! Dimension to store individual collision events - call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "collision_netcdf_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "collision_netcdf_io_initialize_output nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers - call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "collision_netcdf_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - call netcdf_io_check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "collision_netcdf_io_initialize_output nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + call netcdf_io_check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "collision_io_netcdf_initialize_output nf90_def_dim event_dimid" ) ! Dimension to store individual collision events + call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "collision_io_netcdf_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "collision_io_netcdf_initialize_output nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers + call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "collision_io_netcdf_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call netcdf_io_check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "collision_io_netcdf_initialize_output nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" ! Dimension coordinates - call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "collision_netcdf_io_initialize_output nf90_def_var space_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "collision_netcdf_io_initialize_output nf90_def_var name_varid") - call netcdf_io_check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "collision_netcdf_io_initialize_output nf90_def_var stage_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "collision_io_netcdf_initialize_output nf90_def_var space_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "collision_io_netcdf_initialize_output nf90_def_var name_varid") + call netcdf_io_check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "collision_io_netcdf_initialize_output nf90_def_var stage_varid" ) ! Variables - call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "collision_netcdf_io_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "collision_io_netcdf_initialize_output nf90_def_var id_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & - nc%event_dimid, nc%time_varid), "collision_netcdf_io_initialize_output nf90_def_var time_varid" ) + nc%event_dimid, nc%time_varid), "collision_io_netcdf_initialize_output nf90_def_var time_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & - [nc%str_dimid, nc%event_dimid], nc%regime_varid), "collision_netcdf_io_initialize_output nf90_def_var regime_varid") + [nc%str_dimid, nc%event_dimid], nc%regime_varid), "collision_io_netcdf_initialize_output nf90_def_var regime_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & - [ nc%event_dimid], nc%Qloss_varid), "collision_netcdf_io_initialize_output nf90_def_var Qloss_varid") + [ nc%event_dimid], nc%Qloss_varid), "collision_io_netcdf_initialize_output nf90_def_var Qloss_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & - [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "collision_netcdf_io_initialize_output nf90_def_var ptype_varid") + [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "collision_io_netcdf_initialize_output nf90_def_var ptype_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & - [ nc%event_dimid], nc%loop_varid), "collision_netcdf_io_initialize_output nf90_def_var loop_varid") + [ nc%event_dimid], nc%loop_varid), "collision_io_netcdf_initialize_output nf90_def_var loop_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "collision_netcdf_io_initialize_output nf90_def_var rh_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "collision_io_netcdf_initialize_output nf90_def_var rh_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "collision_netcdf_io_initialize_output nf90_def_var vh_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "collision_io_netcdf_initialize_output nf90_def_var vh_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& - [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "collision_netcdf_io_initialize_output nf90_def_var Gmass_varid") + [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "collision_io_netcdf_initialize_output nf90_def_var Gmass_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& - [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "collision_netcdf_io_initialize_output nf90_def_var radius_varid") + [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "collision_io_netcdf_initialize_output nf90_def_var radius_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "collision_netcdf_io_initialize_output nf90_def_var Ip_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "collision_io_netcdf_initialize_output nf90_def_var Ip_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "collision_netcdf_io_initialize_output nf90_def_var rot_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "collision_io_netcdf_initialize_output nf90_def_var rot_varid") if (param%lenergy) then call netcdf_io_check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "collision_netcdf_io_initialize_output nf90_def_var KE_orb_varid") + [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "collision_io_netcdf_initialize_output nf90_def_var KE_orb_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "collision_netcdf_io_initialize_output nf90_def_var KE_spin_varid" ) + [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "collision_io_netcdf_initialize_output nf90_def_var KE_spin_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "collision_netcdf_io_initialize_output nf90_def_var PE_varid" ) + [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "collision_io_netcdf_initialize_output nf90_def_var PE_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "collision_netcdf_io_initialize_output nf90_def_var L_orb_varid" ) + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "collision_io_netcdf_initialize_output nf90_def_var L_orb_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%Lspin_varname, nc%out_type,& - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%Lspin_varid), "collision_netcdf_io_initialize_output nf90_def_var Lspin_varid" ) + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%Lspin_varid), "collision_io_netcdf_initialize_output nf90_def_var Lspin_varid" ) end if - call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "collision_netcdf_io_initialize_output nf90_inquire nVariables" ) + call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "collision_io_netcdf_initialize_output nf90_inquire nVariables" ) do varid = 1, nvar - call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "collision_netcdf_io_initialize_output nf90_inquire_variable" ) + call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "collision_io_netcdf_initialize_output nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "collision_netcdf_io_initialize_output nf90_def_var_fill NF90_INT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "collision_io_netcdf_initialize_output nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "collision_netcdf_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "collision_io_netcdf_initialize_output nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "collision_netcdf_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "collision_io_netcdf_initialize_output nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "collision_netcdf_io_initialize_output nf90_def_var_fill NF90_CHAR" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "collision_io_netcdf_initialize_output nf90_def_var_fill NF90_CHAR" ) end select end do ! Take the file out of define mode - call netcdf_io_check( nf90_enddef(nc%id), "collision_netcdf_io_initialize_output nf90_enddef" ) + call netcdf_io_check( nf90_enddef(nc%id), "collision_io_netcdf_initialize_output nf90_enddef" ) ! Add in the space and stage dimension coordinates - call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "collision_netcdf_io_initialize_output nf90_put_var space" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "collision_netcdf_io_initialize_output nf90_put_var stage 1" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "collision_netcdf_io_initialize_output nf90_put_var stage 2" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "collision_io_netcdf_initialize_output nf90_put_var space" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "collision_io_netcdf_initialize_output nf90_put_var stage 1" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "collision_io_netcdf_initialize_output nf90_put_var stage 2" ) end associate end select @@ -195,10 +269,10 @@ module subroutine collision_netcdf_io_initialize_output(self, param) 667 continue write(*,*) "Error creating fragmentation output file. " // trim(adjustl(errmsg)) call util_exit(FAILURE) - end subroutine collision_netcdf_io_initialize_output + end subroutine collision_io_netcdf_initialize_output - module subroutine collision_netcdf_io_write_frame_snapshot(self, history, param) + module subroutine collision_io_netcdf_write_frame_snapshot(self, history, param) !! author: David A. Minton !! !! Write a frame of output of a collision result @@ -215,19 +289,19 @@ module subroutine collision_netcdf_io_write_frame_snapshot(self, history, param) select type(nc => history%nc) class is (collision_netcdf_parameters) - associate(system => self%collision_system, impactors => self%collision_system%impactors, fragments => self%collision_system%fragments, eslot => param%ioutput) - call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "collision_netcdf_io_write_frame_snapshot nf90_set_fill" ) + associate(collider => self%collider, impactors => self%collider%impactors, fragments => self%collider%fragments, eslot => param%ioutput) + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "collision_io_netcdf_write_frame_snapshot nf90_set_fill" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "collision_netcdf_io_write_frame_snapshot nf90_put_var time_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "collision_netcdf_io_write_frame_snapshot nf90_put_varloop_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "collision_io_netcdf_write_frame_snapshot nf90_put_var time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "collision_io_netcdf_write_frame_snapshot nf90_put_varloop_varid" ) charstring = trim(adjustl(REGIME_NAMES(impactors%regime))) - call netcdf_io_check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var regime_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Qloss_varid, impactors%Qloss, start=[eslot] ), "collision_netcdf_io_write_frame_snapshot nf90_put_var Qloss_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var regime_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Qloss_varid, impactors%Qloss, start=[eslot] ), "collision_io_netcdf_write_frame_snapshot nf90_put_var Qloss_varid" ) - select type(before =>self%collision_system%before) + select type(before =>self%collider%before) class is (swiftest_nbody_system) - select type(after =>self%collision_system%before) + select type(after =>self%collider%before) class is (swiftest_nbody_system) do stage = 1,2 if (allocated(pl)) deallocate(pl) @@ -240,34 +314,36 @@ module subroutine collision_netcdf_io_write_frame_snapshot(self, history, param) npl = pl%nbody do i = 1, npl idslot = findloc(history%idvals,pl%id(i),dim=1) - call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "collision_netcdf_io_write_frame_snapshot nf90_put_var id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "collision_io_netcdf_write_frame_snapshot nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) - call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var particle_type_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var rh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var vh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "collision_netcdf_io_write_frame_snapshot nf90_put_var Gmass_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "collision_netcdf_io_write_frame_snapshot nf90_put_var radius_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var Ip_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var rotx_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var particle_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "collision_io_netcdf_write_frame_snapshot nf90_put_var Gmass_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "collision_io_netcdf_write_frame_snapshot nf90_put_var radius_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var Ip_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var rotx_varid" ) end do end do end select end select if (param%lenergy) then - call netcdf_io_check( nf90_put_var(nc%id, nc%ke_orb_varid, system%ke_orbit(:), start=[ 1, eslot], count=[ 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var ke_orb_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%ke_spin_varid, system%ke_spin(:), start=[ 1, eslot], count=[ 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var ke_spin_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%pe_varid, system%pe(:), start=[ 1, eslot], count=[ 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var pe_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%L_orb_varid, system%Lorbit(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var L_orb_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Lspin_varid, system%Lspin(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var Lspin_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ke_orb_varid, collider%ke_orbit(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var ke_orb_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ke_spin_varid, collider%ke_spin(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var ke_spin_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%pe_varid, collider%pe(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var pe_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%L_orb_varid, collider%Lorbit(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var L_orb_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Lspin_varid, collider%Lspin(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var Lspin_varid before" ) end if call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode) ) end associate end select return - end subroutine collision_netcdf_io_write_frame_snapshot + end subroutine collision_io_netcdf_write_frame_snapshot + + -end submodule s_collision_netcdf_io \ No newline at end of file +end submodule s_collision_io_netcdf \ No newline at end of file diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 77c5552fd..1eee878b0 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -18,6 +18,8 @@ module collision implicit none public + character(len=*), parameter :: COLLISION_LOG_OUT = "collision.log" !! Name of log file for collision diagnostic information + !>Symbolic names for collisional outcomes from collresolve_resolve: integer(I4B), parameter :: COLLRESOLVE_REGIME_MERGE = 1 integer(I4B), parameter :: COLLRESOLVE_REGIME_DISRUPTION = 2 @@ -63,14 +65,14 @@ module collision real(DP), dimension(:), allocatable :: mass_dist !! Distribution of fragment mass determined by the regime calculation (largest fragment, second largest, and remainder) real(DP) :: Mcb !! Mass of central body (used to compute potential energy in regime determination) - ! Values in a coordinate frame centered on the collider barycenter and collisional system unit vectors - real(DP), dimension(NDIM) :: x_unit !! x-direction unit vector of collisional system - real(DP), dimension(NDIM) :: y_unit !! y-direction unit vector of collisional system - real(DP), dimension(NDIM) :: z_unit !! z-direction unit vector of collisional system - real(DP), dimension(NDIM) :: v_unit !! z-direction unit vector of collisional system - real(DP), dimension(NDIM) :: rbcom !! Center of mass position vector of the collider system in system barycentric coordinates - real(DP), dimension(NDIM) :: vbcom !! Velocity vector of the center of mass of the collider system in system barycentric coordinates - real(DP), dimension(NDIM) :: rbimp !! Impact point position vector of the collider system in system barycentric coordinates + ! Values in a coordinate frame centered on the collider barycenter and collisional nbody_system unit vectors + real(DP), dimension(NDIM) :: x_unit !! x-direction unit vector of collisional nbody_system + real(DP), dimension(NDIM) :: y_unit !! y-direction unit vector of collisional nbody_system + real(DP), dimension(NDIM) :: z_unit !! z-direction unit vector of collisional nbody_system + real(DP), dimension(NDIM) :: v_unit !! z-direction unit vector of collisional nbody_system + real(DP), dimension(NDIM) :: rbcom !! Center of mass position vector of the collider nbody_system in nbody_system barycentric coordinates + real(DP), dimension(NDIM) :: vbcom !! Velocity vector of the center of mass of the collider nbody_system in nbody_system barycentric coordinates + real(DP), dimension(NDIM) :: rbimp !! Impact point position vector of the collider nbody_system in nbody_system barycentric coordinates contains procedure :: get_regime => collision_regime_impactors !! Determine which fragmentation regime the set of impactors will be @@ -108,49 +110,50 @@ module collision type, abstract :: collision_system - !! This class defines a collisional system that stores impactors and fragments. This is written so that various collision models (i.e. Fraggle) could potentially be used + !! This class defines a collisional nbody_system that stores impactors and fragments. This is written so that various collision models (i.e. Fraggle) could potentially be used !! to resolve collision by defining extended types of encounters_impactors and/or encounetr_fragments class(collision_fragments(:)), allocatable :: fragments !! Object containing information on the pre-collision system class(collision_impactors), allocatable :: impactors !! Object containing information on the post-collision system - class(base_nbody_system), allocatable :: before !! A snapshot of the subset of the system involved in the collision - class(base_nbody_system), allocatable :: after !! A snapshot of the subset of the system containing products of the collision + class(base_nbody_system), allocatable :: before !! A snapshot of the subset of the nbody_system involved in the collision + class(base_nbody_system), allocatable :: after !! A snapshot of the subset of the nbody_system containing products of the collision + integer(I4B) :: status !! Status flag to pass to the collision list once the collision has been resolved - ! For the following variables, index 1 refers to the *entire* n-body system in its pre-collisional state and index 2 refers to the system in its post-collisional state + ! For the following variables, index 1 refers to the *entire* n-body nbody_system in its pre-collisional state and index 2 refers to the nbody_system in its post-collisional state real(DP), dimension(NDIM,2) :: Lorbit !! Before/after orbital angular momentum real(DP), dimension(NDIM,2) :: Lspin !! Before/after spin angular momentum - real(DP), dimension(NDIM,2) :: Ltot !! Before/after total system angular momentum + real(DP), dimension(NDIM,2) :: Ltot !! Before/after total nbody_system angular momentum real(DP), dimension(2) :: ke_orbit !! Before/after orbital kinetic energy real(DP), dimension(2) :: ke_spin !! Before/after spin kinetic energy real(DP), dimension(2) :: pe !! Before/after potential energy - real(DP), dimension(2) :: Etot !! Before/after total system energy + real(DP), dimension(2) :: Etot !! Before/after total nbody_system energy contains procedure :: setup => collision_setup_system !! Initializer for the encounter collision system and the before/after snapshots procedure :: setup_impactors => collision_setup_impactors_system !! Initializer for the impactors for the encounter collision system. Deallocates old impactors before creating new ones procedure :: setup_fragments => collision_setup_fragments_system !! Initializer for the fragments of the collision system. - procedure :: add_fragments => collision_util_add_fragments_to_system !! Add fragments to system - procedure :: construct_temporary_system => collision_util_construct_temporary_system !! Constructs temporary n-body system in order to compute pre- and post-impact energy and momentum - procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) + procedure :: add_fragments => collision_util_add_fragments_to_system !! Add fragments to nbody_system + procedure :: construct_temporary_system => collision_util_construct_temporary_system !! Constructs temporary n-body nbody_system in order to compute pre- and post-impact energy and momentum + procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total nbody_system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) procedure :: reset => collision_util_reset_system !! Deallocates all allocatables - procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate system of the collisional system - procedure(abstract_generate_system), deferred :: generate !! Generates a system of fragments depending on collision model + procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate nbody_system of the collisional nbody_system + procedure(abstract_generate_system), deferred :: generate !! Generates a nbody_system of fragments depending on collision model end type collision_system type, extends(collision_system) :: collision_merge contains procedure :: generate => collision_generate_merge_system !! Merges the impactors to make a single final body - final :: collision_final_merge_system !! Finalizer will deallocate all allocatables + final :: collision_final_merge_system !! Finalizer will deallocate all allocatables end type collision_merge type, extends(collision_system) :: collision_bounce contains procedure :: generate => collision_generate_bounce_system !! If a collision would result in a disruption, "bounce" the bodies instead. - final :: collision_final_bounce_system !! Finalizer will deallocate all allocatables + final :: collision_final_bounce_system !! Finalizer will deallocate all allocatables end type collision_bounce type, extends(collision_system) :: collision_simple contains procedure :: generate => collision_generate_simple_system !! If a collision would result in a disruption [TODO: SOMETHING LIKE CHAMBERS 2012] - final :: collision_final_simple_system !! Finalizer will deallocate all allocatables + final :: collision_final_simple_system !! Finalizer will deallocate all allocatables end type collision_simple @@ -171,28 +174,28 @@ module collision character(NAMELEN) :: regime_varname = "regime" !! name of the collision regime variable integer(I4B) :: regime_varid !! ID for the collision regime variable contains - procedure :: initialize => collision_netcdf_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + procedure :: initialize => collision_io_netcdf_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object final :: collision_final_netcdf_parameters !! Finalizer closes the NetCDF file end type collision_netcdf_parameters type, extends(encounter_snapshot) :: collision_snapshot - logical :: lcollision !! Indicates that this snapshot contains at least one collision - class(collision_system), allocatable :: collision_system !! impactors object at this snapshot + logical :: lcollision !! Indicates that this snapshot contains at least one collision + class(collision_system), allocatable :: collider !! Collider object at this snapshot contains - procedure :: write_frame => collision_netcdf_io_write_frame_snapshot !! Writes a frame of encounter data to file - procedure :: get_idvals => collision_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot - final :: collision_final_snapshot !! Finalizer deallocates all allocatables + procedure :: write_frame => collision_io_netcdf_write_frame_snapshot !! Writes a frame of encounter data to file + procedure :: get_idvals => collision_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot + final :: collision_final_snapshot !! Finalizer deallocates all allocatables end type collision_snapshot !> A class that that is used to store simulation history data between file output type, extends(encounter_storage) :: collision_storage contains - procedure :: dump => collision_netcdf_io_dump !! Dumps contents of encounter history to file - procedure :: take_snapshot => collision_util_snapshot !! Take a minimal snapshot of the system through an encounter - procedure :: make_index_map => collision_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - final :: collision_final_storage !! Finalizer deallocates all allocatables + procedure :: dump => collision_io_netcdf_dump !! Dumps contents of encounter history to file + procedure :: take_snapshot => collision_util_snapshot !! Take a minimal snapshot of the nbody_system through an encounter + procedure :: make_index_map => collision_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + final :: collision_final_storage !! Finalizer deallocates all allocatables end type collision_storage @@ -216,10 +219,17 @@ end subroutine abstract_set_mass_dist interface + module subroutine collision_generate_merge_any(self, nbody_system, param, t) + implicit none + class(collision_system), intent(inout) :: self !! Merge fragment nbody_system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_merge_any module subroutine collision_generate_merge_system(self, nbody_system, param, t) implicit none - class(collision_merge), intent(inout) :: self !! Merge fragment system object + class(collision_merge), intent(inout) :: self !! Merge fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision @@ -227,7 +237,7 @@ end subroutine collision_generate_merge_system module subroutine collision_generate_bounce_system(self, nbody_system, param, t) implicit none - class(collision_bounce), intent(inout) :: self !! Bounce fragment system object + class(collision_bounce), intent(inout) :: self !! Bounce fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision @@ -235,42 +245,54 @@ end subroutine collision_generate_bounce_system module subroutine collision_generate_simple_system(self, nbody_system, param, t) implicit none - class(collision_simple), intent(inout) :: self !! Simple fragment system object + class(collision_simple), intent(inout) :: self !! Simple fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision end subroutine collision_generate_simple_system - module subroutine collision_netcdf_io_dump(self, param) + module subroutine collision_io_collider_message(pl, collidx, collider_message) + implicit none + class(base_object), intent(in) :: pl !! Swiftest massive body object + integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional colliders%idx members + character(*), intent(inout) :: collider_message !! The message to print to the screen. + end subroutine collision_io_collider_message + + module subroutine collision_io_log_regime(self) + implicit none + class(collision_system), intent(inout) :: self !! Collision system object + end subroutine collision_io_log_regime + + module subroutine collision_io_netcdf_dump(self, param) implicit none class(collision_storage(*)), intent(inout) :: self !! Collision storage object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine collision_netcdf_io_dump + end subroutine collision_io_netcdf_dump - module subroutine collision_netcdf_io_initialize_output(self, param) + module subroutine collision_io_netcdf_initialize_output(self, param) implicit none class(collision_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(base_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine collision_netcdf_io_initialize_output + end subroutine collision_io_netcdf_initialize_output - module subroutine collision_netcdf_io_write_frame_snapshot(self, history, param) + module subroutine collision_io_netcdf_write_frame_snapshot(self, history, param) implicit none class(collision_snapshot), intent(in) :: self !! Swiftest encounter structure class(encounter_storage(*)), intent(inout) :: history !! Collision history object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine collision_netcdf_io_write_frame_snapshot + end subroutine collision_io_netcdf_write_frame_snapshot - module subroutine collision_regime_impactors(self, system, param) + module subroutine collision_regime_impactors(self, nbody_system, param) implicit none - class(collision_impactors), intent(inout) :: self !! Collision system impactors object - class(base_nbody_system), intent(in) :: system !! Swiftest nbody system object - class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + class(collision_impactors), intent(inout) :: self !! Collision system impactors object + class(base_nbody_system), intent(in) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters end subroutine collision_regime_impactors - module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_collision) + module subroutine collision_check_plpl(self, nbody_system, param, t, dt, irec, lany_collision) implicit none class(collision_list_plpl), intent(inout) :: self !! encounter list object - class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size @@ -278,35 +300,28 @@ module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_co logical, intent(out) :: lany_collision !! Returns true if any pair of encounters resulted in a collision end subroutine collision_check_plpl - module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_collision) + module subroutine collision_check_pltp(self, nbody_system, param, t, dt, irec, lany_collision) implicit none class(collision_list_pltp), intent(inout) :: self !! encounter list object - class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical, intent(out) :: lany_collision !! Returns true if any pair of encounters resulted in a collision end subroutine collision_check_pltp - - module subroutine collision_resolve_collider_message(pl, collidx, collider_message) - implicit none - class(base_object), intent(in) :: pl !! Swiftest massive body object - integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional impactors%id members - character(*), intent(inout) :: collider_message !! The message to print to the screen. - end subroutine collision_resolve_collider_message - module subroutine collision_resolve_extract_plpl(self, system, param) + module subroutine collision_resolve_extract_plpl(self, nbody_system, param) implicit none - class(collision_list_plpl), intent(inout) :: self !! pl-pl encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(in) :: param !! Current run configuration parameters + class(collision_list_plpl), intent(inout) :: self !! pl-pl encounter list + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters end subroutine collision_resolve_extract_plpl - module subroutine collision_resolve_extract_pltp(self, system, param) + module subroutine collision_resolve_extract_pltp(self, nbody_system, param) implicit none class(collision_list_pltp), intent(inout) :: self !! pl-tp encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(in) :: param !! Current run configuration parameters end subroutine collision_resolve_extract_pltp @@ -316,36 +331,27 @@ module subroutine collision_resolve_make_impactors_pl(pl, idx) integer(I4B), dimension(:), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision end subroutine collision_resolve_make_impactors_pl - module function collision_resolve_merge(system, param, t) result(status) - implicit none - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - integer(I4B) :: status !! Status flag assigned to this outcome - end function collision_resolve_merge - - module subroutine collision_resolve_mergeaddsub(system, param, t, status) - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + module subroutine collision_resolve_mergeaddsub(nbody_system, param, t, status) + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions real(DP), intent(in) :: t !! Time of collision integer(I4B), intent(in) :: status !! Status flag to assign to adds end subroutine collision_resolve_mergeaddsub - - module subroutine collision_resolve_plpl(self, system, param, t, dt, irec) + module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) implicit none class(collision_list_plpl), intent(inout) :: self !! pl-pl encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current simulation step size integer(I4B), intent(in) :: irec !! Current recursion level end subroutine collision_resolve_plpl - module subroutine collision_resolve_pltp(self, system, param, t, dt, irec) + module subroutine collision_resolve_pltp(self, nbody_system, param, t, dt, irec) implicit none class(collision_list_pltp), intent(inout) :: self !! pl-tp encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current simulation step size @@ -354,7 +360,7 @@ end subroutine collision_resolve_pltp module subroutine collision_util_set_coordinate_system(self) implicit none - class(collision_system), intent(inout) :: self !! Collisional system + class(collision_system), intent(inout) :: self !! Collisional nbody_system end subroutine collision_util_set_coordinate_system module subroutine collision_setup_system(self, nbody_system) @@ -374,11 +380,11 @@ module subroutine collision_setup_fragments_system(self, nfrag) integer(I4B), intent(in) :: nfrag !! Number of fragments to create end subroutine collision_setup_fragments_system - module subroutine collision_util_add_fragments_to_system(self, system, param) + module subroutine collision_util_add_fragments_to_system(self, nbody_system, param) implicit none - class(collision_system), intent(in) :: self !! Collision system system object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(collision_system), intent(in) :: self !! Collision system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters end subroutine collision_util_add_fragments_to_system module subroutine collision_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) @@ -397,17 +403,17 @@ end subroutine collision_util_reset_fragments module subroutine collision_util_get_idvalues_snapshot(self, idvals) implicit none - class(collision_snapshot), intent(in) :: self !! Fraggle snapshot object + class(collision_snapshot), intent(in) :: self !! Collision snapshot object integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot end subroutine collision_util_get_idvalues_snapshot - module subroutine collision_util_get_energy_momentum(self, system, param, lbefore) + module subroutine collision_util_get_energy_momentum(self, nbody_system, param, lbefore) use base, only : base_nbody_system, base_parameters implicit none - class(collision_system), intent(inout) :: self !! Encounter collision system object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with impactors included and fragments excluded or vice versa + class(collision_system), intent(inout) :: self !! Encounter collision system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the nbody_system, with impactors included and fragments excluded or vice versa end subroutine collision_util_get_energy_momentum module subroutine collision_util_index_map(self) @@ -425,13 +431,13 @@ module subroutine collision_util_reset_system(self) class(collision_system), intent(inout) :: self !! Collision system object end subroutine collision_util_reset_system - module subroutine collision_util_snapshot(self, param, system, t, arg) + module subroutine collision_util_snapshot(self, param, nbody_system, t, arg) implicit none - class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from system time - character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from nbody_system time + character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. end subroutine collision_util_snapshot end interface diff --git a/src/collision/collision_regime.f90 b/src/collision/collision_regime.f90 index 5aa170863..50884258b 100644 --- a/src/collision/collision_regime.f90 +++ b/src/collision/collision_regime.f90 @@ -13,7 +13,7 @@ contains - module subroutine collision_regime_impactors(self, system, param) + module subroutine collision_regime_impactors(self, nbody_system, param) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Determine which fragmentation regime the set of impactors will be. This subroutine is a wrapper for the non-polymorphic raggle_regime_collresolve subroutine. @@ -21,13 +21,13 @@ module subroutine collision_regime_impactors(self, system, param) implicit none ! Arguments class(collision_impactors), intent(inout) :: self !! Collision system impactors object - class(base_nbody_system), intent(in) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(in) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters ! Internals real (DP) :: mtot associate(impactors => self) - select type (system) + select type (nbody_system) class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) @@ -42,7 +42,7 @@ module subroutine collision_regime_impactors(self, system, param) impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / mtot impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / mtot case default - call collision_regim_LS12(impactors, system, param) + call collision_regime_LS12(impactors, nbody_system, param) end select !call fraggle_io_log_regime(impactors, fragments) end select @@ -70,6 +70,7 @@ subroutine collision_regime_LS12(impactors, nbody_system, param) real(DP) :: min_mfrag_si, Mcb_si real(DP), dimension(NDIM) :: x1_si, v1_si, x2_si, v2_si, runit real(DP) :: mlr, mslr, mtot, dentot + integer(I4B), parameter :: NMASS_DIST = 3 !! Number of mass bins returned by the regime calculation (largest fragment, second largest, and remainder) ! Convert all quantities to SI units and determine which of the pair is the projectile vs. target before sending them to the regime determination subroutine if (impactors%mass(1) > impactors%mass(2)) then @@ -93,12 +94,12 @@ subroutine collision_regime_LS12(impactors, nbody_system, param) dentot = sum(mass_si(:) * density_si(:)) / mtot !! Use the positions and velocities of the parents from indside the step (at collision) to calculate the collisional regime - call collision_regime_collresolve(Mcb_si, mass_si(jtarg), mass_si(jproj), radius_si(jtarg), radius_si(jproj), & + call collision_regime_LS12_SI(Mcb_si, mass_si(jtarg), mass_si(jproj), radius_si(jtarg), radius_si(jproj), & x1_si(:), x2_si(:), v1_si(:), v2_si(:), density_si(jtarg), density_si(jproj), & min_mfrag_si, impactors%regime, mlr, mslr, impactors%Qloss) if (allocated(impactors%mass_dist)) deallocate(impactors%mass_dist) - allocate(impactors%mass_dist(3)) + allocate(impactors%mass_dist(NMASS_DIST)) impactors%mass_dist(1) = min(max(mlr, 0.0_DP), mtot) impactors%mass_dist(2) = min(max(mslr, 0.0_DP), mtot) impactors%mass_dist(3) = min(max(mtot - mlr - mslr, 0.0_DP), mtot) @@ -231,7 +232,7 @@ subroutine collision_regime_LS12_SI(Mcb, m1, m2, rad1, rad2, rh1, rh2, vb1, vb2, Mlr = Mtot Mslr = 0.0_DP Qloss = 0.0_DP - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, & "Fragments would have mass below the minimum. Converting this collision into a merger.") else if( Vimp < Vescp) then diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index aee398839..6cb08a49a 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -11,123 +11,6 @@ use swiftest contains - module function collision_resolve_merge(system, param, t) result(status) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Merge massive bodies. - !! - !! Adapted from David E. Kaufmann's Swifter routines swiftest_merge_pl.f90 and swiftest_discard_merge_pl.f90 - !! - !! Adapted from Hal Levison's Swift routines symba5_merge.f and discard_mass_merge.f - implicit none - ! Arguments - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions - real(DP), intent(in) :: t !! Time of collision - ! Result - integer(I4B) :: status !! Status flag assigned to this outcome - ! Internals - integer(I4B) :: i, j, k, ibiggest - real(DP), dimension(NDIM) :: Lspin_new - real(DP) :: dpe - character(len=STRMAX) :: message - - select type(system) - class is (swiftest_nbody_system) - associate(collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) - message = "Merging" - call collision_resolve_collider_message(system%pl, impactors%id, message) - ! call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) - - select type(pl => system%pl) - class is (swiftest_pl) - - call collision_system%set_mass_dist(param) - - ! Calculate the initial energy of the system without the collisional family - call collision_system%get_energy_and_momentum(system, param, lbefore=.true.) - - ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) - fragments%id(1) = pl%id(ibiggest) - fragments%rb(:,1) = impactors%rbcom(:) - fragments%vb(:,1) = impactors%vbcom(:) - - if (param%lrotation) then - ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body - Lspin_new(:) = impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + impactors%Lspin(:,1) + impactors%Lspin(:,2) - - ! Assume prinicpal axis rotation on 3rd Ip axis - fragments%rot(:,1) = Lspin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) - else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable - system%Lescape(:) = system%Lescape(:) + impactors%Lorbit(:,1) + impactors%Lorbit(:,2) - end if - - ! Keep track of the component of potential energy due to the pre-impact impactors%id for book-keeping - ! Get the energy of the system after the collision - call collision_system%get_energy_and_momentum(system, param, lbefore=.false.) - dpe = collision_system%pe(2) - collision_system%pe(1) - system%Ecollisions = system%Ecollisions - dpe - system%Euntracked = system%Euntracked + dpe - - - ! Update any encounter lists that have the removed bodies in them so that they instead point to the new - do k = 1, system%plpl_encounter%nenc - do j = 1, impactors%ncoll - i = impactors%id(j) - if (i == ibiggest) cycle - if (system%plpl_encounter%id1(k) == pl%id(i)) then - system%plpl_encounter%id1(k) = pl%id(ibiggest) - system%plpl_encounter%index1(k) = i - end if - if (system%plpl_encounter%id2(k) == pl%id(i)) then - system%plpl_encounter%id2(k) = pl%id(ibiggest) - system%plpl_encounter%index2(k) = i - end if - if (system%plpl_encounter%id1(k) == system%plpl_encounter%id2(k)) system%plpl_encounter%status(k) = INACTIVE - end do - end do - - status = MERGED - - call collision_resolve_mergeaddsub(system, param, t, status) - - end select - end associate - end select - return - end function collision_resolve_merge - - - module subroutine collision_resolve_collider_message(pl, collidx, collider_message) - !! author: David A. Minton - !! - !! Prints a nicely formatted message about which bodies collided, including their names and ids. - !! This subroutine appends the body names and ids to an input message. - implicit none - ! Arguments - class(base_object), intent(in) :: pl !! Swiftest massive body object - integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional impactors%id members - character(*), intent(inout) :: collider_message !! The message to print to the screen. - ! Internals - integer(I4B) :: i, n - character(len=STRMAX) :: idstr - - n = size(collidx) - if (n == 0) return - - select type(pl) - class is (swiftest_pl) - do i = 1, n - if (i > 1) collider_message = trim(adjustl(collider_message)) // " and " - collider_message = " " // trim(adjustl(collider_message)) // " " // trim(adjustl(pl%info(collidx(i))%name)) - write(idstr, '(I10)') pl%id(collidx(i)) - collider_message = trim(adjustl(collider_message)) // " (" // trim(adjustl(idstr)) // ") " - end do - end select - - return - end subroutine collision_resolve_collider_message - function collision_resolve_consolidate_impactors(pl, cb, param, idx_parent, impactors) result(lflag) !! author: David A. Minton @@ -267,16 +150,16 @@ function collision_resolve_consolidate_impactors(pl, cb, param, idx_parent, impa end function collision_resolve_consolidate_impactors - module subroutine collision_resolve_extract_plpl(self, system, param) + module subroutine collision_resolve_extract_plpl(self, nbody_system, param) !! author: David A. Minton !! !! Processes the pl-pl encounter list remove only those encounters that led to a collision !! implicit none ! Arguments - class(collision_list_plpl), intent(inout) :: self !! pl-pl encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(in) :: param !! Current run configuration parameters + class(collision_list_plpl), intent(inout) :: self !! pl-pl encounter list + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters ! Internals logical, dimension(:), allocatable :: lplpl_collision logical, dimension(:), allocatable :: lplpl_unique_parent @@ -284,9 +167,9 @@ module subroutine collision_resolve_extract_plpl(self, system, param) integer(I4B), dimension(:), allocatable :: collision_idx, unique_parent_idx integer(I4B) :: i, index_coll, ncollisions, nunique_parent, nplplenc - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) - select type (pl => system%pl) + select type (pl => nbody_system%pl) class is (swiftest_pl) associate(plpl_encounter => self, idx1 => self%index1, idx2 => self%index2, plparent => pl%kin%parent) nplplenc = plpl_encounter%nenc @@ -330,7 +213,7 @@ module subroutine collision_resolve_extract_plpl(self, system, param) ! Create a mask that contains only the pl-pl encounters that did not result in a collision, and then discard them lplpl_collision(:) = .false. lplpl_collision(collision_idx(:)) = .true. - call plpl_encounter%spill(system%plpl_collision, lplpl_collision, ldestructive=.true.) ! Extract any encounters that are not collisions from the list. + call plpl_encounter%spill(nbody_system%plpl_collision, lplpl_collision, ldestructive=.true.) ! Extract any encounters that are not collisions from the list. end associate end select end select @@ -338,16 +221,59 @@ module subroutine collision_resolve_extract_plpl(self, system, param) return end subroutine collision_resolve_extract_plpl - module subroutine collision_resolve_extract_pltp(self, system, param) + + module subroutine collision_resolve_extract_pltp(self, nbody_system, param) implicit none class(collision_list_pltp), intent(inout) :: self !! pl-tp encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(in) :: param !! Current run configuration parameters + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters return end subroutine collision_resolve_extract_pltp + subroutine collision_resolve_list(plpl_collision, nbody_system, param, t) + !! author: David A. Minton + !! + !! Process list of collisions, determine the collisional regime, and then create fragments. + !! + implicit none + ! Arguments + class(collision_list_plpl), intent(inout) :: plpl_collision !! Swiftest pl-pl encounter list + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions + real(DP), intent(in) :: t !! Time of collision + ! Internals + ! Internals + integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision + logical :: lgoodcollision + integer(I4B) :: i + + select type(nbody_system) + class is (swiftest_nbody_system) + associate(ncollisions => plpl_collision%nenc, idx1 => plpl_collision%index1, idx2 => plpl_collision%index2, & + collision_history => nbody_system%collision_history, impactors => nbody_system%collider%impactors, & + fragments => nbody_system%collider%fragments, & + pl => nbody_system%pl, cb => nbody_system%cb) + do i = 1, ncollisions + idx_parent(1) = pl%kin(idx1(i))%parent + idx_parent(2) = pl%kin(idx2(i))%parent + lgoodcollision = collision_resolve_consolidate_impactors(pl, cb, param, idx_parent, impactors) + if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLIDED)) cycle + + call impactors%get_regime(nbody_system, param) + call collision_history%take_snapshot(param,nbody_system, t, "before") + call nbody_system%collider%generate(nbody_system, param, t) + call collision_history%take_snapshot(param,nbody_system, t, "after") + call impactors%reset() + + end do + end associate + end select + return + end subroutine collision_resolve_list + + module subroutine collision_resolve_make_impactors_pl(pl, idx) !! author: Jennifer L.L. Pouplin, Carlisle A. wishard, and David A. Minton !! @@ -411,7 +337,7 @@ module subroutine collision_resolve_make_impactors_pl(pl, idx) end subroutine collision_resolve_make_impactors_pl - module subroutine collision_resolve_mergeaddsub(system, param, t, status) + module subroutine collision_resolve_mergeaddsub(nbody_system, param, t, status) !! author: David A. Minton !! !! Fills the pl_discards and pl_adds with removed and added bodies @@ -419,7 +345,7 @@ module subroutine collision_resolve_mergeaddsub(system, param, t, status) use symba, only : symba_pl implicit none ! Arguments - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions real(DP), intent(in) :: t !! Time of collision integer(I4B), intent(in) :: status !! Status flag to assign to adds @@ -430,18 +356,18 @@ module subroutine collision_resolve_mergeaddsub(system, param, t, status) character(*), parameter :: FRAGFMT = '("Newbody",I0.7)' character(len=NAMELEN) :: newname, origin_type - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) - associate(pl => system%pl, pl_discards => system%pl_discards, info => system%pl%info, pl_adds => system%pl_adds, cb => system%cb, npl => pl%nbody, & - collision_system => system%collision_system, impactors => system%collision_system%impactors,fragments => system%collision_system%fragments) + associate(pl => nbody_system%pl, pl_discards => nbody_system%pl_discards, info => nbody_system%pl%info, pl_adds => nbody_system%pl_adds, cb => nbody_system%cb, npl => pl%nbody, & + collision_system => nbody_system%collider, impactors => nbody_system%collider%impactors,fragments => nbody_system%collider%fragments) ! Add the impactors%id bodies to the subtraction list nimpactors = impactors%ncoll nfrag = fragments%nbody - param%maxid_collision = max(param%maxid_collision, maxval(system%pl%info(:)%collision_id)) + param%maxid_collision = max(param%maxid_collision, maxval(nbody_system%pl%info(:)%collision_id)) param%maxid_collision = param%maxid_collision + 1 ! Setup new bodies @@ -588,49 +514,7 @@ module subroutine collision_resolve_mergeaddsub(system, param, t, status) end subroutine collision_resolve_mergeaddsub - subroutine collision_resolve_list(plpl_collision , system, param, t) - !! author: David A. Minton - !! - !! Process list of collisions, determine the collisional regime, and then create fragments. - !! - implicit none - ! Arguments - class(collision_list_plpl), intent(inout) :: plpl_collision !! Swiftest pl-pl encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions - real(DP), intent(in) :: t !! Time of collision - ! Internals - ! Internals - integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision - logical :: lgoodcollision - integer(I4B) :: i - - select type(system) - class is (swiftest_nbody_system) - associate(ncollisions => plpl_collision%nenc, idx1 => plpl_collision%index1, idx2 => plpl_collision%index2, collision_history => system%collision_history, & - collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments, & - pl => system%pl, cb => system%cb) - do i = 1, ncollisions - idx_parent(1) = pl%kin(idx1(i))%parent - idx_parent(2) = pl%kin(idx2(i))%parent - lgoodcollision = collision_resolve_consolidate_impactors(pl, cb, param, idx_parent, impactors) - if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLIDED)) cycle - - call impactors%get_regime(system, param) - call collision_history%take_snapshot(param,system, t, "before") - - call collision_system%generate(system, param, t) - - call collision_history%take_snapshot(param,system, t, "after") - call impactors%reset() - end do - end associate - end select - return - end subroutine collision_resolve_list - - - module subroutine collision_resolve_plpl(self, system, param, t, dt, irec) + module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) !! author: David A. Minton !! !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the collision @@ -638,7 +522,7 @@ module subroutine collision_resolve_plpl(self, system, param, t, dt, irec) implicit none ! Arguments class(collision_list_plpl), intent(inout) :: self !! Swiftest pl-pl encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current simulation step size @@ -649,63 +533,63 @@ module subroutine collision_resolve_plpl(self, system, param, t, dt, irec) character(len=STRMAX) :: timestr class(swiftest_parameters), allocatable :: tmp_param - select type (system) + select type (nbody_system) class is (swiftest_nbody_system) - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (swiftest_pl) select type(param) class is (swiftest_parameters) - associate(plpl_encounter => self, plpl_collision => system%plpl_collision) + associate(plpl_encounter => self, plpl_collision => nbody_system%plpl_collision) if (plpl_collision%nenc == 0) return ! No collisions to resolve ! Make sure that the heliocentric and barycentric coordinates are consistent with each other - call pl%vb2vh(system%cb) - call pl%rh2rb(system%cb) + call pl%vb2vh(nbody_system%cb) + call pl%rh2rb(nbody_system%cb) ! Get the energy before the collision is resolved if (param%lenergy) then - call system%get_energy_and_momentum(param) - Eorbit_before = system%te + call nbody_system%get_energy_and_momentum(param) + Eorbit_before = nbody_system%te end if do write(timestr,*) t - ! call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") - ! call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & - ! "***********************************************************") - ! call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Collision between massive bodies detected at time t = " // & - ! trim(adjustl(timestr))) - ! call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & - ! "***********************************************************") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & + "***********************************************************") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Collision between massive bodies detected at time t = " // & + trim(adjustl(timestr))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & + "***********************************************************") allocate(tmp_param, source=param) - call collision_resolve_list(plpl_collision, system, param, t) + call collision_resolve_list(plpl_collision, nbody_system, param, t) ! Destroy the collision list now that the collisions are resolved call plpl_collision%setup(0_I8B) - if ((system%pl_adds%nbody == 0) .and. (system%pl_discards%nbody == 0)) exit + if ((nbody_system%pl_adds%nbody == 0) .and. (nbody_system%pl_discards%nbody == 0)) exit ! Save the add/discard information to file - call system%write_discard(tmp_param) + call nbody_system%write_discard(tmp_param) ! Rearrange the arrays: Remove discarded bodies, add any new bodies, resort, and recompute all indices and encounter lists - call pl%rearray(system, tmp_param) + call pl%rearray(nbody_system, tmp_param) ! Destroy the add/discard list so that we don't append the same body multiple times if another collision is detected - call system%pl_discards%setup(0, param) - call system%pl_adds%setup(0, param) + call nbody_system%pl_discards%setup(0, param) + call nbody_system%pl_adds%setup(0, param) deallocate(tmp_param) ! Check whether or not any of the particles that were just added are themselves in a collision state. This will generate a new plpl_collision - call plpl_encounter%collision_check(system, param, t, dt, irec, lplpl_collision) + call plpl_encounter%collision_check(nbody_system, param, t, dt, irec, lplpl_collision) if (.not.lplpl_collision) exit end do if (param%lenergy) then - call system%get_energy_and_momentum(param) - Eorbit_after = system%te - system%Ecollisions = system%Ecollisions + (Eorbit_after - Eorbit_before) + call nbody_system%get_energy_and_momentum(param) + Eorbit_after = nbody_system%te + nbody_system%Ecollisions = nbody_system%Ecollisions + (Eorbit_after - Eorbit_before) end if end associate @@ -717,7 +601,7 @@ module subroutine collision_resolve_plpl(self, system, param, t, dt, irec) end subroutine collision_resolve_plpl - module subroutine collision_resolve_pltp(self, system, param, t, dt, irec) + module subroutine collision_resolve_pltp(self, nbody_system, param, t, dt, irec) !! author: David A. Minton !! !! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the collision @@ -725,24 +609,24 @@ module subroutine collision_resolve_pltp(self, system, param, t, dt, irec) implicit none ! Arguments class(collision_list_pltp), intent(inout) :: self !! Swiftest pl-pl encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions real(DP), intent(in) :: t !! Current simulation tim real(DP), intent(in) :: dt !! Current simulation step size integer(I4B), intent(in) :: irec !! Current recursion level ! Make sure coordinate systems are all synced up due to being inside the recursion at this point - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) - call system%pl%vb2vh(system%cb) - call system%tp%vb2vh(system%cb%vb) - call system%pl%b2h(system%cb) - call system%tp%b2h(system%cb) + call nbody_system%pl%vb2vh(nbody_system%cb) + call nbody_system%tp%vb2vh(nbody_system%cb%vb) + call nbody_system%pl%b2h(nbody_system%cb) + call nbody_system%tp%b2h(nbody_system%cb) ! Discard the collider - call system%tp%discard(system, param) + call nbody_system%tp%discard(nbody_system, param) end select end select diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 47a341f61..9898e3710 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -11,22 +11,22 @@ use swiftest contains - module subroutine collision_util_add_fragments_to_system(self, system, param) + module subroutine collision_util_add_fragments_to_system(self, nbody_system, param) !! Author: David A. Minton !! !! Adds fragments to the temporary system pl object implicit none ! Arguments class(collision_system), intent(in) :: self !! Collision system system object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters ! Internals integer(I4B) :: i, npl_before, npl_after logical, dimension(:), allocatable :: lexclude - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) - associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => system%pl, cb => system%cb) + associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => nbody_system%pl, cb => nbody_system%cb) npl_after = pl%nbody npl_before = npl_after - nfrag allocate(lexclude(npl_after)) @@ -129,9 +129,9 @@ module subroutine collision_util_get_idvalues_snapshot(self, idvals) ! Internals integer(I4B) :: npl_before, ntp_before, npl_after, ntp_after, ntot, nlo, nhi - select type(before => self%collision_system%before) + select type(before => self%collider%before) class is (swiftest_nbody_system) - select type(after => self%collision_system%after) + select type(after => self%collider%after) class is (swiftest_nbody_system) npl_before = 0; ntp_before = 0; npl_after = 0; ntp_after = 0 if (allocated(before%pl)) then @@ -171,7 +171,7 @@ module subroutine collision_util_get_idvalues_snapshot(self, idvals) end subroutine collision_util_get_idvalues_snapshot - module subroutine collision_util_get_energy_momentum(self, system, param, lbefore) + module subroutine collision_util_get_energy_momentum(self, nbody_system, param, lbefore) !! Author: David A. Minton !! !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) @@ -181,19 +181,19 @@ module subroutine collision_util_get_energy_momentum(self, system, param, lbefo implicit none ! Arguments class(collision_system), intent(inout) :: self !! Encounter collision system object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with impactors included and fragments excluded or vice versa + logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the nbody_system, with impactors included and fragments excluded or vice versa ! Internals class(base_nbody_system), allocatable, save :: tmpsys class(base_parameters), allocatable, save :: tmpparam integer(I4B) :: npl_before, npl_after, stage - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) - associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => system%pl, cb => system%cb) + associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => nbody_system%pl, cb => nbody_system%cb) ! Because we're making a copy of the massive body object with the excludes/fragments appended, we need to deallocate the ! big k_plpl array and recreate it when we're done, otherwise we run the risk of blowing up the memory by @@ -204,7 +204,7 @@ module subroutine collision_util_get_energy_momentum(self, system, param, lbefo npl_after = npl_before + nfrag if (lbefore) then - call self%construct_temporary_system(system, param, tmpsys, tmpparam) + call self%construct_temporary_system(nbody_system, param, tmpsys, tmpparam) select type(tmpsys) class is (swiftest_nbody_system) ! Build the exluded body logical mask for the *before* case: Only the original bodies are used to compute energy and momentum @@ -346,7 +346,7 @@ end subroutine collision_util_reset_fragments module subroutine collision_util_reset_system(self) !! author: David A. Minton !! - !! Resets the collider system and deallocates all allocatables + !! Resets the collider nbody_system and deallocates all allocatables implicit none ! Arguments class(collision_system), intent(inout) :: self !! Collision system object @@ -372,10 +372,10 @@ end subroutine collision_util_reset_system module subroutine collision_util_set_coordinate_system(self) !! author: David A. Minton !! - !! Defines the collisional coordinate system, including the unit vectors of both the system and individual fragments. + !! Defines the collisional coordinate nbody_system, including the unit vectors of both the nbody_system and individual fragments. implicit none ! Arguments - class(collision_system), intent(inout) :: self !! Collisional system + class(collision_system), intent(inout) :: self !! Collisional nbody_system ! Internals integer(I4B) :: i real(DP), dimension(NDIM) :: delta_r, delta_v, Ltot @@ -386,7 +386,7 @@ module subroutine collision_util_set_coordinate_system(self) delta_v(:) = impactors%vb(:, 2) - impactors%vb(:, 1) delta_r(:) = impactors%rb(:, 2) - impactors%rb(:, 1) - ! We will initialize fragments on a plane defined by the pre-impact system, with the z-axis aligned with the angular momentum vector + ! We will initialize fragments on a plane defined by the pre-impact nbody_system, with the z-axis aligned with the angular momentum vector ! and the y-axis aligned with the pre-impact distance vector. ! y-axis is the separation distance @@ -410,7 +410,7 @@ module subroutine collision_util_set_coordinate_system(self) fragments%rmag(:) = .mag. fragments%rc(:,:) ! Randomize the tangential velocity direction. - ! This helps to ensure that the tangential velocity doesn't completely line up with the angular momentum vector, otherwise we can get an ill-conditioned system + ! This helps to ensure that the tangential velocity doesn't completely line up with the angular momentum vector, otherwise we can get an ill-conditioned nbody_system call random_number(L_sigma(:,:)) do concurrent(i = 1:nfrag, fragments%rmag(i) > 0.0_DP) fragments%v_n_unit(:, i) = impactors%z_unit(:) + 2e-1_DP * (L_sigma(:,i) - 0.5_DP) @@ -472,17 +472,17 @@ subroutine collision_util_save_snapshot(collision_history, snapshot) end subroutine collision_util_save_snapshot - module subroutine collision_util_snapshot(self, param, system, t, arg) + module subroutine collision_util_snapshot(self, param, nbody_system, t, arg) !! author: David A. Minton !! - !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories + !! Takes a minimal snapshot of the state of the nbody_system during an encounter so that the trajectories !! can be played back through the encounter implicit none ! Internals class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from nbody_system time character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. ! Arguments class(collision_snapshot), allocatable :: snapshot @@ -495,33 +495,33 @@ module subroutine collision_util_snapshot(self, param, system, t, arg) stage = "" end if - select type (system) + select type (nbody_system) class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) select case(stage) case("before") ! Saves the states of the bodies involved in the collision before the collision is resolved - associate (idx => system%collision_system%impactors%id, ncoll => system%collision_system%impactors%ncoll) + associate (idx => nbody_system%collider%impactors%id, ncoll => nbody_system%collider%impactors%ncoll) call pl%setup(ncoll, param) - pl%id(:) = system%pl%id(idx(:)) - pl%Gmass(:) = system%pl%Gmass(idx(:)) - pl%radius(:) = system%pl%radius(idx(:)) - pl%rot(:,:) = system%pl%rot(:,idx(:)) - pl%Ip(:,:) = system%pl%Ip(:,idx(:)) - pl%rh(:,:) = system%pl%rh(:,idx(:)) - pl%vh(:,:) = system%pl%vh(:,idx(:)) - pl%info(:) = system%pl%info(idx(:)) - select type (before => system%collision_system%before) + pl%id(:) = nbody_system%pl%id(idx(:)) + pl%Gmass(:) = nbody_system%pl%Gmass(idx(:)) + pl%radius(:) = nbody_system%pl%radius(idx(:)) + pl%rot(:,:) = nbody_system%pl%rot(:,idx(:)) + pl%Ip(:,:) = nbody_system%pl%Ip(:,idx(:)) + pl%rh(:,:) = nbody_system%pl%rh(:,idx(:)) + pl%vh(:,:) = nbody_system%pl%vh(:,idx(:)) + pl%info(:) = nbody_system%pl%info(idx(:)) + select type (before => nbody_system%collider%before) class is (swiftest_nbody_system) allocate(before%pl, source=pl) end select end associate case("after") allocate(collision_snapshot :: snapshot) - allocate(snapshot%collision_system, source=system%collision_system) + allocate(snapshot%collider, source=nbody_system%collider) snapshot%t = t - call collision_util_save_snapshot(system%collision_history,snapshot) + call collision_util_save_snapshot(nbody_system%collision_history,snapshot) case default write(*,*) "collision_util_snapshot requies either 'before' or 'after' passed to 'arg'" end select diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index c5b68b98c..4b572af9d 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -7,11 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (encounter) s_encounter_netcdf_io +submodule (encounter) s_encounter_io_netcdf use swiftest contains - module subroutine encounter_netcdf_io_dump(self, param) + module subroutine encounter_io_netcdf_dump(self, param) ! author: David A. Minton !! !! Dumps the time history of an encounter to file. @@ -51,10 +51,10 @@ module subroutine encounter_netcdf_io_dump(self, param) end select return - end subroutine encounter_netcdf_io_dump + end subroutine encounter_io_netcdf_dump - module subroutine encounter_netcdf_io_initialize_output(self, param) + module subroutine encounter_io_netcdf_initialize_output(self, param) !! author: David A. Minton !! !! Initialize a NetCDF encounter file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. @@ -93,55 +93,55 @@ module subroutine encounter_netcdf_io_initialize_output(self, param) close(unit=LUN, status="delete") end if - call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_netcdf_io_initialize_output nf90_create" ) + call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_netcdf_initialize_output nf90_create" ) nc%lfile_is_open = .true. ! Dimensions - call netcdf_io_check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_netcdf_io_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension - call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "encounter_netcdf_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "encounter_netcdf_io_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers - call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_netcdf_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call netcdf_io_check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_netcdf_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "encounter_io_netcdf_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "encounter_io_netcdf_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers + call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_netcdf_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) ! Dimension coordinates - call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_netcdf_io_initialize_output nf90_def_var time_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_netcdf_io_initialize_output nf90_def_var space_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "encounter_netcdf_io_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_netcdf_initialize_output nf90_def_var time_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_netcdf_initialize_output nf90_def_var space_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "encounter_io_netcdf_initialize_output nf90_def_var id_varid" ) ! Variables - call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "encounter_netcdf_io_initialize_output nf90_def_var id_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "encounter_netcdf_io_initialize_output nf90_def_var ptype_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "encounter_netcdf_io_initialize_output nf90_def_var rh_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "encounter_netcdf_io_initialize_output nf90_def_var vh_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_netcdf_io_initialize_output nf90_def_var Gmass_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_netcdf_io_initialize_output nf90_def_var loop_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "encounter_io_netcdf_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "encounter_io_netcdf_initialize_output nf90_def_var ptype_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_netcdf_initialize_output nf90_def_var rh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_netcdf_initialize_output nf90_def_var vh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_netcdf_initialize_output nf90_def_var Gmass_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_netcdf_initialize_output nf90_def_var loop_varid" ) if (param%lclose) then - call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "encounter_netcdf_io_initialize_output nf90_def_var radius_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_netcdf_initialize_output nf90_def_var radius_varid" ) end if if (param%lrotation) then - call netcdf_io_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "encounter_netcdf_io_initialize_output nf90_def_var Ip_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "encounter_netcdf_io_initialize_output nf90_def_var rot_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_netcdf_initialize_output nf90_def_var Ip_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_netcdf_initialize_output nf90_def_var rot_varid" ) end if - call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "encounter_netcdf_io_initialize_output nf90_inquire nVariables" ) + call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_netcdf_initialize_output nf90_inquire nVariables" ) do varid = 1, nvar - call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_netcdf_io_initialize_output nf90_inquire_variable" ) + call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_netcdf_initialize_output nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "encounter_netcdf_io_initialize_output nf90_def_var_fill NF90_INT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "encounter_io_netcdf_initialize_output nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "encounter_netcdf_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "encounter_io_netcdf_initialize_output nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "encounter_netcdf_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "encounter_io_netcdf_initialize_output nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "encounter_netcdf_io_initialize_output nf90_def_var_fill NF90_CHAR" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "encounter_io_netcdf_initialize_output nf90_def_var_fill NF90_CHAR" ) end select end do ! Take the file out of define mode - call netcdf_io_check( nf90_enddef(nc%id), "encounter_netcdf_io_initialize_output nf90_enddef" ) + call netcdf_io_check( nf90_enddef(nc%id), "encounter_io_netcdf_initialize_output nf90_enddef" ) ! Add in the space dimension coordinates - call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_netcdf_io_initialize_output nf90_put_var space" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_netcdf_initialize_output nf90_put_var space" ) end associate @@ -150,10 +150,10 @@ module subroutine encounter_netcdf_io_initialize_output(self, param) 667 continue write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) call util_exit(FAILURE) - end subroutine encounter_netcdf_io_initialize_output + end subroutine encounter_io_netcdf_initialize_output - module subroutine encounter_netcdf_io_write_frame_snapshot(self, history, param) + module subroutine encounter_io_netcdf_write_frame_snapshot(self, history, param) !! author: David A. Minton !! !! Write a frame of output of an encounter trajectory. @@ -177,43 +177,43 @@ module subroutine encounter_netcdf_io_write_frame_snapshot(self, history, param) select type (nc => history%nc) class is (encounter_netcdf_parameters) associate(tslot => param%ioutput) - call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_netcdf_io_write_frame_snapshot nf90_set_fill" ) + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_netcdf_write_frame_snapshot nf90_set_fill" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var time_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl loop_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl loop_varid" ) npl = pl%nbody do i = 1, npl idslot = findloc(history%idvals,pl%id(i),dim=1) - call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl id_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl rh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl vh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl Gmass_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl Gmass_varid" ) - if (param%lclose) call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl radius_varid" ) + if (param%lclose) call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl radius_varid" ) if (param%lrotation) then - call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl Ip_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl rotx_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl Ip_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl rotx_varid" ) end if charstring = trim(adjustl(pl%info(i)%name)) - call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl particle_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl particle_type_varid" ) end do ntp = tp%nbody do i = 1, ntp idslot = findloc(history%idvals,tp%id(i),dim=1) - call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp id_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp rh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var tp id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var tp rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var tp vh_varid" ) charstring = trim(adjustl(tp%info(i)%name)) - call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var tp name_varid" ) charstring = trim(adjustl(tp%info(i)%particle_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp particle_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var tp particle_type_varid" ) end do call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode) ) @@ -224,9 +224,6 @@ module subroutine encounter_netcdf_io_write_frame_snapshot(self, history, param) end select return - end subroutine encounter_netcdf_io_write_frame_snapshot + end subroutine encounter_io_netcdf_write_frame_snapshot - - - -end submodule s_encounter_netcdf_io \ No newline at end of file +end submodule s_encounter_io_netcdf \ No newline at end of file diff --git a/src/encounter/encounter_module.f90 b/src/encounter/encounter_module.f90 index d4d35db92..abb3c3422 100644 --- a/src/encounter/encounter_module.f90 +++ b/src/encounter/encounter_module.f90 @@ -53,7 +53,7 @@ module encounter real(DP) :: t !! Simulation time when snapshot was taken integer(I8B) :: iloop !! Loop number at time of snapshot contains - procedure :: write_frame => encounter_netcdf_io_write_frame_snapshot !! Writes a frame of encounter data to file + procedure :: write_frame => encounter_io_netcdf_write_frame_snapshot !! Writes a frame of encounter data to file procedure :: get_idvals => encounter_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot final :: encounter_final_snapshot end type encounter_snapshot @@ -66,7 +66,7 @@ module encounter integer(I4B) :: name_dimsize = 0 !! Number of potential id values in snapshot integer(I4B) :: file_number = 1 !! The number to append on the output file contains - procedure :: initialize => encounter_netcdf_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + procedure :: initialize => encounter_io_netcdf_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object final :: encounter_final_netcdf_parameters !! Finalizer will close the NetCDF file end type encounter_netcdf_parameters @@ -75,7 +75,7 @@ module encounter type, extends(base_storage) :: encounter_storage class(encounter_netcdf_parameters), allocatable :: nc !! NetCDF object attached to this storage object contains - procedure :: dump => encounter_netcdf_io_dump !! Dumps contents of encounter history to file + procedure :: dump => encounter_io_netcdf_dump !! Dumps contents of encounter history to file procedure :: get_index_values => encounter_util_get_vals_storage !! Gets the unique values of the indices of a storage object (i.e. body id or time value) procedure :: make_index_map => encounter_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id procedure :: take_snapshot => encounter_util_snapshot !! Take a minimal snapshot of the system through an encounter @@ -83,7 +83,6 @@ module encounter end type encounter_storage - type encounter_bounding_box_1D integer(I4B) :: n !! Number of bodies with extents integer(I4B), dimension(:), allocatable :: ind !! Sorted minimum/maximum extent indices (value > n indicates an ending index) @@ -110,7 +109,7 @@ module encounter module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, nenc, index1, index2, lvdotr) use base, only: base_parameters implicit none - class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s + class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: npl !! Total number of massive bodies real(DP), dimension(:,:), intent(in) :: x !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: v !! Velocity vectors of massive bodies @@ -126,7 +125,7 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, nenc, index1, index2, lvdotr) use base, only: base_parameters implicit none - class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s + class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: nplm !! Total number of fully interacting massive bodies integer(I4B), intent(in) :: nplt !! Total number of partially interacting masive bodies (GM < GMTINY) real(DP), dimension(:,:), intent(in) :: xplm !! Position vectors of fully interacting massive bodies @@ -218,24 +217,24 @@ module subroutine encounter_check_sweep_aabb_single_list(self, n, x, v, renc, dt logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical array indicating which pairs are approaching end subroutine encounter_check_sweep_aabb_single_list - module subroutine encounter_netcdf_io_dump(self, param) + module subroutine encounter_io_netcdf_dump(self, param) implicit none class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine encounter_netcdf_io_dump + end subroutine encounter_io_netcdf_dump - module subroutine encounter_netcdf_io_initialize_output(self, param) + module subroutine encounter_io_netcdf_initialize_output(self, param) implicit none class(encounter_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(base_parameters), intent(in) :: param - end subroutine encounter_netcdf_io_initialize_output + end subroutine encounter_io_netcdf_initialize_output - module subroutine encounter_netcdf_io_write_frame_snapshot(self, history, param) + module subroutine encounter_io_netcdf_write_frame_snapshot(self, history, param) implicit none class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure class(encounter_storage(*)), intent(inout) :: history !! Encounter storage object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine encounter_netcdf_io_write_frame_snapshot + end subroutine encounter_io_netcdf_write_frame_snapshot module subroutine encounter_setup_aabb(self, n, n_last) implicit none @@ -297,13 +296,13 @@ module subroutine encounter_util_resize_list(self, nnew) integer(I8B), intent(in) :: nnew !! New size of list needed end subroutine encounter_util_resize_list - module subroutine encounter_util_snapshot(self, param, system, t, arg) + module subroutine encounter_util_snapshot(self, param, nbody_system, t, arg) implicit none - class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from system time - character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) end subroutine encounter_util_snapshot module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestructive) diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 5c26771a5..06648ca9f 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -368,7 +368,7 @@ subroutine encounter_util_save_snapshot(encounter_history, snapshot) end subroutine encounter_util_save_snapshot - module subroutine encounter_util_snapshot(self, param, system, t, arg) + module subroutine encounter_util_snapshot(self, param, nbody_system, t, arg) !! author: David A. Minton !! !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories @@ -378,7 +378,7 @@ module subroutine encounter_util_snapshot(self, param, system, t, arg) ! Internals class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object to store real(DP), intent(in), optional :: t !! Time of snapshot if different from system time character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) ! Arguments @@ -400,11 +400,11 @@ module subroutine encounter_util_snapshot(self, param, system, t, arg) select type(param) class is (swiftest_parameters) - select type (system) + select type (nbody_system) class is (swiftest_nbody_system) - select type (pl => system%pl) + select type (pl => nbody_system%pl) class is (swiftest_pl) - select type (tp => system%tp) + select type (tp => nbody_system%tp) class is (swiftest_tp) associate(npl => pl%nbody, ntp => tp%nbody) if (npl + ntp == 0) return @@ -429,9 +429,9 @@ module subroutine encounter_util_snapshot(self, param, system, t, arg) pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE select type(pl) class is (symba_pl) - select type(system) + select type(nbody_system) class is (symba_nbody_system) - pl%lmask(1:npl) = pl%lmask(1:npl) .and. pl%levelg(1:npl) == system%irec + pl%lmask(1:npl) = pl%lmask(1:npl) .and. pl%levelg(1:npl) == nbody_system%irec end select end select npl_snap = count(pl%lmask(1:npl)) @@ -440,9 +440,9 @@ module subroutine encounter_util_snapshot(self, param, system, t, arg) tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE select type(tp) class is (symba_tp) - select type(system) + select type(nbody_system) class is (symba_nbody_system) - tp%lmask(1:ntp) = tp%lmask(1:ntp) .and. tp%levelg(1:ntp) == system%irec + tp%lmask(1:ntp) = tp%lmask(1:ntp) .and. tp%levelg(1:ntp) == nbody_system%irec end select end select ntp_snap = count(tp%lmask(1:ntp)) @@ -496,13 +496,13 @@ module subroutine encounter_util_snapshot(self, param, system, t, arg) end if ! Save the snapshot - select type (encounter_history => system%encounter_history) + select type (encounter_history => nbody_system%encounter_history) class is (encounter_storage(*)) encounter_history%nid = encounter_history%nid + ntp_snap + npl_snap - call encounter_util_save_snapshot(system%encounter_history,snapshot) + call encounter_util_save_snapshot(nbody_system%encounter_history,snapshot) end select case("closest") - associate(plpl_encounter => system%plpl_encounter, pltp_encounter => system%pltp_encounter) + associate(plpl_encounter => nbody_system%plpl_encounter, pltp_encounter => nbody_system%pltp_encounter) if (any(plpl_encounter%lclosest(:))) then call pl_snap%setup(2, param) do k = 1, plpl_encounter%nenc @@ -565,7 +565,7 @@ module subroutine encounter_util_snapshot(self, param, system, t, arg) pl_snap%vh(:,2) = vb(:,2) + vcom(:) call pl_snap%sort("id", ascending=.true.) - call encounter_util_save_snapshot(system%encounter_history,snapshot) + call encounter_util_save_snapshot(nbody_system%encounter_history,snapshot) end if end do diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 5cad2a3a9..52ba2d914 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -21,31 +21,31 @@ module subroutine fraggle_generate_system(self, nbody_system, param, t) implicit none class(fraggle_system), intent(inout) :: self !! Fraggle fragment nbody_system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody nbody_system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision ! Internals integer(I4B) :: i - select type(nbody_system) - class is (swiftest_nbody_system) - select type(param) - class is (swiftest_parameters) - associate(impactors => self%impactors, plpl_collision => nbody_system%plpl_collision) - select case (impactors%regime) - case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - plpl_collision%status(i) = fraggle_resolve_disruption(nbody_system, param, t) - case (COLLRESOLVE_REGIME_HIT_AND_RUN) - plpl_collision%status(i) = fraggle_resolve_hitandrun(nbody_system, param, t) - case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - plpl_collision%status(i) = collision_resolve_merge(nbody_system, param, t) - case default - write(*,*) "Error in swiftest_collision, unrecognized collision regime" - call util_exit(FAILURE) - end select - end associate - end select - end select + ! select type(nbody_system) + ! class is (swiftest_nbody_system) + ! select type(param) + ! class is (swiftest_parameters) + ! associate(impactors => self%impactors, plpl_collision => nbody_system%plpl_collision) + ! select case (impactors%regime) + ! case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + ! plpl_collision%status(i) = fraggle_resolve_disruption(nbody_system, param, t) + ! case (COLLRESOLVE_REGIME_HIT_AND_RUN) + ! plpl_collision%status(i) = fraggle_resolve_hitandrun(nbody_system, param, t) + ! case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + ! plpl_collision%status(i) = collision_resolve_merge(nbody_system, param, t) + ! case default + ! write(*,*) "Error in swiftest_collision, unrecognized collision regime" + ! call util_exit(FAILURE) + ! end select + ! end associate + ! end select + ! end select end subroutine fraggle_generate_system @@ -58,7 +58,7 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par implicit none ! Arguments class(fraggle_system), intent(inout) :: collision_system !! Fraggle nbody_system object the outputs will be the fragmentation - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody nbody_system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? ! Internals @@ -87,10 +87,10 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par associate(impactors => collision_system%impactors, nfrag => fragments%nbody, pl => nbody_system%pl) write(message,*) nfrag - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle generating " // trim(adjustl(message)) // " fragments.") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle generating " // trim(adjustl(message)) // " fragments.") if (nfrag < NFRAG_MIN) then write(message,*) "Fraggle needs at least ",NFRAG_MIN," fragments, but only ",nfrag," were given." - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) lfailure = .true. return end if @@ -119,7 +119,7 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par try = 1 do while (try < MAXTRY) write(message,*) try - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle try " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle try " // trim(adjustl(message))) if (lfailure) then call fragments%restructure(impactors, try, f_spin, r_max_start) call fragments%reset() @@ -142,19 +142,19 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par call fraggle_generate_spins(collision_system, f_spin, lfailure) if (lfailure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find spins") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find spins") cycle end if call fraggle_generate_tan_vel(collision_system, lfailure) if (lfailure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find tangential velocities") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find tangential velocities") cycle end if call fraggle_generate_rad_vel(collision_system, lfailure) if (lfailure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find radial velocities") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find radial velocities") cycle end if @@ -166,7 +166,7 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par lfailure = ((abs(dEtot + impactors%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) if (lfailure) then write(message, *) dEtot, abs(dEtot + impactors%Qloss) / FRAGGLE_ETOL - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed due to high energy error: " // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high energy error: " // & trim(adjustl(message))) cycle end if @@ -174,7 +174,7 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par lfailure = ((abs(dLmag) / (.mag.collision_system%Ltot(:,1))) > FRAGGLE_LTOL) if (lfailure) then write(message,*) dLmag / (.mag.collision_system%Ltot(:,1)) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & trim(adjustl(message))) cycle end if @@ -184,15 +184,15 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par lfailure = any(fpe_flag) if (.not.lfailure) exit write(message,*) "Fraggle failed due to a floating point exception: ", fpe_flag - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) end do write(message,*) try if (lfailure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle fragment generation failed after " // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle fragment generation failed after " // & trim(adjustl(message)) // " tries") else - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle fragment generation succeeded after " // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle fragment generation succeeded after " // & trim(adjustl(message)) // " tries") end if @@ -218,7 +218,7 @@ subroutine fraggle_generate_pos_vec(collision_system, r_max_start) !! The initial positions do not conserve energy or momentum, so these need to be adjusted later. implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision nbody_system object + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object real(DP), intent(in) :: r_max_start !! Initial guess for the starting maximum radial distance of fragments ! Internals real(DP) :: dis, rad, r_max, fdistort @@ -301,7 +301,7 @@ subroutine fraggle_generate_spins(collision_system, f_spin, lfailure) !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision nbody_system object + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object real(DP), intent(in) :: f_spin !! Fraction of energy or momentum that goes into spin (whichever gives the lowest kinetic energy) logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals @@ -364,16 +364,16 @@ subroutine fraggle_generate_spins(collision_system, f_spin, lfailure) lfailure = ((fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit) < 0.0_DP) if (lfailure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, " ") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Spin failure diagnostics") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, " ") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Spin failure diagnostics") write(message, *) fragments%ke_budget - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_budget : " // trim(adjustl(message))) write(message, *) fragments%ke_spin - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_spin : " // trim(adjustl(message))) write(message, *) fragments%ke_orbit - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) write(message, *) fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) end if end select @@ -398,7 +398,7 @@ subroutine fraggle_generate_tan_vel(collision_system, lfailure) !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision nbody_system object + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds ! Internals integer(I4B) :: i, try @@ -466,20 +466,20 @@ subroutine fraggle_generate_tan_vel(collision_system, lfailure) fragments%rc(:,:) = fragments%rc(:,:) * 1.1_DP end do if (lfailure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, " ") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Tangential velocity failure diagnostics") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, " ") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Tangential velocity failure diagnostics") call fragments%get_angular_momentum() L_frag_tot = fragments%Lspin(:) + fragments%Lorbit(:) write(message, *) .mag.(fragments%L_budget(:) - L_frag_tot(:)) / (.mag.collision_system%Ltot(:,1)) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "|L_remainder| : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "|L_remainder| : " // trim(adjustl(message))) write(message, *) fragments%ke_budget - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_budget : " // trim(adjustl(message))) write(message, *) fragments%ke_spin - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_spin : " // trim(adjustl(message))) write(message, *) fragments%ke_orbit - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_tangential : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_tangential : " // trim(adjustl(message))) write(message, *) fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_radial : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_radial : " // trim(adjustl(message))) end if end select end associate @@ -582,7 +582,7 @@ subroutine fraggle_generate_rad_vel(collision_system, lfailure) !! Adjust the fragment velocities to set the fragment orbital kinetic energy. This will minimize the difference between the fragment kinetic energy and the energy budget implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision nbody_system object + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals real(DP), parameter :: TOL_MIN = FRAGGLE_ETOL ! This needs to be more accurate than the tangential step, as we are trying to minimize the total residual energy @@ -641,16 +641,16 @@ subroutine fraggle_generate_rad_vel(collision_system, lfailure) lfailure = abs((fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin)) / fragments%ke_budget) > FRAGGLE_ETOL if (lfailure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, " ") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Radial velocity failure diagnostics") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, " ") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Radial velocity failure diagnostics") write(message, *) fragments%ke_budget - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_budget : " // trim(adjustl(message))) write(message, *) fragments%ke_spin - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_spin : " // trim(adjustl(message))) write(message, *) fragments%ke_orbit - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) write(message, *) fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) end if end select diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 7c943b5d6..c2e479dbb 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -12,43 +12,5 @@ contains - module subroutine fraggle_io_log_regime(collision_system) - !! author: David A. Minton - !! - !! Writes a log of the results of the collisional regime determination - implicit none - ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object - ! Internals - character(STRMAX) :: errmsg - - associate(fragments => collision_system%fragments, impactors => collision_system%impactors) - open(unit=LUN, file=FRAGGLE_LOG_OUT, status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) - write(LUN, *, err = 667, iomsg = errmsg) - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) " Fraggle collisional regime determination results" - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) "True number of impactors : ",impactors%ncoll - write(LUN, *) "Index list of true impactors : ",impactors%id(1:impactors%ncoll) - select case(impactors%regime) - case(COLLRESOLVE_REGIME_MERGE) - write(LUN, *) "Regime: Merge" - case(COLLRESOLVE_REGIME_DISRUPTION) - write(LUN, *) "Regime: Disruption" - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - write(LUN, *) "Regime: Supercatastrophic disruption" - case(COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - write(LUN, *) "Regime: Graze and merge" - case(COLLRESOLVE_REGIME_HIT_AND_RUN) - write(LUN, *) "Regime: Hit and run" - end select - write(LUN, *) "Energy loss : ", impactors%Qloss - write(LUN, *) "--------------------------------------------------------------------" - close(LUN) - end associate - return - 667 continue - write(*,*) "Error writing Fraggle regime information to log file: " // trim(adjustl(errmsg)) - end subroutine fraggle_io_log_regime end submodule s_fraggle_io \ No newline at end of file diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index 7960a8d44..89c5ab5f7 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -15,8 +15,6 @@ module fraggle implicit none public - integer(I4B), parameter :: FRAGGLE_NMASS_DIST = 3 !! Number of mass bins returned by the regime calculation (largest fragment, second largest, and remainder) - character(len=*), parameter :: FRAGGLE_LOG_OUT = "fraggle.log" !! Name of log file for Fraggle diagnostic information !> Class definition for the variables that describe a collection of fragments by Fraggle barycentric coordinates type, extends(collision_fragments) :: fraggle_fragments diff --git a/src/fraggle/fraggle_resolve.f90 b/src/fraggle/fraggle_resolve.f90 index 41f80aa72..10c7bf3e2 100644 --- a/src/fraggle/fraggle_resolve.f90 +++ b/src/fraggle/fraggle_resolve.f90 @@ -38,8 +38,8 @@ module function fraggle_resolve_disruption(collision_system, nbody_system, param case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) message = "Supercatastrophic disruption between" end select - call collision_resolve_collider_message(nbody_system%pl, impactors%id, message) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) + call collision_io_collider_message(nbody_system%pl, impactors%id, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) ! Collisional fragments will be uniformly distributed around the pre-impact barycenter call collision_system%set_mass_dist(param) @@ -52,7 +52,7 @@ module function fraggle_resolve_disruption(collision_system, nbody_system, param nbody_system%Euntracked = nbody_system%Euntracked + dpe if (lfailure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") status = ACTIVE nfrag = 0 pl%status(impactors%id(:)) = status @@ -69,7 +69,7 @@ module function fraggle_resolve_disruption(collision_system, nbody_system, param ! Populate the list of new bodies nfrag = fragments%nbody write(message, *) nfrag - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") select case(impactors%regime) case(COLLRESOLVE_REGIME_DISRUPTION) status = DISRUPTED @@ -116,8 +116,8 @@ module function fraggle_resolve_hitandrun(collision_system, nbody_system, param, class is (swiftest_nbody_system) associate(impactors => collision_system%impactors, fragments => collision_system%fragments, pl => nbody_system%pl) message = "Hit and run between" - call collision_resolve_collider_message(nbody_system%pl, impactors%id, message) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, trim(adjustl(message))) + call collision_io_collider_message(nbody_system%pl, impactors%id, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, trim(adjustl(message))) if (impactors%mass(1) > impactors%mass(2)) then jtarg = 1 @@ -128,7 +128,7 @@ module function fraggle_resolve_hitandrun(collision_system, nbody_system, param, end if if (impactors%mass_dist(2) > 0.9_DP * impactors%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Pure hit and run. No new fragments generated.") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Pure hit and run. No new fragments generated.") nfrag = 0 lpure = .true. else ! Imperfect hit and run, so we'll keep the largest body and destroy the other @@ -143,12 +143,12 @@ module function fraggle_resolve_hitandrun(collision_system, nbody_system, param, nbody_system%Euntracked = nbody_system%Euntracked + dpe if (lpure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Should have been a pure hit and run instead") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Should have been a pure hit and run instead") nfrag = 0 else nfrag = fragments%nbody write(message, *) nfrag - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") end if end if if (lpure) then ! Reset these bodies back to being active so that nothing further is done to them diff --git a/src/helio/helio_drift.f90 b/src/helio/helio_drift.f90 index d61eb6450..ad476a2b2 100644 --- a/src/helio/helio_drift.f90 +++ b/src/helio/helio_drift.f90 @@ -11,7 +11,7 @@ use swiftest contains - module subroutine helio_drift_body(self, system, param, dt) + module subroutine helio_drift_body(self, nbody_system, param, dt) !! author: David A. Minton !! !! Loop through bodies and call Danby drift routine on democratic heliocentric coordinates @@ -21,7 +21,7 @@ module subroutine helio_drift_body(self, system, param, dt) implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize ! Internals @@ -35,7 +35,7 @@ module subroutine helio_drift_body(self, system, param, dt) allocate(iflag(n)) iflag(:) = 0 allocate(mu(n)) - mu(:) = system%cb%Gmass + mu(:) = nbody_system%cb%Gmass call swiftest_drift_all(mu, self%rh, self%vb, self%nbody, param, dt, self%lmask, iflag) if (any(iflag(1:n) /= 0)) then where(iflag(1:n) /= 0) self%status(1:n) = DISCARDED_DRIFTERR @@ -50,35 +50,35 @@ module subroutine helio_drift_body(self, system, param, dt) end subroutine helio_drift_body - module subroutine helio_drift_pl(self, system, param, dt) + module subroutine helio_drift_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Wrapper function used to call the body drift routine from a helio_pl structure implicit none ! Arguments class(helio_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize - call helio_drift_body(self, system, param, dt) + call helio_drift_body(self, nbody_system, param, dt) return end subroutine helio_drift_pl - module subroutine helio_drift_tp(self, system, param, dt) + module subroutine helio_drift_tp(self, nbody_system, param, dt) !! author: David A. Minton !! !! Wrapper function used to call the body drift routine from a helio_pl structure implicit none ! Arguments class(helio_tp), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize - call helio_drift_body(self, system, param, dt) + call helio_drift_body(self, nbody_system, param, dt) return end subroutine helio_drift_tp diff --git a/src/helio/helio_gr.f90 b/src/helio/helio_gr.f90 index 7a5ac9525..2092fca6a 100644 --- a/src/helio/helio_gr.f90 +++ b/src/helio/helio_gr.f90 @@ -57,7 +57,7 @@ pure module subroutine helio_gr_kick_getacch_tp(self, param) end subroutine helio_gr_kick_getacch_tp - pure module subroutine helio_gr_p4_pl(self, system, param, dt) + pure module subroutine helio_gr_p4_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to massive bodies due to p**4 term in the post-Newtonian correction @@ -67,7 +67,7 @@ pure module subroutine helio_gr_p4_pl(self, system, param, dt) implicit none ! Arguments class(helio_pl), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size ! Internals @@ -85,7 +85,7 @@ pure module subroutine helio_gr_p4_pl(self, system, param, dt) end subroutine helio_gr_p4_pl - pure module subroutine helio_gr_p4_tp(self, system, param, dt) + pure module subroutine helio_gr_p4_tp(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to test particles due to p**4 term in the post-Newtonian correction @@ -95,7 +95,7 @@ pure module subroutine helio_gr_p4_tp(self, system, param, dt) implicit none ! Arguments class(helio_tp), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size ! Internals diff --git a/src/helio/helio_kick.f90 b/src/helio/helio_kick.f90 index 525990d12..6fb4fad43 100644 --- a/src/helio/helio_kick.f90 +++ b/src/helio/helio_kick.f90 @@ -11,7 +11,7 @@ use swiftest contains - module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) + module subroutine helio_kick_getacch_pl(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of massive bodies @@ -21,17 +21,17 @@ module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) implicit none ! Arguments class(helio_pl), intent(inout) :: self !! Helio massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step if (self%nbody == 0) return - associate(cb => system%cb, pl => self, npl => self%nbody) + associate(cb => nbody_system%cb, pl => self, npl => self%nbody) call pl%accel_int(param) if (param%loblatecb) then - call pl%accel_obl(system) + call pl%accel_obl(nbody_system) if (lbeg) then cb%aoblbeg = cb%aobl else @@ -39,7 +39,7 @@ module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) end if ! TODO: Implement tides ! if (param%ltides) then - ! call pl%accel_tides(system) + ! call pl%accel_tides(nbody_system) ! if (lbeg) then ! cb%atidebeg = cb%atide ! else @@ -47,7 +47,7 @@ module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) ! end if ! end if end if - if (param%lextra_force) call pl%accel_user(system, param, t, lbeg) + if (param%lextra_force) call pl%accel_user(nbody_system, param, t, lbeg) if (param%lgr) call pl%accel_gr(param) end associate @@ -55,7 +55,7 @@ module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) end subroutine helio_kick_getacch_pl - module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine helio_kick_getacch_tp(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of test particles @@ -65,22 +65,22 @@ module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) implicit none ! Arguments class(helio_tp), intent(inout) :: self !! Helio test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step if (self%nbody == 0) return - associate(tp => self, cb => system%cb, pl => system%pl, npl => system%pl%nbody) - system%lbeg = lbeg - if (system%lbeg) then + associate(tp => self, cb => nbody_system%cb, pl => nbody_system%pl, npl => nbody_system%pl%nbody) + nbody_system%lbeg = lbeg + if (nbody_system%lbeg) then call tp%accel_int(param, pl%Gmass(1:npl), pl%rbeg(:,1:npl), npl) else call tp%accel_int(param, pl%Gmass(1:npl), pl%rend(:,1:npl), npl) end if - if (param%loblatecb) call tp%accel_obl(system) - if (param%lextra_force) call tp%accel_user(system, param, t, lbeg) + if (param%loblatecb) call tp%accel_obl(nbody_system) + if (param%lextra_force) call tp%accel_user(nbody_system, param, t, lbeg) if (param%lgr) call tp%accel_gr(param) end associate @@ -88,7 +88,7 @@ module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) end subroutine helio_kick_getacch_tp - module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) + module subroutine helio_kick_vb_pl(self, nbody_system, param, t, dt, lbeg) !! author: David A. Minton !! !! Kick barycentric velocities of bodies @@ -98,7 +98,7 @@ module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) implicit none ! Arguments class(helio_pl), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -110,7 +110,7 @@ module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) associate(pl => self, npl => self%nbody) pl%ah(:, 1:npl) = 0.0_DP - call pl%accel(system, param, t, lbeg) + call pl%accel(nbody_system, param, t, lbeg) if (lbeg) then call pl%set_beg_end(rbeg = pl%rh) else @@ -127,7 +127,7 @@ module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) end subroutine helio_kick_vb_pl - module subroutine helio_kick_vb_tp(self, system, param, t, dt, lbeg) + module subroutine helio_kick_vb_tp(self, nbody_system, param, t, dt, lbeg) !! author: David A. Minton !! !! Kick barycentric velocities of bodies @@ -137,7 +137,7 @@ module subroutine helio_kick_vb_tp(self, system, param, t, dt, lbeg) implicit none ! Arguments class(helio_tp), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -149,7 +149,7 @@ module subroutine helio_kick_vb_tp(self, system, param, t, dt, lbeg) associate(tp => self, ntp => self%nbody) tp%ah(:, 1:ntp) = 0.0_DP - call tp%accel(system, param, t, lbeg) + call tp%accel(nbody_system, param, t, lbeg) do concurrent(i = 1:ntp, tp%lmask(i)) tp%vb(:, i) = tp%vb(:, i) + tp%ah(:, i) * dt end do diff --git a/src/helio/helio_module.f90 b/src/helio/helio_module.f90 index c33583529..b8d9d8b26 100644 --- a/src/helio/helio_module.f90 +++ b/src/helio/helio_module.f90 @@ -22,7 +22,7 @@ module helio contains procedure :: step => helio_step_system !! Advance the Helio nbody system forward in time by one step procedure :: initialize => helio_setup_initialize_system !! Performs Helio-specific initilization steps, including converting to DH coordinates - final :: helio_final_system !! Finalizes the Helio system object - deallocates all allocatables + final :: helio_final_system !! Finalizes the Helio nbody_system object - deallocates all allocatables end type helio_nbody_system @@ -62,26 +62,26 @@ module helio end type helio_tp interface - module subroutine helio_drift_body(self, system, param, dt) + module subroutine helio_drift_body(self, nbody_system, param, dt) implicit none class(swiftest_body), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize end subroutine helio_drift_body - module subroutine helio_drift_pl(self, system, param, dt) + module subroutine helio_drift_pl(self, nbody_system, param, dt) implicit none class(helio_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize end subroutine helio_drift_pl - module subroutine helio_drift_tp(self, system, param, dt) + module subroutine helio_drift_tp(self, nbody_system, param, dt) implicit none class(helio_tp), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize end subroutine helio_drift_tp @@ -114,54 +114,54 @@ pure module subroutine helio_gr_kick_getacch_tp(self, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine helio_gr_kick_getacch_tp - pure module subroutine helio_gr_p4_pl(self, system, param, dt) + pure module subroutine helio_gr_p4_pl(self, nbody_system, param, dt) implicit none class(helio_pl), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size end subroutine helio_gr_p4_pl - pure module subroutine helio_gr_p4_tp(self, system, param, dt) + pure module subroutine helio_gr_p4_tp(self, nbody_system, param, dt) implicit none class(helio_tp), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size end subroutine helio_gr_p4_tp - module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) + module subroutine helio_kick_getacch_pl(self, nbody_system, param, t, lbeg) implicit none class(helio_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine helio_kick_getacch_pl - module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine helio_kick_getacch_tp(self, nbody_system, param, t, lbeg) implicit none class(helio_tp), intent(inout) :: self !! Helio test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine helio_kick_getacch_tp - module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) + module subroutine helio_kick_vb_pl(self, nbody_system, param, t, dt, lbeg) implicit none class(helio_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. end subroutine helio_kick_vb_pl - module subroutine helio_kick_vb_tp(self, system, param, t, dt, lbeg) + module subroutine helio_kick_vb_tp(self, nbody_system, param, t, dt, lbeg) implicit none class(helio_tp), intent(inout) :: self !! Helio test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -174,10 +174,10 @@ module subroutine helio_setup_initialize_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine helio_setup_initialize_system - module subroutine helio_step_pl(self, system, param, t, dt) + module subroutine helio_step_pl(self, nbody_system, param, t, dt) implicit none class(helio_pl), intent(inout) :: self !! Helio massive body particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Stepsize @@ -191,10 +191,10 @@ module subroutine helio_step_system(self, param, t, dt) real(DP), intent(in) :: dt !! Current stepsize end subroutine helio_step_system - module subroutine helio_step_tp(self, system, param, t, dt) + module subroutine helio_step_tp(self, nbody_system, param, t, dt) implicit none class(helio_tp), intent(inout) :: self !! Helio test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Stepsizee diff --git a/src/helio/helio_step.f90 b/src/helio/helio_step.f90 index ddcfe0bd5..dd2463246 100644 --- a/src/helio/helio_step.f90 +++ b/src/helio/helio_step.f90 @@ -16,7 +16,7 @@ module subroutine helio_step_system(self, param, t, dt) !! !! Step massive bodies and and active test particles ahead in heliocentric coordinates. !! - !! Currently there's no difference between this and the WHM system stepper, so this is just + !! Currently there's no difference between this and the WHM nbody_system stepper, so this is just !! a wrapper function to keep the method calls consistent for inherited types. !! !! Adapted from Hal Levison's Swift routine step_kdk.f @@ -34,7 +34,7 @@ module subroutine helio_step_system(self, param, t, dt) end subroutine helio_step_system - module subroutine helio_step_pl(self, system, param, t, dt) + module subroutine helio_step_pl(self, nbody_system, param, t, dt) !! author: David A. Minton !! !! Step massive bodies ahead Democratic Heliocentric method @@ -44,7 +44,7 @@ module subroutine helio_step_pl(self, system, param, t, dt) implicit none ! Arguments class(helio_pl), intent(inout) :: self !! Helio massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Stepsize @@ -54,7 +54,7 @@ module subroutine helio_step_pl(self, system, param, t, dt) if (self%nbody == 0) return associate(pl => self) - select type(cb => system%cb) + select type(cb => nbody_system%cb) class is (helio_cb) dth = 0.5_DP * dt if (pl%lfirst) then @@ -62,11 +62,11 @@ module subroutine helio_step_pl(self, system, param, t, dt) pl%lfirst = .false. end if call pl%lindrift(cb, dth, lbeg=.true.) - call pl%kick(system, param, t, dth, lbeg=.true.) - if (param%lgr) call pl%gr_pos_kick(system, param, dth) - call pl%drift(system, param, dt) - if (param%lgr) call pl%gr_pos_kick(system, param, dth) - call pl%kick(system, param, t + dt, dth, lbeg=.false.) + call pl%kick(nbody_system, param, t, dth, lbeg=.true.) + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) + call pl%drift(nbody_system, param, dt) + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) + call pl%kick(nbody_system, param, t + dt, dth, lbeg=.false.) call pl%lindrift(cb, dth, lbeg=.false.) call pl%vb2vh(cb) end select @@ -76,7 +76,7 @@ module subroutine helio_step_pl(self, system, param, t, dt) end subroutine helio_step_pl - module subroutine helio_step_tp(self, system, param, t, dt) + module subroutine helio_step_tp(self, nbody_system, param, t, dt) !! author: David A. Minton !! @@ -87,7 +87,7 @@ module subroutine helio_step_tp(self, system, param, t, dt) implicit none ! Arguments class(helio_tp), intent(inout) :: self !! Helio test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Stepsize @@ -97,7 +97,7 @@ module subroutine helio_step_tp(self, system, param, t, dt) if (self%nbody == 0) return associate(tp => self) - select type(cb => system%cb) + select type(cb => nbody_system%cb) class is (helio_cb) dth = 0.5_DP * dt if (tp%lfirst) then @@ -105,11 +105,11 @@ module subroutine helio_step_tp(self, system, param, t, dt) tp%lfirst = .false. end if call tp%lindrift(cb, dth, lbeg=.true.) - call tp%kick(system, param, t, dth, lbeg=.true.) - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%drift(system, param, dt) - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%kick(system, param, t + dt, dth, lbeg=.false.) + call tp%kick(nbody_system, param, t, dth, lbeg=.true.) + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%drift(nbody_system, param, dt) + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%kick(nbody_system, param, t + dt, dth, lbeg=.false.) call tp%lindrift(cb, dth, lbeg=.false.) call tp%vb2vh(vbcb = -cb%ptend) end select diff --git a/src/misc/minimizer_module.f90 b/src/misc/minimizer_module.f90 index 0e4c37ede..a52fe2b00 100644 --- a/src/misc/minimizer_module.f90 +++ b/src/misc/minimizer_module.f90 @@ -542,7 +542,7 @@ subroutine quadfit(f, x0, S, N, eps, lo, hi, lerr) hi = astar exit end if - ! Set up system for gaussian elimination equation solver + ! Set up nbody_system for gaussian elimination equation solver row_1 = [1.0_DP, a1, a1**2] row_2 = [1.0_DP, a2, a2**2] row_3 = [1.0_DP, a3, a3**2] @@ -550,7 +550,7 @@ subroutine quadfit(f, x0, S, N, eps, lo, hi, lerr) lhs(1, :) = row_1 lhs(2, :) = row_2 lhs(3, :) = row_3 - ! Solve system of equations + ! Solve nbody_system of equations soln(:) = solve_linear_system(lhs, rhs, 3, lerr) call ieee_set_flag(ieee_all, .false.) ! Set all flags back to quiet call ieee_set_halting_mode(ieee_divide_by_zero, .false.) diff --git a/src/misc/solver_module.f90 b/src/misc/solver_module.f90 index f71ca46bb..6462fa57c 100644 --- a/src/misc/solver_module.f90 +++ b/src/misc/solver_module.f90 @@ -44,7 +44,7 @@ function solve_linear_system_dp(A,b,n,lerr) result(x) !! Solves the linear equation of the form A*x = b for x. !! A is an (n,n) arrays !! x and b are (n) arrays - !! Uses Gaussian elimination, so will have issues if system is ill-conditioned. + !! Uses Gaussian elimination, so will have issues if nbody_system is ill-conditioned. !! Uses quad precision intermidiate values, so works best on small arrays. implicit none ! Arguments @@ -84,7 +84,7 @@ function solve_linear_system_qp(A,b,n,lerr) result(x) !! Solves the linear equation of the form A*x = b for x. !! A is an (n,n) arrays !! x and b are (n) arrays - !! Uses Gaussian elimination, so will have issues if system is ill-conditioned. + !! Uses Gaussian elimination, so will have issues if nbody_system is ill-conditioned. !! Uses quad precision intermidiate values, so works best on small arrays. implicit none ! Arguments diff --git a/src/netcdf_io/netcdf_io_module.f90 b/src/netcdf_io/netcdf_io_module.f90 index cea8ca147..7199451b0 100644 --- a/src/netcdf_io/netcdf_io_module.f90 +++ b/src/netcdf_io/netcdf_io_module.f90 @@ -96,24 +96,24 @@ module netcdf_io integer(I4B) :: k2_varid !! ID for the Love number variable character(NAMELEN) :: q_varname = "Q" !! name of the energy dissipation variable integer(I4B) :: Q_varid !! ID for the energy dissipation variable - character(NAMELEN) :: ke_orb_varname = "KE_orb" !! name of the system orbital kinetic energy variable - integer(I4B) :: KE_orb_varid !! ID for the system orbital kinetic energy variable - character(NAMELEN) :: ke_spin_varname = "KE_spin" !! name of the system spin kinetic energy variable - integer(I4B) :: KE_spin_varid !! ID for the system spin kinetic energy variable - character(NAMELEN) :: pe_varname = "PE" !! name of the system potential energy variable - integer(I4B) :: PE_varid !! ID for the system potential energy variable + character(NAMELEN) :: ke_orb_varname = "KE_orb" !! name of the nbody_system orbital kinetic energy variable + integer(I4B) :: KE_orb_varid !! ID for the nbody_system orbital kinetic energy variable + character(NAMELEN) :: ke_spin_varname = "KE_spin" !! name of the nbody_system spin kinetic energy variable + integer(I4B) :: KE_spin_varid !! ID for the nbody_system spin kinetic energy variable + character(NAMELEN) :: pe_varname = "PE" !! name of the nbody_system potential energy variable + integer(I4B) :: PE_varid !! ID for the nbody_system potential energy variable character(NAMELEN) :: L_orb_varname = "L_orb" !! name of the orbital angular momentum vector variable - integer(I4B) :: L_orb_varid !! ID for the system orbital angular momentum vector variable + integer(I4B) :: L_orb_varid !! ID for the nbody_system orbital angular momentum vector variable character(NAMELEN) :: Lspin_varname = "Lspin" !! name of the spin angular momentum vector variable - integer(I4B) :: Lspin_varid !! ID for the system spin angular momentum vector variable + integer(I4B) :: Lspin_varid !! ID for the nbody_system spin angular momentum vector variable character(NAMELEN) :: L_escape_varname = "L_escape" !! name of the escaped angular momentum vector variable integer(I4B) :: L_escape_varid !! ID for the escaped angular momentum vector variable character(NAMELEN) :: Ecollisions_varname = "Ecollisions" !! name of the escaped angular momentum y variable integer(I4B) :: Ecollisions_varid !! ID for the energy lost in collisions variable character(NAMELEN) :: Euntracked_varname = "Euntracked" !! name of the energy that is untracked due to loss (untracked potential energy due to mergers and body energy for escaped bodies) integer(I4B) :: Euntracked_varid !! ID for the energy that is untracked due to loss (untracked potential energy due to mergers and body energy for escaped bodies) - character(NAMELEN) :: GMescape_varname = "GMescape" !! name of the G*Mass of bodies that escape the system - integer(I4B) :: GMescape_varid !! ID for the G*Mass of bodies that escape the system + character(NAMELEN) :: GMescape_varname = "GMescape" !! name of the G*Mass of bodies that escape the nbody_system + integer(I4B) :: GMescape_varid !! ID for the G*Mass of bodies that escape the nbody_system character(NAMELEN) :: origin_type_varname = "origin_type" !! name of the origin type variable (Initial Conditions, Disruption, etc.) integer(I4B) :: origin_type_varid !! ID for the origin type character(NAMELEN) :: origin_time_varname = "origin_time" !! name of the time of origin variable diff --git a/src/rmvs/rmvs_discard.f90 b/src/rmvs/rmvs_discard.f90 index 0c7e6230e..5a8fd94f5 100644 --- a/src/rmvs/rmvs_discard.f90 +++ b/src/rmvs/rmvs_discard.f90 @@ -11,7 +11,7 @@ use swiftest contains - module subroutine rmvs_discard_tp(self, system, param) + module subroutine rmvs_discard_tp(self, nbody_system, param) !! author: David A. Minton !! !! Check to see if test particles should be discarded based on pericenter passage distances with respect to planets encountered @@ -21,7 +21,7 @@ module subroutine rmvs_discard_tp(self, system, param) implicit none ! Arguments class(rmvs_tp), intent(inout) :: self !! RMVS test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i @@ -29,7 +29,7 @@ module subroutine rmvs_discard_tp(self, system, param) if (self%nbody == 0) return - associate(tp => self, ntp => self%nbody, pl => system%pl, t => system%t) + associate(tp => self, ntp => self%nbody, pl => nbody_system%pl, t => nbody_system%t) do i = 1, ntp associate(iplperP => tp%plperP(i)) if ((tp%status(i) == ACTIVE) .and. (tp%lperi(i))) then @@ -50,7 +50,7 @@ module subroutine rmvs_discard_tp(self, system, param) end associate end do ! Call the base method that this overrides - call swiftest_discard_tp(tp, system, param) + call swiftest_discard_tp(tp, nbody_system, param) end associate end subroutine rmvs_discard_tp diff --git a/src/rmvs/rmvs_encounter_check.f90 b/src/rmvs/rmvs_encounter_check.f90 index 664821272..68e052a6f 100644 --- a/src/rmvs/rmvs_encounter_check.f90 +++ b/src/rmvs/rmvs_encounter_check.f90 @@ -11,7 +11,7 @@ use swiftest contains - module function rmvs_encounter_check_tp(self, param, system, dt) result(lencounter) + module function rmvs_encounter_check_tp(self, param, nbody_system, dt) result(lencounter) !! author: David A. Minton !! !! Determine whether a test particle and planet are having or will have an encounter within the next time step @@ -22,7 +22,7 @@ module function rmvs_encounter_check_tp(self, param, system, dt) result(lencount ! Arguments class(rmvs_tp), intent(inout) :: self !! RMVS test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(rmvs_nbody_system), intent(inout) :: system !! RMVS nbody system object + class(rmvs_nbody_system), intent(inout) :: nbody_system !! RMVS nbody system object real(DP), intent(in) :: dt !! step size ! Result logical :: lencounter !! Returns true if there is at least one close encounter @@ -38,7 +38,7 @@ module function rmvs_encounter_check_tp(self, param, system, dt) result(lencount lencounter = .false. if (self%nbody == 0) return - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (rmvs_pl) associate(tp => self, ntp => self%nbody, npl => pl%nbody) tp%plencP(1:ntp) = 0 diff --git a/src/rmvs/rmvs_kick.f90 b/src/rmvs/rmvs_kick.f90 index 2f36bbb81..7d113f863 100644 --- a/src/rmvs/rmvs_kick.f90 +++ b/src/rmvs/rmvs_kick.f90 @@ -11,7 +11,7 @@ use swiftest contains - module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine rmvs_kick_getacch_tp(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute the oblateness acceleration in the inner encounter region with planets @@ -21,7 +21,7 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) implicit none ! Arguments class(rmvs_tp), intent(inout) :: self !! RMVS test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest central body particle data structuree + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest central body particle data structuree class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step @@ -34,15 +34,15 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) if (self%nbody == 0) return associate(tp => self, ntp => self%nbody, ipleP => self%ipleP, inner_index => self%index) - select type(system) + select type(nbody_system) class is (rmvs_nbody_system) - if (system%lplanetocentric) then ! This is a close encounter step, so any accelerations requiring heliocentric position values + if (nbody_system%lplanetocentric) then ! This is a close encounter step, so any accelerations requiring heliocentric position values ! must be handeled outside the normal WHM method call - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (rmvs_pl) - select type (cb => system%cb) + select type (cb => nbody_system%cb) class is (rmvs_cb) - associate(xpc => pl%rh, xpct => self%rh, apct => self%ah, system_planetocen => system) + associate(xpc => pl%rh, xpct => self%rh, apct => self%ah, system_planetocen => nbody_system) system_planetocen%lbeg = lbeg ! Save the original heliocentric position for later @@ -88,7 +88,7 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) end select end select else ! Not a close encounter, so just proceded with the standard WHM method - call whm_kick_getacch_tp(tp, system, param, t, lbeg) + call whm_kick_getacch_tp(tp, nbody_system, param, t, lbeg) end if end select end associate diff --git a/src/rmvs/rmvs_module.f90 b/src/rmvs/rmvs_module.f90 index e6d3c7553..51e824b8d 100644 --- a/src/rmvs/rmvs_module.f90 +++ b/src/rmvs/rmvs_module.f90 @@ -44,7 +44,7 @@ module rmvs real(DP), dimension(:, :), allocatable :: atide !! Encountering planet's tidal acceleration value contains procedure :: dealloc => rmvs_util_dealloc_interp !! Deallocates all allocatable arrays - final :: rmvs_final_interp !! Finalizes the RMVS interpolated system variables object - deallocates all allocatables + final :: rmvs_final_interp !! Finalizes the RMVS interpolated nbody_system variables object - deallocates all allocatables end type rmvs_interp @@ -113,26 +113,26 @@ module rmvs end type rmvs_pl interface - module subroutine rmvs_discard_tp(self, system, param) + module subroutine rmvs_discard_tp(self, nbody_system, param) implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine rmvs_discard_tp - module function rmvs_encounter_check_tp(self, param, system, dt) result(lencounter) + module function rmvs_encounter_check_tp(self, param, nbody_system, dt) result(lencounter) implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(rmvs_nbody_system), intent(inout) :: system !! RMVS nbody system object + class(rmvs_nbody_system), intent(inout) :: nbody_system !! RMVS nbody system object real(DP), intent(in) :: dt !! step size logical :: lencounter !! Returns true if there is at least one close encounter end function rmvs_encounter_check_tp - module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine rmvs_kick_getacch_tp(self, nbody_system, param, t, lbeg) implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest central body particle data structuree + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest central body particle data structuree class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step @@ -179,7 +179,7 @@ end subroutine rmvs_util_dealloc_cb module subroutine rmvs_util_dealloc_interp(self) implicit none - class(rmvs_interp), intent(inout) :: self !! RMVS interpolated system variables object + class(rmvs_interp), intent(inout) :: self !! RMVS interpolated nbody_system variables object end subroutine rmvs_util_dealloc_interp module subroutine rmvs_util_dealloc_pl(self) @@ -213,7 +213,7 @@ end subroutine rmvs_final_cb module subroutine rmvs_final_interp(self) implicit none - type(rmvs_interp), intent(inout) :: self !! RMVS interpolated system variables object + type(rmvs_interp), intent(inout) :: self !! RMVS interpolated nbody_system variables object end subroutine rmvs_final_interp module subroutine rmvs_final_pl(self) diff --git a/src/rmvs/rmvs_setup.f90 b/src/rmvs/rmvs_setup.f90 index cc8f8839c..fe7d15b6d 100644 --- a/src/rmvs/rmvs_setup.f90 +++ b/src/rmvs/rmvs_setup.f90 @@ -70,7 +70,7 @@ module subroutine rmvs_setup_initialize_system(self, param) !! We currently rearrange the pl order to keep it consistent with the way Swifter does it !! In Swifter, the central body occupies the first position in the pl list, and during !! encounters, the encountering planet is skipped in loops. In Swiftest, we instantiate an - !! RMVS nbody system object attached to each pl to store planetocentric versions of the system + !! RMVS nbody system object attached to each pl to store planetocentric versions of the nbody_system !! to use during close encounters. implicit none ! Arguments diff --git a/src/rmvs/rmvs_step.f90 b/src/rmvs/rmvs_step.f90 index 7c602a20b..1bc313336 100644 --- a/src/rmvs/rmvs_step.f90 +++ b/src/rmvs/rmvs_step.f90 @@ -37,32 +37,32 @@ module subroutine rmvs_step_system(self, param, t, dt) class is (rmvs_pl) select type(tp => self%tp) class is (rmvs_tp) - associate(system => self, ntp => tp%nbody, npl => pl%nbody) + associate(nbody_system => self, ntp => tp%nbody, npl => pl%nbody) allocate(rbeg, source=pl%rh) allocate(vbeg, source=pl%vh) call pl%set_beg_end(rbeg = rbeg, vbeg = vbeg) ! ****** Check for close encounters ***** ! call pl%set_renc(RHSCALE) - lencounter = tp%encounter_check(param, system, dt) + lencounter = tp%encounter_check(param, nbody_system, dt) if (lencounter) then lfirstpl = pl%lfirst pl%outer(0)%x(:, 1:npl) = rbeg(:, 1:npl) pl%outer(0)%v(:, 1:npl) = vbeg(:, 1:npl) - call pl%step(system, param, t, dt) + call pl%step(nbody_system, param, t, dt) pl%outer(NTENC)%x(:, 1:npl) = pl%rh(:, 1:npl) pl%outer(NTENC)%v(:, 1:npl) = pl%vh(:, 1:npl) call rmvs_interp_out(cb, pl, dt) - call rmvs_step_out(cb, pl, tp, system, param, t, dt) + call rmvs_step_out(cb, pl, tp, nbody_system, param, t, dt) tp%lmask(1:ntp) = .not. tp%lmask(1:ntp) call pl%set_beg_end(rbeg = rbeg, rend = rend) tp%lfirst = .true. - call tp%step(system, param, t, dt) + call tp%step(nbody_system, param, t, dt) tp%lmask(1:ntp) = .true. pl%lfirst = lfirstpl tp%lfirst = .true. - ! if (param%ltides) call system%step_spin(param, t, dt) + ! if (param%ltides) call nbody_system%step_spin(param, t, dt) else - call whm_step_system(system, param, t, dt) + call whm_step_system(nbody_system, param, t, dt) end if end associate end select @@ -153,7 +153,7 @@ subroutine rmvs_interp_out(cb, pl, dt) end subroutine rmvs_interp_out - subroutine rmvs_step_out(cb, pl, tp, system, param, t, dt) + subroutine rmvs_step_out(cb, pl, tp, nbody_system, param, t, dt) !! author: David A. Minton !! !! Step ACTIVE test particles ahead in the outer encounter region, setting up and calling the inner region @@ -166,7 +166,7 @@ subroutine rmvs_step_out(cb, pl, tp, system, param, t, dt) class(rmvs_cb), intent(inout) :: cb !! RMVS central body object class(rmvs_pl), intent(inout) :: pl !! RMVS massive body object class(rmvs_tp), intent(inout) :: tp !! RMVS test particle object - class(rmvs_nbody_system), intent(inout) :: system !! RMVS nbody system object + class(rmvs_nbody_system), intent(inout) :: nbody_system !! RMVS nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current stepsiz @@ -188,18 +188,18 @@ subroutine rmvs_step_out(cb, pl, tp, system, param, t, dt) call pl%set_beg_end(rbeg = pl%outer(outer_index - 1)%x(:, 1:npl), & vbeg = pl%outer(outer_index - 1)%v(:, 1:npl), & rend = pl%outer(outer_index )%x(:, 1:npl)) - lencounter = tp%encounter_check(param, system, dto) + lencounter = tp%encounter_check(param, nbody_system, dto) if (lencounter) then ! Interpolate planets in inner encounter region - call rmvs_interp_in(cb, pl, system, param, dto, outer_index) + call rmvs_interp_in(cb, pl, nbody_system, param, dto, outer_index) ! Step through the inner region call rmvs_step_in(cb, pl, tp, param, outer_time, dto) lfirsttp = tp%lfirst tp%lfirst = .true. - call tp%step(system, param, outer_time, dto) + call tp%step(nbody_system, param, outer_time, dto) tp%lfirst = lfirsttp else - call tp%step(system, param, outer_time, dto) + call tp%step(nbody_system, param, outer_time, dto) end if do j = 1, npl if (pl%nenc(j) == 0) cycle @@ -215,7 +215,7 @@ subroutine rmvs_step_out(cb, pl, tp, system, param, t, dt) end subroutine rmvs_step_out - subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) + subroutine rmvs_interp_in(cb, pl, nbody_system, param, dt, outer_index) !! author: David A. Minton !! !! Interpolate planet positions between two Keplerian orbits in inner encounter regio @@ -227,7 +227,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) ! Arguments class(rmvs_cb), intent(inout) :: cb !! RMVS cenral body object class(rmvs_pl), intent(inout) :: pl !! RMVS massive body object - class(rmvs_nbody_system), intent(inout) :: system !! RMVS nbody system object + class(rmvs_nbody_system), intent(inout) :: nbody_system !! RMVS nbody system object class(swiftest_parameters), intent(in) :: param !! Swiftest parameters file real(DP), intent(in) :: dt !! Step size integer(I4B), intent(in) :: outer_index !! Outer substep number within current set @@ -238,7 +238,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) real(DP), dimension(:), allocatable :: GMcb, dti integer(I4B), dimension(:), allocatable :: iflag - associate (npl => system%pl%nbody) + associate (npl => nbody_system%pl%nbody) dntphenc = real(NTPHENC, kind=DP) ! Set the endpoints of the inner region from the outer region values in the current outer step index @@ -263,12 +263,12 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) pl%rh(:, 1:npl) = xtmp(:, 1:npl) ! Temporarily replace heliocentric position with inner substep values to calculate the oblateness terms end if if (param%loblatecb) then - call pl%accel_obl(system) + call pl%accel_obl(nbody_system) pl%inner(0)%aobl(:, 1:npl) = pl%aobl(:, 1:npl) ! Save the oblateness acceleration on the planet for this substep end if ! TODO: Implement tides ! if (param%ltides) then - ! call pl%accel_tides(system) + ! call pl%accel_tides(nbody_system) ! pl%inner(0)%atide(:, 1:npl) = pl%atide(:, 1:npl) ! Save the oblateness acceleration on the planet for this substep ! end if @@ -318,24 +318,24 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) if (param%loblatecb) then pl%rh(:,1:npl) = pl%inner(inner_index)%x(:, 1:npl) - call pl%accel_obl(system) + call pl%accel_obl(nbody_system) pl%inner(inner_index)%aobl(:, 1:npl) = pl%aobl(:, 1:npl) end if ! TODO: Implement tides ! if (param%ltides) then - ! call pl%accel_tides(system) + ! call pl%accel_tides(nbody_system) ! pl%inner(inner_index)%atide(:, 1:npl) = pl%atide(:, 1:npl) ! end if end do if (param%loblatecb) then ! Calculate the final value of oblateness accelerations at the final inner substep pl%rh(:, 1:npl) = pl%inner(NTPHENC)%x(:, 1:npl) - call pl%accel_obl(system) + call pl%accel_obl(nbody_system) pl%inner(NTPHENC)%aobl(:, 1:npl) = pl%aobl(:, 1:npl) end if ! TODO: Implement tides ! if (param%ltides) then - ! call pl%accel_tides(system) + ! call pl%accel_tides(nbody_system) ! pl%inner(NTPHENC)%atide(:, 1:npl) = pl%atide(:, 1:npl) ! end if ! Put the planet positions and accelerations back into place diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index 79e36e40b..26306f064 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -96,7 +96,7 @@ module subroutine rmvs_util_dealloc_interp(self) !! Deallocates all allocatabale arrays implicit none ! Argument - class(rmvs_interp), intent(inout) :: self !! RMVS interpolated system variables object + class(rmvs_interp), intent(inout) :: self !! RMVS interpolated nbody_system variables object if (allocated(self%x)) deallocate(self%x) if (allocated(self%v)) deallocate(self%v) diff --git a/src/swiftest/swiftest_discard.f90 b/src/swiftest/swiftest_discard.f90 index a3d5d861d..5f2f5d331 100644 --- a/src/swiftest/swiftest_discard.f90 +++ b/src/swiftest/swiftest_discard.f90 @@ -17,7 +17,7 @@ module subroutine swiftest_discard_system(self, param) !! implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals logical :: lpl_discards, ltp_discards, lpl_check, ltp_check @@ -25,16 +25,16 @@ module subroutine swiftest_discard_system(self, param) lpl_check = allocated(self%pl_discards) ltp_check = allocated(self%tp_discards) - associate(system => self, tp => self%tp, pl => self%pl, tp_discards => self%tp_discards, pl_discards => self%pl_discards) + associate(nbody_system => self, tp => self%tp, pl => self%pl, tp_discards => self%tp_discards, pl_discards => self%pl_discards) lpl_discards = .false. ltp_discards = .false. if (lpl_check) then - call pl%discard(system, param) + call pl%discard(nbody_system, param) lpl_discards = (pl_discards%nbody > 0) end if if (ltp_check) then - call tp%discard(system, param) + call tp%discard(nbody_system, param) ltp_discards = (tp_discards%nbody > 0) end if if (ltp_discards) call tp_discards%write_info(param%system_history%nc, param) @@ -49,7 +49,7 @@ module subroutine swiftest_discard_system(self, param) end subroutine swiftest_discard_system - module subroutine swiftest_discard_pl(self, system, param) + module subroutine swiftest_discard_pl(self, nbody_system, param) !! author: David A. Minton !! !! Placeholder method for discarding massive bodies. This method does nothing except to ensure that the discard flag is set to false. @@ -57,7 +57,7 @@ module subroutine swiftest_discard_pl(self, system, param) implicit none ! Arguments class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameter if (self%nbody == 0) return @@ -67,7 +67,7 @@ module subroutine swiftest_discard_pl(self, system, param) end subroutine swiftest_discard_pl - module subroutine swiftest_discard_tp(self, system, param) + module subroutine swiftest_discard_tp(self, nbody_system, param) !! author: David A. Minton !! !! Check to see if particles should be discarded based on their positions relative to the massive bodies @@ -77,13 +77,13 @@ module subroutine swiftest_discard_tp(self, system, param) implicit none ! Arguments class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameter ! Internals logical, dimension(:), allocatable :: ldiscard integer(I4B) :: npl, ntp - associate(tp => self, cb => system%cb, pl => system%pl) + associate(tp => self, cb => nbody_system%cb, pl => nbody_system%pl) ntp = tp%nbody npl = pl%nbody @@ -93,12 +93,12 @@ module subroutine swiftest_discard_tp(self, system, param) call tp%h2b(cb) end if - if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. (param%rmaxu >= 0.0_DP)) call swiftest_discard_cb_tp(tp, system, param) - if (param%qmin >= 0.0_DP) call swiftest_discard_peri_tp(tp, system, param) - if (param%lclose) call swiftest_discard_pl_tp(tp, system, param) + if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. (param%rmaxu >= 0.0_DP)) call swiftest_discard_cb_tp(tp, nbody_system, param) + if (param%qmin >= 0.0_DP) call swiftest_discard_peri_tp(tp, nbody_system, param) + if (param%lclose) call swiftest_discard_pl_tp(tp, nbody_system, param) if (any(tp%ldiscard(1:ntp))) then allocate(ldiscard, source=tp%ldiscard) - call tp%spill(system%tp_discards, ldiscard(1:ntp), ldestructive=.true.) + call tp%spill(nbody_system%tp_discards, ldiscard(1:ntp), ldestructive=.true.) end if end associate @@ -106,25 +106,25 @@ module subroutine swiftest_discard_tp(self, system, param) end subroutine swiftest_discard_tp - subroutine swiftest_discard_cb_tp(tp, system, param) + subroutine swiftest_discard_cb_tp(tp, nbody_system, param) !! author: David A. Minton !! !! Check to see if test particles should be discarded based on their positions relative to the Sun - !! or because they are unbound from the system + !! or because they are unbound from the nbody_system !! !! Adapted from David E. Kaufmann's Swifter routine: discard_sun.f90 !! Adapted from Hal Levison's Swift routine discard_sun.f implicit none ! Arguments class(swiftest_tp), intent(inout) :: tp !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i real(DP) :: energy, vb2, rb2, rh2, rmin2, rmax2, rmaxu2 character(len=STRMAX) :: idstr, timestr - associate(ntp => tp%nbody, cb => system%cb, Gmtot => system%Gmtot) + associate(ntp => tp%nbody, cb => nbody_system%cb, Gmtot => nbody_system%Gmtot) rmin2 = max(param%rmin * param%rmin, cb%radius * cb%radius) rmax2 = param%rmax**2 rmaxu2 = param%rmaxu**2 @@ -134,22 +134,22 @@ subroutine swiftest_discard_cb_tp(tp, system, param) if ((param%rmax >= 0.0_DP) .and. (rh2 > rmax2)) then tp%status(i) = DISCARDED_RMAX write(idstr, *) tp%id(i) - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(*, *) "Particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too far from the central body at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. tp%lmask(i) = .false. - call tp%info(i)%set_value(status="DISCARDED_RMAX", discard_time=system%t, discard_rh=tp%rh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_RMAX", discard_time=nbody_system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i)) else if ((param%rmin >= 0.0_DP) .and. (rh2 < rmin2)) then tp%status(i) = DISCARDED_RMIN write(idstr, *) tp%id(i) - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(*, *) "Particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too close to the central body at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. tp%lmask(i) = .false. - call tp%info(i)%set_value(status="DISCARDED_RMIN", discard_time=system%t, discard_rh=tp%rh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_RMIN", discard_time=nbody_system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i), discard_body_id=cb%id) else if (param%rmaxu >= 0.0_DP) then rb2 = dot_product(tp%rb(:, i), tp%rb(:, i)) @@ -158,12 +158,12 @@ subroutine swiftest_discard_cb_tp(tp, system, param) if ((energy > 0.0_DP) .and. (rb2 > rmaxu2)) then tp%status(i) = DISCARDED_RMAXU write(idstr, *) tp%id(i) - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(*, *) "Particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " is unbound and too far from barycenter at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. tp%lmask(i) = .false. - call tp%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=system%t, discard_rh=tp%rh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=nbody_system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i)) end if end if @@ -175,7 +175,7 @@ subroutine swiftest_discard_cb_tp(tp, system, param) end subroutine swiftest_discard_cb_tp - subroutine swiftest_discard_peri_tp(tp, system, param) + subroutine swiftest_discard_peri_tp(tp, nbody_system, param) !! author: David A. Minton !! !! Check to see if a test particle should be discarded because its perihelion distance becomes too small @@ -185,7 +185,7 @@ subroutine swiftest_discard_peri_tp(tp, system, param) implicit none ! Arguments class(swiftest_tp), intent(inout) :: tp !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameterss ! Internals integer(I4B) :: i, j, ih @@ -193,8 +193,8 @@ subroutine swiftest_discard_peri_tp(tp, system, param) real(DP), dimension(NDIM) :: dx character(len=STRMAX) :: idstr, timestr - associate(cb => system%cb, ntp => tp%nbody, pl => system%pl, npl => system%pl%nbody, t => system%t) - call tp%get_peri(system, param) + associate(cb => nbody_system%cb, ntp => tp%nbody, pl => nbody_system%pl, npl => nbody_system%pl%nbody, t => nbody_system%t) + call tp%get_peri(nbody_system, param) do i = 1, ntp if (tp%status(i) == ACTIVE) then if (tp%isperi(i) == 0) then @@ -210,11 +210,11 @@ subroutine swiftest_discard_peri_tp(tp, system, param) (tp%peri(i) <= param%qmin)) then tp%status(i) = DISCARDED_PERI write(idstr, *) tp%id(i) - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(*, *) "Particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " perihelion distance too small at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. - call tp%info(i)%set_value(status="DISCARDED_PERI", discard_time=system%t, discard_rh=tp%rh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_PERI", discard_time=nbody_system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i), discard_body_id=pl%id(j)) end if end if @@ -227,7 +227,7 @@ subroutine swiftest_discard_peri_tp(tp, system, param) end subroutine swiftest_discard_peri_tp - subroutine swiftest_discard_pl_tp(tp, system, param) + subroutine swiftest_discard_pl_tp(tp, nbody_system, param) !! author: David A. Minton !! !! Check to see if test particles should be discarded based on their positions relative to the massive bodies @@ -237,7 +237,7 @@ subroutine swiftest_discard_pl_tp(tp, system, param) implicit none ! Arguments class(swiftest_tp), intent(inout) :: tp !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, j, isp @@ -245,7 +245,7 @@ subroutine swiftest_discard_pl_tp(tp, system, param) real(DP), dimension(NDIM) :: dx, dv character(len=STRMAX) :: idstri, idstrj, timestr - associate(ntp => tp%nbody, pl => system%pl, npl => system%pl%nbody, t => system%t, dt => param%dt) + associate(ntp => tp%nbody, pl => nbody_system%pl, npl => nbody_system%pl%nbody, t => nbody_system%t, dt => param%dt) do i = 1, ntp if (tp%status(i) == ACTIVE) then do j = 1, npl @@ -259,12 +259,12 @@ subroutine swiftest_discard_pl_tp(tp, system, param) pl%ldiscard(j) = .true. write(idstri, *) tp%id(i) write(idstrj, *) pl%id(j) - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(*, *) "Test particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstri)) // ")" & // " too close to massive body " // trim(adjustl(pl%info(j)%name)) // " (" // trim(adjustl(idstrj)) // ")" & // " at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. - call tp%info(i)%set_value(status="DISCARDED_PLR", discard_time=system%t, discard_rh=tp%rh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_PLR", discard_time=nbody_system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i), discard_body_id=pl%id(j)) exit end if diff --git a/src/swiftest/swiftest_drift.f90 b/src/swiftest/swiftest_drift.f90 index 23ea00ee5..8e2273435 100644 --- a/src/swiftest/swiftest_drift.f90 +++ b/src/swiftest/swiftest_drift.f90 @@ -18,7 +18,7 @@ contains - module subroutine swiftest_drift_body(self, system, param, dt) + module subroutine swiftest_drift_body(self, nbody_system, param, dt) !! author: David A. Minton !! !! Loop bodies and call Danby drift routine on the heliocentric position and velocities. @@ -28,7 +28,7 @@ module subroutine swiftest_drift_body(self, system, param, dt) implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! Swiftest test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize ! Internals diff --git a/src/swiftest/swiftest_driver.f90 b/src/swiftest/swiftest_driver.f90 index b83583ed4..4c0b18ce1 100644 --- a/src/swiftest/swiftest_driver.f90 +++ b/src/swiftest/swiftest_driver.f90 @@ -19,7 +19,7 @@ program swiftest_driver use symba implicit none - class(swiftest_nbody_system), allocatable :: system !! Polymorphic object containing the nbody system to be integrated + class(swiftest_nbody_system), allocatable :: nbody_system !! Polymorphic object containing the nbody system to be integrated class(swiftest_parameters), allocatable :: param !! Run configuration parameters character(len=:), allocatable :: integrator !! Integrator type code (see globals for symbolic names) character(len=:), allocatable :: param_file_name !! Name of the file containing user-defined parameters @@ -43,7 +43,7 @@ program swiftest_driver call swiftest_io_get_args(integrator, param_file_name, display_style) - !> Read in the user-defined parameters file and the initial conditions of the system + !> Read in the user-defined parameters file and the initial conditions of the nbody_system allocate(swiftest_parameters :: param) param%integrator = trim(adjustl(integrator)) call param%set_display(display_style) @@ -67,11 +67,11 @@ program swiftest_driver istart = ceiling((tstart - t0) / dt + 1.0_DP, kind=I8B) ioutput = max(int(istart / istep_out, kind=I4B),1) - ! Set up system storage for intermittent file dumps + ! Set up nbody_system storage for intermittent file dumps if (dump_cadence == 0) dump_cadence = ceiling(nloops / (1.0_DP * istep_out), kind=I8B) - ! Construct the main n-body system using the user-input integrator to choose the type of system - call swiftest_setup_construct_system(system, param) + ! Construct the main n-body nbody_system using the user-input integrator to choose the type of nbody_system + call swiftest_setup_construct_system(nbody_system, param) !> Define the maximum number of threads nthreads = 1 ! In the *serial* case @@ -81,19 +81,19 @@ program swiftest_driver !$ write(param%display_unit,'(a,i3,/)') ' Number of threads = ', nthreads !$ if (param%log_output) write(*,'(a,i3)') ' OpenMP: Number of threads = ',nthreads - call system%initialize(param) + call nbody_system%initialize(param) associate (system_history => param%system_history) ! If this is a new run, compute energy initial conditions (if energy tracking is turned on) and write the initial conditions to file. if (param%lenergy) then if (param%lrestart) then - call system%conservation_report(param, lterminal=.true.) + call nbody_system%conservation_report(param, lterminal=.true.) else - call system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum + call nbody_system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum end if end if - call system_history%take_snapshot(param,system) - call system%dump(param) + call system_history%take_snapshot(param,nbody_system) + call nbody_system%dump(param) write(display_unit, *) " *************** Main Loop *************** " @@ -103,22 +103,22 @@ program swiftest_driver call pbar%update(1,message=pbarmessage) else if (display_style == "COMPACT") then write(*,*) "SWIFTEST START " // param%integrator - call system%compact_output(param,integration_timer) + call nbody_system%compact_output(param,integration_timer) end if iout = 0 idump = 0 - system%t = tstart + nbody_system%t = tstart do iloop = istart, nloops - !> Step the system forward in time + !> Step the nbody_system forward in time call integration_timer%start() - call system%step(param, system%t, dt) + call nbody_system%step(param, nbody_system%t, dt) call integration_timer%stop() - system%t = t0 + iloop * dt + nbody_system%t = t0 + iloop * dt !> Evaluate any discards or collisional outcomes - call system%discard(param) + call nbody_system%discard(param) if (display_style == "PROGRESS") call pbar%update(iloop) !> If the loop counter is at the output cadence value, append the data file with a single frame @@ -127,30 +127,30 @@ program swiftest_driver if (iout == istep_out) then iout = 0 idump = idump + 1 - call system_history%take_snapshot(param,system) + call system_history%take_snapshot(param,nbody_system) if (idump == dump_cadence) then idump = 0 - call system%dump(param) + call nbody_system%dump(param) end if - tfrac = (system%t - t0) / (tstop - t0) + tfrac = (nbody_system%t - t0) / (tstop - t0) - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (symba_pl) - write(display_unit, symbastatfmt) system%t, tfrac, pl%nplm, pl%nbody, system%tp%nbody + write(display_unit, symbastatfmt) nbody_system%t, tfrac, pl%nplm, pl%nbody, nbody_system%tp%nbody class default - write(display_unit, statusfmt) system%t, tfrac, pl%nbody, system%tp%nbody + write(display_unit, statusfmt) nbody_system%t, tfrac, pl%nbody, nbody_system%tp%nbody end select - if (param%lenergy) call system%conservation_report(param, lterminal=.true.) + if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) call integration_timer%report(message="Integration steps:", unit=display_unit, nsubsteps=istep_out) if (display_style == "PROGRESS") then - write(pbarmessage,fmt=pbarfmt) system%t, tstop + write(pbarmessage,fmt=pbarfmt) nbody_system%t, tstop call pbar%update(1,message=pbarmessage) else if (display_style == "COMPACT") then - call system%compact_output(param,integration_timer) + call nbody_system%compact_output(param,integration_timer) end if call integration_timer%reset() @@ -160,7 +160,7 @@ program swiftest_driver end do ! Dump any remaining history if it exists - call system%dump(param) + call nbody_system%dump(param) call system_history%dump(param) if (display_style == "COMPACT") write(*,*) "SWIFTEST STOP" // param%integrator end associate diff --git a/src/swiftest/swiftest_gr.f90 b/src/swiftest/swiftest_gr.f90 index e3467b8c0..b4cc17c2b 100644 --- a/src/swiftest/swiftest_gr.f90 +++ b/src/swiftest/swiftest_gr.f90 @@ -10,7 +10,7 @@ submodule(swiftest) s_gr contains - pure module subroutine swiftest_gr_kick_getaccb_ns_body(self, system, param) + pure module subroutine swiftest_gr_kick_getaccb_ns_body(self, nbody_system, param) !! author: David A. Minton !! !! Add relativistic correction acceleration for non-symplectic integrators. @@ -24,13 +24,13 @@ pure module subroutine swiftest_gr_kick_getaccb_ns_body(self, system, param) implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals real(DP) :: rmag, rdotv, vmag2 integer(I4B) :: i - associate(n => self%nbody, cb => system%cb, inv_c2 => param%inv_c2) + associate(n => self%nbody, cb => nbody_system%cb, inv_c2 => param%inv_c2) if (n == 0) return do i = 1, n rmag = norm2(self%rh(:,i)) diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 456bef4a0..d3fbb229e 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -130,50 +130,50 @@ module subroutine swiftest_io_conservation_report(self, param, lterminal) "; D(Eorbit+Ecollisions)/|E0| = ", ES12.5, & "; DM/M0 = ", ES12.5)' - associate(system => self, pl => self%pl, cb => self%cb, npl => self%pl%nbody, display_unit => param%display_unit, nc => param%system_history%nc) + associate(nbody_system => self, pl => self%pl, cb => self%cb, npl => self%pl%nbody, display_unit => param%display_unit, nc => param%system_history%nc) call pl%vb2vh(cb) call pl%rh2rb(cb) - call system%get_energy_and_momentum(param) - ke_orbit_now = system%ke_orbit - ke_spin_now = system%ke_spin - pe_now = system%pe - Lorbit_now(:) = system%Lorbit(:) - Lspin_now(:) = system%Lspin(:) + call nbody_system%get_energy_and_momentum(param) + ke_orbit_now = nbody_system%ke_orbit + ke_spin_now = nbody_system%ke_spin + pe_now = nbody_system%pe + Lorbit_now(:) = nbody_system%Lorbit(:) + Lspin_now(:) = nbody_system%Lspin(:) Eorbit_now = ke_orbit_now + ke_spin_now + pe_now - Ltot_now(:) = system%Ltot(:) + system%Lescape(:) - GMtot_now = system%GMtot + system%GMescape + Ltot_now(:) = nbody_system%Ltot(:) + nbody_system%Lescape(:) + GMtot_now = nbody_system%GMtot + nbody_system%GMescape if (param%lfirstenergy) then - system%ke_orbit_orig = ke_orbit_now - system%ke_spin_orig = ke_spin_now - system%pe_orig = pe_now - system%Eorbit_orig = Eorbit_now - system%GMtot_orig = GMtot_now - system%Lorbit_orig(:) = Lorbit_now(:) - system%Lspin_orig(:) = Lspin_now(:) - system%Ltot_orig(:) = Ltot_now(:) + nbody_system%ke_orbit_orig = ke_orbit_now + nbody_system%ke_spin_orig = ke_spin_now + nbody_system%pe_orig = pe_now + nbody_system%Eorbit_orig = Eorbit_now + nbody_system%GMtot_orig = GMtot_now + nbody_system%Lorbit_orig(:) = Lorbit_now(:) + nbody_system%Lspin_orig(:) = Lspin_now(:) + nbody_system%Ltot_orig(:) = Ltot_now(:) param%lfirstenergy = .false. end if if (.not.param%lfirstenergy) then - system%ke_orbit_error = (ke_orbit_now - system%ke_orbit_orig) / abs(system%Eorbit_orig) - system%ke_spin_error = (ke_spin_now - system%ke_spin_orig) / abs(system%Eorbit_orig) - system%pe_error = (pe_now - system%pe_orig) / abs(system%Eorbit_orig) - system%Eorbit_error = (Eorbit_now - system%Eorbit_orig) / abs(system%Eorbit_orig) - system%Ecoll_error = system%Ecollisions / abs(system%Eorbit_orig) - system%Euntracked_error = system%Euntracked / abs(system%Eorbit_orig) - system%Etot_error = (Eorbit_now - system%Ecollisions - system%Eorbit_orig - system%Euntracked) / abs(system%Eorbit_orig) - - system%Lorbit_error = norm2(Lorbit_now(:) - system%Lorbit_orig(:)) / norm2(system%Ltot_orig(:)) - system%Lspin_error = norm2(Lspin_now(:) - system%Lspin_orig(:)) / norm2(system%Ltot_orig(:)) - system%Lescape_error = norm2(system%Lescape(:)) / norm2(system%Ltot_orig(:)) - system%Ltot_error = norm2(Ltot_now(:) - system%Ltot_orig(:)) / norm2(system%Ltot_orig(:)) - system%Mescape_error = system%GMescape / system%GMtot_orig - system%Mtot_error = (GMtot_now - system%GMtot_orig) / system%GMtot_orig - if (lterminal) write(display_unit, EGYTERMFMT) system%Ltot_error, system%Ecoll_error, system%Etot_error,system%Mtot_error - if (abs(system%Mtot_error) > 100 * epsilon(system%Mtot_error)) then + nbody_system%ke_orbit_error = (ke_orbit_now - nbody_system%ke_orbit_orig) / abs(nbody_system%Eorbit_orig) + nbody_system%ke_spin_error = (ke_spin_now - nbody_system%ke_spin_orig) / abs(nbody_system%Eorbit_orig) + nbody_system%pe_error = (pe_now - nbody_system%pe_orig) / abs(nbody_system%Eorbit_orig) + nbody_system%Eorbit_error = (Eorbit_now - nbody_system%Eorbit_orig) / abs(nbody_system%Eorbit_orig) + nbody_system%Ecoll_error = nbody_system%Ecollisions / abs(nbody_system%Eorbit_orig) + nbody_system%Euntracked_error = nbody_system%Euntracked / abs(nbody_system%Eorbit_orig) + nbody_system%Etot_error = (Eorbit_now - nbody_system%Ecollisions - nbody_system%Eorbit_orig - nbody_system%Euntracked) / abs(nbody_system%Eorbit_orig) + + nbody_system%Lorbit_error = norm2(Lorbit_now(:) - nbody_system%Lorbit_orig(:)) / norm2(nbody_system%Ltot_orig(:)) + nbody_system%Lspin_error = norm2(Lspin_now(:) - nbody_system%Lspin_orig(:)) / norm2(nbody_system%Ltot_orig(:)) + nbody_system%Lescape_error = norm2(nbody_system%Lescape(:)) / norm2(nbody_system%Ltot_orig(:)) + nbody_system%Ltot_error = norm2(Ltot_now(:) - nbody_system%Ltot_orig(:)) / norm2(nbody_system%Ltot_orig(:)) + nbody_system%Mescape_error = nbody_system%GMescape / nbody_system%GMtot_orig + nbody_system%Mtot_error = (GMtot_now - nbody_system%GMtot_orig) / nbody_system%GMtot_orig + if (lterminal) write(display_unit, EGYTERMFMT) nbody_system%Ltot_error, nbody_system%Ecoll_error, nbody_system%Etot_error,nbody_system%Mtot_error + if (abs(nbody_system%Mtot_error) > 100 * epsilon(nbody_system%Mtot_error)) then write(*,*) "Severe error! Mass not conserved! Halting!" ! Save the frame of data to the bin file in the slot just after the present one for diagnostics param%ioutput = param%ioutput + 1 @@ -226,12 +226,12 @@ end subroutine swiftest_io_dump_param module subroutine swiftest_io_dump_system(self, param) !! author: David A. Minton !! - !! Dumps the state of the system to files in case the simulation is interrupted. + !! Dumps the state of the nbody_system to files in case the simulation is interrupted. !! As a safety mechanism, there are two dump files that are written in alternating order !! so that if a dump file gets corrupted during writing, the user can restart from the older one. implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals class(swiftest_parameters), allocatable :: dump_param !! Local parameters variable used to parameters change input file names @@ -268,7 +268,7 @@ module subroutine swiftest_io_dump_system(self, param) if (param%lenc_save_trajectory .or. param%lenc_save_closest) call self%encounter_history%dump(param) call self%collision_history%dump(param) - ! Dump the system history to file + ! Dump the nbody_system history to file call param%system_history%dump(param) return @@ -278,7 +278,7 @@ end subroutine swiftest_io_dump_system module subroutine swiftest_io_dump_storage(self, param) !! author: David A. Minton !! - !! Dumps the time history of the simulation to file. Each time it writes a frame to file, it deallocates the system + !! Dumps the time history of the simulation to file. Each time it writes a frame to file, it deallocates the nbody_system !! object from inside. It will only dump frames with systems that are allocated, so this can be called at the end of !! a simulation for cases when the number of saved frames is not equal to the dump cadence (for instance, if the dump !! cadence is not divisible by the total number of loops). @@ -296,9 +296,9 @@ module subroutine swiftest_io_dump_storage(self, param) do i = 1, self%iframe if (allocated(self%frame(i)%item)) then param%ioutput = iloop_start + self%tmap(i) - select type(system => self%frame(i)%item) + select type(nbody_system => self%frame(i)%item) class is (swiftest_nbody_system) - call system%write_frame(param) + call nbody_system%write_frame(param) end select deallocate(self%frame(i)%item) end if @@ -578,7 +578,7 @@ end function swiftest_io_netcdf_get_old_t_final_system module subroutine swiftest_io_netcdf_initialize_output(self, param) !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton !! - !! Initialize a NetCDF file system and defines all variables. + !! Initialize a NetCDF file nbody_system and defines all variables. use, intrinsic :: ieee_arithmetic implicit none ! Arguments @@ -881,7 +881,7 @@ module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ier !! Read a frame (header plus records for each massive body and active test particle) from an output binary file implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Return @@ -1108,7 +1108,7 @@ module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ier return 667 continue - write(*,*) "Error reading system frame in netcdf_io_read_frame_system" + write(*,*) "Error reading nbody_system frame in netcdf_io_read_frame_system" end function swiftest_io_netcdf_read_frame_system @@ -1568,7 +1568,7 @@ module subroutine swiftest_io_netcdf_write_frame_system(self, nc, param) !! Write a frame (header plus records for each massive body and active test particle) to a output binary file implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters @@ -1928,7 +1928,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i case("SEED") read(param_value, *) nseeds_from_file ! Because the number of seeds can vary between compilers/systems, we need to make sure we can handle cases in which the input file has a different - ! number of seeds than the current system. If the number of seeds in the file is smaller than required, we will use them as a source to fill in the missing elements. + ! number of seeds than the current nbody_system. If the number of seeds in the file is smaller than required, we will use them as a source to fill in the missing elements. ! If the number of seeds in the file is larger than required, we will truncate the seed array. if (nseeds_from_file > nseeds) then nseeds = nseeds_from_file @@ -2045,12 +2045,12 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i return end if - ! Calculate the G for the system units + ! Calculate the G for the nbody_system units param%GU = GC / (param%DU2M**3 / (param%MU2KG * param%TU2S**2)) ! All reporting of collision information in SyMBA (including mergers) is now recorded in the Fraggle logfile - call swiftest_io_log_start(param, FRAGGLE_LOG_OUT, "Fraggle logfile") + call swiftest_io_log_start(param, COLLISION_LOG_OUT, "Fraggle logfile") if ((param%encounter_save /= "NONE") .and. & (param%encounter_save /= "TRAJECTORY") .and. & @@ -2111,7 +2111,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i end select if (param%lgr) then - ! Calculate the inverse speed of light in the system units + ! Calculate the inverse speed of light in the nbody_system units param%inv_c2 = einsteinC * param%TU2S / param%DU2M param%inv_c2 = (param%inv_c2)**(-2) end if @@ -2584,7 +2584,7 @@ end subroutine swiftest_io_read_in_cb module subroutine swiftest_io_read_in_system(self, param) !! author: David A. Minton and Carlisle A. Wishard !! - !! Reads in the system from input files + !! Reads in the nbody_system from input files implicit none ! Arguments class(swiftest_nbody_system), intent(inout) :: self @@ -2859,7 +2859,7 @@ module subroutine swiftest_io_write_frame_system(self, param) !! Adapted from Hal Levison's Swift routine io_write_frame.f implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals logical, save :: lfirst = .true. !! Flag to determine if this is the first call of this method @@ -2898,7 +2898,7 @@ module subroutine swiftest_io_write_frame_system(self, param) return 667 continue - write(*,*) "Error writing system frame: " // trim(adjustl(errmsg)) + write(*,*) "Error writing nbody_system frame: " // trim(adjustl(errmsg)) call util_exit(FAILURE) end subroutine swiftest_io_write_frame_system diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index 34ddefcdb..4ce4ac3b5 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -64,7 +64,7 @@ module swiftest procedure :: dump => swiftest_io_dump_storage !! Dumps storage object contents to file procedure :: get_index_values => swiftest_util_get_vals_storage !! Gets the unique values of the indices of a storage object (i.e. body id or time value) procedure :: make_index_map => swiftest_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - procedure :: take_snapshot => swiftest_util_snapshot_system !! Takes a snapshot of the system for later file storage + procedure :: take_snapshot => swiftest_util_snapshot_system !! Takes a snapshot of the nbody_system for later file storage final :: swiftest_final_storage end type swiftest_storage @@ -139,7 +139,7 @@ module swiftest procedure :: pv2v => swiftest_gr_pv2vh_body !! Converts from psudeovelocity to velocity for GR calculations using symplectic integrators procedure :: read_frame_bin => swiftest_io_read_frame_body !! I/O routine for writing out a single frame of time-series data for the central body procedure :: read_in => swiftest_io_read_in_body !! Read in body initial conditions from an ascii file - procedure :: write_frame => swiftest_io_netcdf_write_frame_body !! I/O routine for writing out a single frame of time-series data for all bodies in the system in NetCDF format + procedure :: write_frame => swiftest_io_netcdf_write_frame_body !! I/O routine for writing out a single frame of time-series data for all bodies in the nbody_system in NetCDF format procedure :: write_info => swiftest_io_netcdf_write_info_body !! Dump contents of particle information metadata to file procedure :: accel_obl => swiftest_obl_acc_body !! Compute the barycentric accelerations of bodies due to the oblateness of the central body procedure :: el2xv => swiftest_orbel_el2xv_vec !! Convert orbital elements to position and velocity vectors @@ -149,7 +149,7 @@ module swiftest procedure :: append => swiftest_util_append_body !! Appends elements from one structure to another procedure :: dealloc => swiftest_util_dealloc_body !! Deallocates all allocatable arrays procedure :: fill => swiftest_util_fill_body !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) - procedure :: get_peri => swiftest_util_peri_body !! Determine system pericenter passages for test particles + procedure :: get_peri => swiftest_util_peri_body !! Determine nbody_system pericenter passages for test particles procedure :: resize => swiftest_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 => swiftest_util_set_ir3h !! Sets the inverse heliocentric radius term (1/rh**3) @@ -211,7 +211,7 @@ module swiftest real(DP) :: dR = 0.0_DP !! Change in the radius of the central body contains procedure :: read_in => swiftest_io_read_in_cb !! Read in central body initial conditions from an ASCII file - procedure :: write_frame => swiftest_io_netcdf_write_frame_cb !! I/O routine for writing out a single frame of time-series data for all bodies in the system in NetCDF format + procedure :: write_frame => swiftest_io_netcdf_write_frame_cb !! I/O routine for writing out a single frame of time-series data for all bodies in the nbody_system in NetCDF format procedure :: write_info => swiftest_io_netcdf_write_info_cb !! Dump contents of particle information metadata to file end type swiftest_cb @@ -307,7 +307,7 @@ module swiftest !> An abstract class for a basic Swiftest nbody system type, abstract, extends(base_nbody_system) :: swiftest_nbody_system - !! This superclass contains a minimial system of a set of test particles (tp), massive bodies (pl), and a central body (cb) + !! This superclass contains a minimial nbody_system of a set of test particles (tp), massive bodies (pl), and a central body (cb) !! The full swiftest_nbody_system type that is used as the parent class of all integrators is defined in collision class(swiftest_cb), allocatable :: cb !! Central body data structure @@ -316,38 +316,38 @@ module swiftest class(swiftest_tp), allocatable :: tp_discards !! Discarded test particle data structure class(swiftest_pl), allocatable :: pl_discards !! Discarded massive body particle data structure - class(swiftest_pl), allocatable :: pl_adds !! List of added bodies in mergers or collisions - class(swiftest_tp), allocatable :: tp_adds !! List of added bodies in mergers or collisions - class(encounter_list), allocatable :: pltp_encounter !! List of massive body-test particle encounters in a single step - class(encounter_list), allocatable :: plpl_encounter !! List of massive body-massive body encounters in a single step + class(swiftest_pl), allocatable :: pl_adds !! List of added bodies in mergers or collisions + class(swiftest_tp), allocatable :: tp_adds !! List of added bodies in mergers or collisions + class(encounter_list), allocatable :: pltp_encounter !! List of massive body-test particle encounters in a single step + class(encounter_list), allocatable :: plpl_encounter !! List of massive body-massive body encounters in a single step class(collision_list_plpl), allocatable :: plpl_collision !! List of massive body-massive body collisions in a single step class(collision_list_plpl), allocatable :: pltp_collision !! List of massive body-massive body collisions in a single step - class(collision_system), allocatable :: collision_system !! Collision system object + class(collision_system), allocatable :: collider !! Collision system object class(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file class(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file real(DP) :: t = -1.0_DP !! Integration current time - real(DP) :: GMtot = 0.0_DP !! Total system mass - used for barycentric coordinate conversion - real(DP) :: ke_orbit = 0.0_DP !! System orbital kinetic energy - real(DP) :: ke_spin = 0.0_DP !! System spin kinetic energy - real(DP) :: pe = 0.0_DP !! System potential energy - real(DP) :: te = 0.0_DP !! System total energy - real(DP) :: oblpot = 0.0_DP !! System potential energy due to oblateness of the central body - real(DP), dimension(NDIM) :: Lorbit = 0.0_DP !! System orbital angular momentum vector - real(DP), dimension(NDIM) :: Lspin = 0.0_DP !! System spin angular momentum vector - real(DP), dimension(NDIM) :: Ltot = 0.0_DP !! System angular momentum vector + real(DP) :: GMtot = 0.0_DP !! Total nbody_system mass - used for barycentric coordinate conversion + real(DP) :: ke_orbit = 0.0_DP !! nbody_system orbital kinetic energy + real(DP) :: ke_spin = 0.0_DP !! nbody_system spin kinetic energy + real(DP) :: pe = 0.0_DP !! nbody_system potential energy + real(DP) :: te = 0.0_DP !! nbody_system total energy + real(DP) :: oblpot = 0.0_DP !! nbody_system potential energy due to oblateness of the central body + real(DP), dimension(NDIM) :: Lorbit = 0.0_DP !! nbody_system orbital angular momentum vector + real(DP), dimension(NDIM) :: Lspin = 0.0_DP !! nbody_system spin angular momentum vector + real(DP), dimension(NDIM) :: Ltot = 0.0_DP !! nbody_system angular momentum vector real(DP) :: ke_orbit_orig = 0.0_DP !! Initial orbital kinetic energy real(DP) :: ke_spin_orig = 0.0_DP !! Initial spin kinetic energy real(DP) :: pe_orig = 0.0_DP !! Initial potential energy real(DP) :: Eorbit_orig = 0.0_DP !! Initial orbital energy - real(DP) :: GMtot_orig = 0.0_DP !! Initial system mass + real(DP) :: GMtot_orig = 0.0_DP !! Initial nbody_system mass real(DP), dimension(NDIM) :: Ltot_orig = 0.0_DP !! Initial total angular momentum vector real(DP), dimension(NDIM) :: Lorbit_orig = 0.0_DP !! Initial orbital angular momentum real(DP), dimension(NDIM) :: Lspin_orig = 0.0_DP !! Initial spin angular momentum vector - real(DP), dimension(NDIM) :: Lescape = 0.0_DP !! Angular momentum of bodies that escaped the system (used for bookeeping) - real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the system (used for bookeeping) - real(DP) :: Ecollisions = 0.0_DP !! Energy lost from system due to collisions - real(DP) :: Euntracked = 0.0_DP !! Energy gained from system due to escaped bodies + real(DP), dimension(NDIM) :: Lescape = 0.0_DP !! Angular momentum of bodies that escaped the nbody_system (used for bookeeping) + real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the nbody_system (used for bookeeping) + real(DP) :: Ecollisions = 0.0_DP !! Energy lost from nbody_system due to collisions + real(DP) :: Euntracked = 0.0_DP !! Energy gained from nbody_system due to escaped bodies ! Energy, momentum, and mass errors (used in error reporting) real(DP) :: ke_orbit_error = 0.0_DP @@ -372,10 +372,10 @@ module swiftest procedure(abstract_step_system), deferred :: step ! Concrete classes that are common to the basic integrator (only test particles considered for discard) - procedure :: discard => swiftest_discard_system !! Perform a discard step on the system + procedure :: discard => swiftest_discard_system !! Perform a discard step on the nbody_system procedure :: compact_output => swiftest_io_compact_output !! Prints out out terminal output when display_style is set to COMPACT procedure :: conservation_report => swiftest_io_conservation_report !! Compute energy and momentum and print out the change with time - procedure :: dump => swiftest_io_dump_system !! Dump the state of the system to a file + procedure :: dump => swiftest_io_dump_system !! Dump the state of the nbody_system to a file procedure :: get_old_t_final => swiftest_io_netcdf_get_old_t_final_system !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the netcdf output. procedure :: read_frame => swiftest_io_netcdf_read_frame_system !! Read in a frame of input data from file procedure :: write_frame_netcdf => swiftest_io_netcdf_write_frame_system !! Write a frame of input data from file @@ -385,14 +385,14 @@ module swiftest procedure :: read_in => swiftest_io_read_in_system !! Reads the initial conditions for an nbody system procedure :: read_particle_info => swiftest_io_netcdf_read_particle_info_system !! Read in particle metadata from file procedure :: obl_pot => swiftest_obl_pot_system !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body - procedure :: initialize => swiftest_setup_initialize_system !! Initialize the system from input files - procedure :: init_particle_info => swiftest_setup_initialize_particle_info_system !! Initialize the system from input files + procedure :: initialize => swiftest_setup_initialize_system !! Initialize the nbody_system from input files + procedure :: init_particle_info => swiftest_setup_initialize_particle_info_system !! Initialize the nbody_system from input files ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. - procedure :: set_msys => swiftest_util_set_msys !! Sets the value of msys from the masses of system bodies. - procedure :: get_energy_and_momentum => swiftest_util_get_energy_momentum_system !! Calculates the total system energy and momentum - procedure :: get_idvals => swiftest_util_get_idvalues_system !! Returns an array of all id values in use in the system - procedure :: rescale => swiftest_util_rescale_system !! Rescales the system into a new set of units - procedure :: validate_ids => swiftest_util_valid_id_system !! Validate the numerical ids passed to the system and save the maximum value + procedure :: set_msys => swiftest_util_set_msys !! Sets the value of msys from the masses of nbody_system bodies. + procedure :: get_energy_and_momentum => swiftest_util_get_energy_momentum_system !! Calculates the total nbody_system energy and momentum + procedure :: get_idvals => swiftest_util_get_idvalues_system !! Returns an array of all id values in use in the nbody_system + procedure :: rescale => swiftest_util_rescale_system !! Rescales the nbody_system into a new set of units + procedure :: validate_ids => swiftest_util_valid_id_system !! Validate the numerical ids passed to the nbody_system and save the maximum value procedure :: write_discard => swiftest_io_write_discard !! Write out information about discarded and merged planets and test particles in SyMBA generic :: write_frame => write_frame_system, write_frame_netcdf !! Generic method call for reading a frame of output data end type swiftest_nbody_system @@ -400,27 +400,27 @@ module swiftest abstract interface - subroutine abstract_accel(self, system, param, t, lbeg) + subroutine abstract_accel(self, nbody_system, param, t, lbeg) import swiftest_body, swiftest_nbody_system, swiftest_parameters, DP class(swiftest_body), intent(inout) :: self !! Swiftest body data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step end subroutine abstract_accel - subroutine abstract_discard_body(self, system, param) + subroutine abstract_discard_body(self, nbody_system, param) import swiftest_body, swiftest_nbody_system, swiftest_parameters class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine abstract_discard_body - subroutine abstract_kick_body(self, system, param, t, dt, lbeg) + subroutine abstract_kick_body(self, nbody_system, param, t, dt, lbeg) import swiftest_body, swiftest_nbody_system, swiftest_parameters, DP implicit none class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system objec + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system objec class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -433,11 +433,11 @@ subroutine abstract_set_mu(self, cb) class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object end subroutine abstract_set_mu - subroutine abstract_step_body(self, system, param, t, dt) + subroutine abstract_step_body(self, nbody_system, param, t, dt) import DP, swiftest_body, swiftest_nbody_system, swiftest_parameters implicit none class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Simulation time real(DP), intent(in) :: dt !! Current stepsize @@ -446,7 +446,7 @@ end subroutine abstract_step_body subroutine abstract_step_system(self, param, t, dt) import DP, swiftest_nbody_system, swiftest_parameters implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Simulation time real(DP), intent(in) :: dt !! Current stepsize @@ -455,23 +455,23 @@ end subroutine abstract_step_system interface - module subroutine swiftest_discard_pl(self, system, param) + module subroutine swiftest_discard_pl(self, nbody_system, param) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameter end subroutine swiftest_discard_pl module subroutine swiftest_discard_system(self, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_discard_system - module subroutine swiftest_discard_tp(self, system, param) + module subroutine swiftest_discard_tp(self, nbody_system, param) implicit none class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_discard_tp @@ -486,10 +486,10 @@ module subroutine swiftest_drift_all(mu, x, v, n, param, dt, lmask, iflag) integer(I4B), dimension(:), intent(out) :: iflag !! Vector of error flags. 0 means no problem end subroutine swiftest_drift_all - module subroutine swiftest_drift_body(self, system, param, dt) + module subroutine swiftest_drift_body(self, nbody_system, param, dt) implicit none class(swiftest_body), intent(inout) :: self !! Swiftest particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize end subroutine swiftest_drift_body @@ -503,10 +503,10 @@ pure elemental module subroutine swiftest_drift_one(mu, px, py, pz, vx, vy, vz, integer(I4B), intent(out) :: iflag !! iflag : error status flag for Danby drift (0 = OK, nonzero = ERROR) end subroutine swiftest_drift_one - pure module subroutine swiftest_gr_kick_getaccb_ns_body(self, system, param) + pure module subroutine swiftest_gr_kick_getaccb_ns_body(self, nbody_system, param) implicit none class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine swiftest_gr_kick_getaccb_ns_body @@ -580,7 +580,7 @@ end subroutine swiftest_io_dump_param module subroutine swiftest_io_dump_system(self, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_io_dump_system @@ -647,7 +647,7 @@ end subroutine swiftest_io_netcdf_open module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ierr) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters integer(I4B) :: ierr !! Error code: returns 0 if the read is successful @@ -685,7 +685,7 @@ end subroutine swiftest_io_netcdf_write_frame_cb module subroutine swiftest_io_netcdf_write_frame_system(self, nc, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_io_netcdf_write_frame_system @@ -834,7 +834,7 @@ end function swiftest_io_read_frame_body module function swiftest_io_read_frame_system(self, iu, param) result(ierr) implicit none - class(swiftest_nbody_system),intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system),intent(inout) :: self !! Swiftest nbody_system object integer(I4B), intent(inout) :: iu !! Unit number for the output file to read frame from class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters integer(I4B) :: ierr !! Error code: returns 0 if the read is successful @@ -853,7 +853,7 @@ end subroutine swiftest_io_toupper module subroutine swiftest_io_write_frame_system(self, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_io_write_frame_system @@ -924,22 +924,22 @@ pure module subroutine swiftest_kick_getacch_int_one_tp(rji2, xr, yr, zr, Gmpl, real(DP), intent(inout) :: ax, ay, az !! Acceleration vector components of test particle end subroutine swiftest_kick_getacch_int_one_tp - module subroutine swiftest_obl_acc_body(self, system) + module subroutine swiftest_obl_acc_body(self, nbody_system) implicit none class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object end subroutine swiftest_obl_acc_body - module subroutine swiftest_obl_acc_pl(self, system) + module subroutine swiftest_obl_acc_pl(self, nbody_system) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object end subroutine swiftest_obl_acc_pl - module subroutine swiftest_obl_acc_tp(self, system) + module subroutine swiftest_obl_acc_tp(self, nbody_system) implicit none class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object end subroutine swiftest_obl_acc_tp module subroutine swiftest_obl_pot_system(self) @@ -1014,9 +1014,9 @@ module subroutine swiftest_setup_body(self, n, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine swiftest_setup_body - module subroutine swiftest_setup_construct_system(system, param) + module subroutine swiftest_setup_construct_system(nbody_system, param) implicit none - class(swiftest_nbody_system), allocatable, intent(inout) :: system !! Swiftest system object + class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_setup_construct_system @@ -1028,7 +1028,7 @@ end subroutine swiftest_setup_initialize_particle_info_system module subroutine swiftest_setup_initialize_system(self, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_setup_initialize_system @@ -1046,10 +1046,10 @@ module subroutine swiftest_setup_tp(self, n, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parametersr end subroutine swiftest_setup_tp - module subroutine swiftest_user_kick_getacch_body(self, system, param, t, lbeg) + module subroutine swiftest_user_kick_getacch_body(self, nbody_system, param, t, lbeg) implicit none class(swiftest_body), intent(inout) :: self !! Swiftest massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody_system_object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody_system_object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters 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 @@ -1352,24 +1352,24 @@ module subroutine swiftest_util_index_map_storage(self) class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object end subroutine swiftest_util_index_map_storage - module subroutine swiftest_util_peri_body(self, system, param) + module subroutine swiftest_util_peri_body(self, nbody_system, param) implicit none class(swiftest_body), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine swiftest_util_peri_body - module subroutine swiftest_util_peri_tp(self, system, param) + module subroutine swiftest_util_peri_tp(self, nbody_system, param) implicit none class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine swiftest_util_peri_tp - module subroutine swiftest_util_rearray_pl(self, system, param) + module subroutine swiftest_util_rearray_pl(self, nbody_system, param) implicit none class(swiftest_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions end subroutine swiftest_util_rearray_pl @@ -1483,7 +1483,7 @@ end subroutine swiftest_util_set_ir3h module subroutine swiftest_util_set_msys(self) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object end subroutine swiftest_util_set_msys module subroutine swiftest_util_set_mu_pl(self, cb) @@ -1540,12 +1540,12 @@ module subroutine swiftest_util_set_rhill_approximate(self,cb) class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object end subroutine swiftest_util_set_rhill_approximate - module subroutine swiftest_util_snapshot_system(self, param, system, t, arg) + module subroutine swiftest_util_snapshot_system(self, param, nbody_system, t, arg) implicit none class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from nbody_system time character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in encounter snapshots) end subroutine swiftest_util_snapshot_system end interface diff --git a/src/swiftest/swiftest_obl.f90 b/src/swiftest/swiftest_obl.f90 index bb785232b..3864c9f2d 100644 --- a/src/swiftest/swiftest_obl.f90 +++ b/src/swiftest/swiftest_obl.f90 @@ -9,7 +9,7 @@ submodule (swiftest) s_obl contains - module subroutine swiftest_obl_acc_body(self, system) + module subroutine swiftest_obl_acc_body(self, nbody_system) !! author: David A. Minton !! !! Compute the barycentric accelerations of bodies due to the oblateness of the central body @@ -20,14 +20,14 @@ module subroutine swiftest_obl_acc_body(self, system) implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object ! Internals integer(I4B) :: i real(DP) :: r2, irh, rinv2, t0, t1, t2, t3, fac1, fac2 if (self%nbody == 0) return - associate(n => self%nbody, cb => system%cb) + associate(n => self%nbody, cb => nbody_system%cb) self%aobl(:,:) = 0.0_DP do concurrent(i = 1:n, self%lmask(i)) r2 = dot_product(self%rh(:, i), self%rh(:, i)) @@ -48,7 +48,7 @@ module subroutine swiftest_obl_acc_body(self, system) end subroutine swiftest_obl_acc_body - module subroutine swiftest_obl_acc_pl(self, system) + module subroutine swiftest_obl_acc_pl(self, nbody_system) !! author: David A. Minton !! !! Compute the barycentric accelerations of massive bodies due to the oblateness of the central body @@ -58,14 +58,14 @@ module subroutine swiftest_obl_acc_pl(self, system) implicit none ! Arguments class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object ! Internals integer(I4B) :: i if (self%nbody == 0) return - associate(pl => self, npl => self%nbody, cb => system%cb) - call swiftest_obl_acc_body(pl, system) + associate(pl => self, npl => self%nbody, cb => nbody_system%cb) + call swiftest_obl_acc_body(pl, nbody_system) cb%aobl(:) = 0.0_DP do i = npl, 1, -1 if (pl%lmask(i)) cb%aobl(:) = cb%aobl(:) - pl%Gmass(i) * pl%aobl(:, i) / cb%Gmass @@ -81,7 +81,7 @@ module subroutine swiftest_obl_acc_pl(self, system) end subroutine swiftest_obl_acc_pl - module subroutine swiftest_obl_acc_tp(self, system) + module subroutine swiftest_obl_acc_tp(self, nbody_system) !! author: David A. Minton !! !! Compute the barycentric accelerations of massive bodies due to the oblateness of the central body @@ -91,16 +91,16 @@ module subroutine swiftest_obl_acc_tp(self, system) implicit none ! Arguments class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object ! Internals real(DP), dimension(NDIM) :: aoblcb integer(I4B) :: i if (self%nbody == 0) return - associate(tp => self, ntp => self%nbody, cb => system%cb) - call swiftest_obl_acc_body(tp, system) - if (system%lbeg) then + associate(tp => self, ntp => self%nbody, cb => nbody_system%cb) + call swiftest_obl_acc_body(tp, nbody_system) + if (nbody_system%lbeg) then aoblcb = cb%aoblbeg else aoblcb = cb%aoblend @@ -133,12 +133,12 @@ module subroutine swiftest_obl_pot_system(self) integer(I4B) :: i real(DP), dimension(self%pl%nbody) :: oblpot_arr - associate(system => self, pl => self%pl, npl => self%pl%nbody, cb => self%cb) + associate(nbody_system => self, pl => self%pl, npl => self%pl%nbody, cb => self%cb) if (.not. any(pl%lmask(1:npl))) return do concurrent (i = 1:npl, pl%lmask(i)) oblpot_arr(i) = obl_pot_one(cb%Gmass, pl%Gmass(i), cb%j2rp2, cb%j4rp4, pl%rh(3,i), 1.0_DP / norm2(pl%rh(:,i))) end do - system%oblpot = sum(oblpot_arr, pl%lmask(1:npl)) + nbody_system%oblpot = sum(oblpot_arr, pl%lmask(1:npl)) end associate return diff --git a/src/swiftest/swiftest_setup.f90 b/src/swiftest/swiftest_setup.f90 index ede789d7d..85084bfe0 100644 --- a/src/swiftest/swiftest_setup.f90 +++ b/src/swiftest/swiftest_setup.f90 @@ -12,16 +12,17 @@ use rmvs use helio use symba + use fraggle contains - module subroutine swiftest_setup_construct_system(system, param) + module subroutine swiftest_setup_construct_system(nbody_system, param) !! author: David A. Minton !! !! Constructor for a Swiftest nbody system. Creates the nbody system object based on the user-input integrator !! implicit none ! Arguments - class(swiftest_nbody_system), allocatable, intent(inout) :: system !! Swiftest system object + class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals type(encounter_storage) :: encounter_history @@ -37,58 +38,54 @@ module subroutine swiftest_setup_construct_system(system, param) case (INT_BS) write(*,*) 'Bulirsch-Stoer integrator not yet enabled' case (INT_HELIO) - allocate(helio_nbody_system :: system) - select type(system) + allocate(helio_nbody_system :: nbody_system) + select type(nbody_system) class is (helio_nbody_system) - allocate(helio_cb :: system%cb) - allocate(helio_pl :: system%pl) - allocate(helio_tp :: system%tp) - allocate(helio_tp :: system%tp_discards) + allocate(helio_cb :: nbody_system%cb) + allocate(helio_pl :: nbody_system%pl) + allocate(helio_tp :: nbody_system%tp) + allocate(helio_tp :: nbody_system%tp_discards) end select + param%collision_model = "MERGE" case (INT_RA15) write(*,*) 'Radau integrator not yet enabled' case (INT_TU4) write(*,*) 'INT_TU4 integrator not yet enabled' case (INT_WHM) - allocate(whm_nbody_system :: system) - select type(system) + allocate(whm_nbody_system :: nbody_system) + select type(nbody_system) class is (whm_nbody_system) - allocate(whm_cb :: system%cb) - allocate(whm_pl :: system%pl) - allocate(whm_tp :: system%tp) - allocate(whm_tp :: system%tp_discards) + allocate(whm_cb :: nbody_system%cb) + allocate(whm_pl :: nbody_system%pl) + allocate(whm_tp :: nbody_system%tp) + allocate(whm_tp :: nbody_system%tp_discards) end select + param%collision_model = "MERGE" case (INT_RMVS) - allocate(rmvs_nbody_system :: system) - select type(system) + allocate(rmvs_nbody_system :: nbody_system) + select type(nbody_system) class is (rmvs_nbody_system) - allocate(rmvs_cb :: system%cb) - allocate(rmvs_pl :: system%pl) - allocate(rmvs_tp :: system%tp) - allocate(rmvs_tp :: system%tp_discards) + allocate(rmvs_cb :: nbody_system%cb) + allocate(rmvs_pl :: nbody_system%pl) + allocate(rmvs_tp :: nbody_system%tp) + allocate(rmvs_tp :: nbody_system%tp_discards) end select + param%collision_model = "MERGE" case (INT_SYMBA) - allocate(symba_nbody_system :: system) - select type(system) + allocate(symba_nbody_system :: nbody_system) + select type(nbody_system) class is (symba_nbody_system) - allocate(symba_cb :: system%cb) - allocate(symba_pl :: system%pl) - allocate(symba_tp :: system%tp) - - allocate(symba_tp :: system%tp_discards) - allocate(symba_pl :: system%pl_adds) - allocate(symba_pl :: system%pl_discards) - - allocate(collision_list_pltp :: system%pltp_encounter) - allocate(collision_list_plpl :: system%plpl_encounter) - allocate(collision_list_plpl :: system%plpl_collision) - - if (param%collision_model == "FRAGGLE") then - allocate(fraggle_system :: system%collision_system) - else - allocate(collision_system :: system%collision_system) - end if - call system%collision_system%setup(system) + allocate(symba_cb :: nbody_system%cb) + allocate(symba_pl :: nbody_system%pl) + allocate(symba_tp :: nbody_system%tp) + + allocate(symba_tp :: nbody_system%tp_discards) + allocate(symba_pl :: nbody_system%pl_adds) + allocate(symba_pl :: nbody_system%pl_discards) + + allocate(collision_list_pltp :: nbody_system%pltp_encounter) + allocate(collision_list_plpl :: nbody_system%plpl_encounter) + allocate(collision_list_plpl :: nbody_system%plpl_collision) if (param%lenc_save_trajectory .or. param%lenc_save_closest) then allocate(encounter_netcdf_parameters :: encounter_history%nc) @@ -97,7 +94,7 @@ module subroutine swiftest_setup_construct_system(system, param) class is (encounter_netcdf_parameters) nc%file_number = param%iloop / param%dump_cadence end select - allocate(system%encounter_history, source=encounter_history) + allocate(nbody_system%encounter_history, source=encounter_history) end if allocate(collision_netcdf_parameters :: collision_history%nc) @@ -106,7 +103,7 @@ module subroutine swiftest_setup_construct_system(system, param) class is (collision_netcdf_parameters) nc%file_number = param%iloop / param%dump_cadence end select - allocate(system%collision_history, source=collision_history) + allocate(nbody_system%collision_history, source=collision_history) end select case (INT_RINGMOONS) @@ -116,7 +113,20 @@ module subroutine swiftest_setup_construct_system(system, param) call util_exit(FAILURE) end select - allocate(swiftest_particle_info :: system%cb%info) + allocate(swiftest_particle_info :: nbody_system%cb%info) + + select case(param%collision_model) + case("MERGE") + allocate(collision_merge :: nbody_system%collider) + case("BOUNCE") + allocate(collision_bounce :: nbody_system%collider) + case("SIMPLE") + allocate(collision_simple :: nbody_system%collider) + case("FRAGGLE") + allocate(fraggle_system :: nbody_system%collider) + end select + call nbody_system%collider%setup(nbody_system) + end select return @@ -163,14 +173,14 @@ module subroutine swiftest_setup_initialize_system(self, param) !! implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - associate(system => self, cb => self%cb, pl => self%pl, tp => self%tp) + associate(nbody_system => self, cb => self%cb, pl => self%pl, tp => self%tp) - call system%read_in(param) - call system%validate_ids(param) - call system%set_msys() + call nbody_system%read_in(param) + call nbody_system%validate_ids(param) + call nbody_system%set_msys() call pl%set_mu(cb) call tp%set_mu(cb) if (param%in_form == "EL") then @@ -183,7 +193,7 @@ module subroutine swiftest_setup_initialize_system(self, param) tp%lfirst = param%lfirstkick if (.not.param%lrestart) then - call system%init_particle_info(param) + call nbody_system%init_particle_info(param) end if end associate diff --git a/src/swiftest/swiftest_user.f90 b/src/swiftest/swiftest_user.f90 index 9d9c30783..927455729 100644 --- a/src/swiftest/swiftest_user.f90 +++ b/src/swiftest/swiftest_user.f90 @@ -10,7 +10,7 @@ submodule(swiftest) s_user_kick_getacch use swiftest contains - module subroutine swiftest_user_kick_getacch_body(self, system, param, t, lbeg) + module subroutine swiftest_user_kick_getacch_body(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Add user-supplied heliocentric accelerations to planets. @@ -19,7 +19,7 @@ module subroutine swiftest_user_kick_getacch_body(self, system, param, t, lbeg) implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! Swiftest massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody_system_object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody_system_object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters user parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the ste diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index ea7a33bb8..b94dbbd07 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -1215,7 +1215,7 @@ end subroutine swiftest_util_flatten_eucl_pltp module subroutine swiftest_util_get_energy_momentum_system(self, param) !! author: David A. Minton !! - !! Compute total system angular momentum vector and kinetic, potential and total system energy + !! Compute total nbody_system angular momentum vector and kinetic, potential and total nbody_system energy !! !! Adapted from David E. Kaufmann Swifter routine symba_energy_eucl.f90 !! @@ -1232,12 +1232,12 @@ module subroutine swiftest_util_get_energy_momentum_system(self, param) real(DP), dimension(NDIM) :: Lcborbit, Lcbspin real(DP) :: hx, hy, hz - associate(system => self, pl => self%pl, npl => self%pl%nbody, cb => self%cb) - system%Lorbit(:) = 0.0_DP - system%Lspin(:) = 0.0_DP - system%Ltot(:) = 0.0_DP - system%ke_orbit = 0.0_DP - system%ke_spin = 0.0_DP + associate(nbody_system => self, pl => self%pl, npl => self%pl%nbody, cb => self%cb) + nbody_system%Lorbit(:) = 0.0_DP + nbody_system%Lspin(:) = 0.0_DP + nbody_system%Ltot(:) = 0.0_DP + nbody_system%ke_orbit = 0.0_DP + nbody_system%ke_spin = 0.0_DP kepl(:) = 0.0_DP Lplorbitx(:) = 0.0_DP @@ -1249,7 +1249,7 @@ module subroutine swiftest_util_get_energy_momentum_system(self, param) pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE - system%GMtot = cb%Gmass + sum(pl%Gmass(1:npl), pl%lmask(1:npl)) + nbody_system%GMtot = cb%Gmass + sum(pl%Gmass(1:npl), pl%lmask(1:npl)) kecb = cb%mass * dot_product(cb%vb(:), cb%vb(:)) Lcborbit(:) = cb%mass * (cb%rb(:) .cross. cb%vb(:)) @@ -1289,32 +1289,32 @@ module subroutine swiftest_util_get_energy_momentum_system(self, param) end if if (param%lflatten_interactions) then - call swiftest_util_get_energy_potential_flat(npl, pl%nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, system%pe) + call swiftest_util_get_energy_potential_flat(npl, pl%nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, nbody_system%pe) else - call swiftest_util_get_energy_potential_triangular(npl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, system%pe) + call swiftest_util_get_energy_potential_triangular(npl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, nbody_system%pe) end if ! Potential energy from the oblateness term if (param%loblatecb) then - call system%obl_pot() - system%pe = system%pe + system%oblpot + call nbody_system%obl_pot() + nbody_system%pe = nbody_system%pe + nbody_system%oblpot end if - system%ke_orbit = 0.5_DP * (kecb + sum(kepl(1:npl), pl%lmask(1:npl))) - if (param%lrotation) system%ke_spin = 0.5_DP * (kespincb + sum(kespinpl(1:npl), pl%lmask(1:npl))) + nbody_system%ke_orbit = 0.5_DP * (kecb + sum(kepl(1:npl), pl%lmask(1:npl))) + if (param%lrotation) nbody_system%ke_spin = 0.5_DP * (kespincb + sum(kespinpl(1:npl), pl%lmask(1:npl))) - system%Lorbit(1) = Lcborbit(1) + sum(Lplorbitx(1:npl), pl%lmask(1:npl)) - system%Lorbit(2) = Lcborbit(2) + sum(Lplorbity(1:npl), pl%lmask(1:npl)) - system%Lorbit(3) = Lcborbit(3) + sum(Lplorbitz(1:npl), pl%lmask(1:npl)) + nbody_system%Lorbit(1) = Lcborbit(1) + sum(Lplorbitx(1:npl), pl%lmask(1:npl)) + nbody_system%Lorbit(2) = Lcborbit(2) + sum(Lplorbity(1:npl), pl%lmask(1:npl)) + nbody_system%Lorbit(3) = Lcborbit(3) + sum(Lplorbitz(1:npl), pl%lmask(1:npl)) if (param%lrotation) then - system%Lspin(1) = Lcbspin(1) + sum(Lplspinx(1:npl), pl%lmask(1:npl)) - system%Lspin(2) = Lcbspin(2) + sum(Lplspiny(1:npl), pl%lmask(1:npl)) - system%Lspin(3) = Lcbspin(3) + sum(Lplspinz(1:npl), pl%lmask(1:npl)) + nbody_system%Lspin(1) = Lcbspin(1) + sum(Lplspinx(1:npl), pl%lmask(1:npl)) + nbody_system%Lspin(2) = Lcbspin(2) + sum(Lplspiny(1:npl), pl%lmask(1:npl)) + nbody_system%Lspin(3) = Lcbspin(3) + sum(Lplspinz(1:npl), pl%lmask(1:npl)) end if - system%te = system%ke_orbit + system%ke_spin + system%pe - system%Ltot(:) = system%Lorbit(:) + system%Lspin(:) + nbody_system%te = nbody_system%ke_orbit + nbody_system%ke_spin + nbody_system%pe + nbody_system%Ltot(:) = nbody_system%Lorbit(:) + nbody_system%Lspin(:) end associate return @@ -1324,7 +1324,7 @@ end subroutine swiftest_util_get_energy_momentum_system subroutine swiftest_util_get_energy_potential_flat(npl, nplpl, k_plpl, lmask, GMcb, Gmass, mass, rb, pe) !! author: David A. Minton !! - !! Compute total system potential energy + !! Compute total nbody_system potential energy implicit none ! Arguments integer(I4B), intent(in) :: npl @@ -1376,7 +1376,7 @@ end subroutine swiftest_util_get_energy_potential_flat subroutine swiftest_util_get_energy_potential_triangular(npl, lmask, GMcb, Gmass, mass, rb, pe) !! author: David A. Minton !! - !! Compute total system potential energy + !! Compute total nbody_system potential energy implicit none ! Arguments integer(I4B), intent(in) :: npl @@ -1606,17 +1606,17 @@ subroutine swiftest_util_peri(n,m, r, v, atp, q, isperi) end subroutine swiftest_util_peri - module subroutine swiftest_util_peri_body(self, system, param) + module subroutine swiftest_util_peri_body(self, nbody_system, param) !! author: David A. Minton !! - !! Determine system pericenter passages for bodies + !! Determine nbody_system pericenter passages for bodies !! !! Adapted from David E. Kaufmann's Swifter routine: symba_peri.f90 !! Adapted from Hal Levison's Swift routine util_mass_peri.f implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i @@ -1629,14 +1629,14 @@ module subroutine swiftest_util_peri_body(self, system, param) if (param%qmin_coord == "HELIO") then call swiftest_util_peri(self%nbody, self%mu, self%rh, self%vh, self%atp, self%peri, self%isperi) else - call swiftest_util_peri(self%nbody, [(system%Gmtot,i=1,self%nbody)], self%rb, self%vb, self%atp, self%peri, self%isperi) + call swiftest_util_peri(self%nbody, [(nbody_system%Gmtot,i=1,self%nbody)], self%rb, self%vb, self%atp, self%peri, self%isperi) end if return end subroutine swiftest_util_peri_body - module subroutine swiftest_util_rearray_pl(self, system, param) + module subroutine swiftest_util_rearray_pl(self, nbody_system, param) !! Author: the Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Clean up the massive body structures to remove discarded bodies and add new bodies @@ -1644,7 +1644,7 @@ module subroutine swiftest_util_rearray_pl(self, system, param) implicit none ! Arguments class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals class(swiftest_pl), allocatable :: tmp !! The discarded body list. @@ -1655,7 +1655,7 @@ module subroutine swiftest_util_rearray_pl(self, system, param) integer(I4B), dimension(:), allocatable :: levelg_orig_pl, levelm_orig_pl, levelg_orig_tp, levelm_orig_tp integer(I4B), dimension(:), allocatable :: nplenc_orig_pl, nplenc_orig_tp, ntpenc_orig_pl - associate(pl => self, tp => system%tp, pl_adds => system%pl_adds) + associate(pl => self, tp => nbody_system%tp, pl_adds => nbody_system%pl_adds) npl = pl%nbody nadd = pl_adds%nbody @@ -1664,7 +1664,7 @@ module subroutine swiftest_util_rearray_pl(self, system, param) if (allocated(pl%rbeg)) deallocate(pl%rbeg) if (allocated(pl%rend)) deallocate(pl%rend) - ! Remove the discards and destroy the list, as the system already tracks pl_discards elsewhere + ! Remove the discards and destroy the list, as the nbody_system already tracks pl_discards elsewhere allocate(lmask(npl)) lmask(1:npl) = pl%ldiscard(1:npl) if (count(lmask(:)) > 0) then @@ -1677,10 +1677,10 @@ module subroutine swiftest_util_rearray_pl(self, system, param) end if ! Store the original plplenc list so we don't remove any of the original encounters - nenc_old = system%plpl_encounter%nenc + nenc_old = nbody_system%plpl_encounter%nenc if (nenc_old > 0) then - allocate(plplenc_old, source=system%plpl_encounter) - call plplenc_old%copy(system%plpl_encounter) + allocate(plplenc_old, source=nbody_system%plpl_encounter) + call plplenc_old%copy(nbody_system%plpl_encounter) end if ! Add in any new bodies @@ -1728,8 +1728,8 @@ module subroutine swiftest_util_rearray_pl(self, system, param) ! Re-build the encounter list - ! Be sure to get the level info if this is a SyMBA system - select type(system) + ! Be sure to get the level info if this is a SyMBA nbody_system + select type(nbody_system) class is (symba_nbody_system) select type(pl) class is (symba_pl) @@ -1741,13 +1741,13 @@ module subroutine swiftest_util_rearray_pl(self, system, param) call move_alloc(levelg_orig_pl, pl%levelg) call move_alloc(levelm_orig_pl, pl%levelm) call move_alloc(nplenc_orig_pl, pl%nplenc) - lencounter = pl%encounter_check(param, system, param%dt, system%irec) + lencounter = pl%encounter_check(param, nbody_system, param%dt, nbody_system%irec) if (tp%nbody > 0) then allocate(levelg_orig_tp, source=tp%levelg) allocate(levelm_orig_tp, source=tp%levelm) allocate(nplenc_orig_tp, source=tp%nplenc) allocate(ntpenc_orig_pl, source=pl%ntpenc) - lencounter = tp%encounter_check(param, system, param%dt, system%irec) + lencounter = tp%encounter_check(param, nbody_system, param%dt, nbody_system%irec) call move_alloc(levelg_orig_tp, tp%levelg) call move_alloc(levelm_orig_tp, tp%levelm) call move_alloc(nplenc_orig_tp, tp%nplenc) @@ -1760,64 +1760,64 @@ module subroutine swiftest_util_rearray_pl(self, system, param) ! Re-index the encounter list as the index values may have changed if (nenc_old > 0) then - nencmin = min(system%plpl_encounter%nenc, plplenc_old%nenc) - system%plpl_encounter%nenc = nencmin + nencmin = min(nbody_system%plpl_encounter%nenc, plplenc_old%nenc) + nbody_system%plpl_encounter%nenc = nencmin do k = 1, nencmin - idnew1 = system%plpl_encounter%id1(k) - idnew2 = system%plpl_encounter%id2(k) + idnew1 = nbody_system%plpl_encounter%id1(k) + idnew2 = nbody_system%plpl_encounter%id2(k) idold1 = plplenc_old%id1(k) idold2 = plplenc_old%id2(k) if ((idnew1 == idold1) .and. (idnew2 == idold2)) then ! This is an encounter we already know about, so save the old information - system%plpl_encounter%lvdotr(k) = plplenc_old%lvdotr(k) - system%plpl_encounter%lclosest(k) = plplenc_old%lclosest(k) - system%plpl_encounter%status(k) = plplenc_old%status(k) - system%plpl_encounter%r1(:,k) = plplenc_old%r1(:,k) - system%plpl_encounter%r2(:,k) = plplenc_old%r2(:,k) - system%plpl_encounter%v1(:,k) = plplenc_old%v1(:,k) - system%plpl_encounter%v2(:,k) = plplenc_old%v2(:,k) - system%plpl_encounter%tcollision(k) = plplenc_old%tcollision(k) - system%plpl_encounter%level(k) = plplenc_old%level(k) + nbody_system%plpl_encounter%lvdotr(k) = plplenc_old%lvdotr(k) + nbody_system%plpl_encounter%lclosest(k) = plplenc_old%lclosest(k) + nbody_system%plpl_encounter%status(k) = plplenc_old%status(k) + nbody_system%plpl_encounter%r1(:,k) = plplenc_old%r1(:,k) + nbody_system%plpl_encounter%r2(:,k) = plplenc_old%r2(:,k) + nbody_system%plpl_encounter%v1(:,k) = plplenc_old%v1(:,k) + nbody_system%plpl_encounter%v2(:,k) = plplenc_old%v2(:,k) + nbody_system%plpl_encounter%tcollision(k) = plplenc_old%tcollision(k) + nbody_system%plpl_encounter%level(k) = plplenc_old%level(k) else if (((idnew1 == idold2) .and. (idnew2 == idold1))) then ! This is an encounter we already know about, but with the order reversed, so save the old information - system%plpl_encounter%lvdotr(k) = plplenc_old%lvdotr(k) - system%plpl_encounter%lclosest(k) = plplenc_old%lclosest(k) - system%plpl_encounter%status(k) = plplenc_old%status(k) - system%plpl_encounter%r1(:,k) = plplenc_old%r2(:,k) - system%plpl_encounter%r2(:,k) = plplenc_old%r1(:,k) - system%plpl_encounter%v1(:,k) = plplenc_old%v2(:,k) - system%plpl_encounter%v2(:,k) = plplenc_old%v1(:,k) - system%plpl_encounter%tcollision(k) = plplenc_old%tcollision(k) - system%plpl_encounter%level(k) = plplenc_old%level(k) + nbody_system%plpl_encounter%lvdotr(k) = plplenc_old%lvdotr(k) + nbody_system%plpl_encounter%lclosest(k) = plplenc_old%lclosest(k) + nbody_system%plpl_encounter%status(k) = plplenc_old%status(k) + nbody_system%plpl_encounter%r1(:,k) = plplenc_old%r2(:,k) + nbody_system%plpl_encounter%r2(:,k) = plplenc_old%r1(:,k) + nbody_system%plpl_encounter%v1(:,k) = plplenc_old%v2(:,k) + nbody_system%plpl_encounter%v2(:,k) = plplenc_old%v1(:,k) + nbody_system%plpl_encounter%tcollision(k) = plplenc_old%tcollision(k) + nbody_system%plpl_encounter%level(k) = plplenc_old%level(k) end if - system%plpl_encounter%index1(k) = findloc(pl%id(1:npl), system%plpl_encounter%id1(k), dim=1) - system%plpl_encounter%index2(k) = findloc(pl%id(1:npl), system%plpl_encounter%id2(k), dim=1) + nbody_system%plpl_encounter%index1(k) = findloc(pl%id(1:npl), nbody_system%plpl_encounter%id1(k), dim=1) + nbody_system%plpl_encounter%index2(k) = findloc(pl%id(1:npl), nbody_system%plpl_encounter%id2(k), dim=1) end do if (allocated(lmask)) deallocate(lmask) allocate(lmask(nencmin)) nenc_old = nencmin - if (any(system%plpl_encounter%index1(1:nencmin) == 0) .or. any(system%plpl_encounter%index2(1:nencmin) == 0)) then - lmask(:) = system%plpl_encounter%index1(1:nencmin) /= 0 .and. system%plpl_encounter%index2(1:nencmin) /= 0 + if (any(nbody_system%plpl_encounter%index1(1:nencmin) == 0) .or. any(nbody_system%plpl_encounter%index2(1:nencmin) == 0)) then + lmask(:) = nbody_system%plpl_encounter%index1(1:nencmin) /= 0 .and. nbody_system%plpl_encounter%index2(1:nencmin) /= 0 else return end if nencmin = count(lmask(:)) - system%plpl_encounter%nenc = nencmin + nbody_system%plpl_encounter%nenc = nencmin if (nencmin > 0) then - system%plpl_encounter%index1(1:nencmin) = pack(system%plpl_encounter%index1(1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%index2(1:nencmin) = pack(system%plpl_encounter%index2(1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%id1(1:nencmin) = pack(system%plpl_encounter%id1(1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%id2(1:nencmin) = pack(system%plpl_encounter%id2(1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%lvdotr(1:nencmin) = pack(system%plpl_encounter%lvdotr(1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%lclosest(1:nencmin) = pack(system%plpl_encounter%lclosest(1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%status(1:nencmin) = pack(system%plpl_encounter%status(1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%tcollision(1:nencmin) = pack(system%plpl_encounter%tcollision(1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%level(1:nencmin) = pack(system%plpl_encounter%level(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%index1(1:nencmin) = pack(nbody_system%plpl_encounter%index1(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%index2(1:nencmin) = pack(nbody_system%plpl_encounter%index2(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%id1(1:nencmin) = pack(nbody_system%plpl_encounter%id1(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%id2(1:nencmin) = pack(nbody_system%plpl_encounter%id2(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%lvdotr(1:nencmin) = pack(nbody_system%plpl_encounter%lvdotr(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%lclosest(1:nencmin) = pack(nbody_system%plpl_encounter%lclosest(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%status(1:nencmin) = pack(nbody_system%plpl_encounter%status(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%tcollision(1:nencmin) = pack(nbody_system%plpl_encounter%tcollision(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%level(1:nencmin) = pack(nbody_system%plpl_encounter%level(1:nenc_old), lmask(1:nenc_old)) do i = 1, NDIM - system%plpl_encounter%r1(i, 1:nencmin) = pack(system%plpl_encounter%r1(i, 1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%r2(i, 1:nencmin) = pack(system%plpl_encounter%r2(i, 1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%v1(i, 1:nencmin) = pack(system%plpl_encounter%v1(i, 1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%v2(i, 1:nencmin) = pack(system%plpl_encounter%v2(i, 1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%r1(i, 1:nencmin) = pack(nbody_system%plpl_encounter%r1(i, 1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%r2(i, 1:nencmin) = pack(nbody_system%plpl_encounter%r2(i, 1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%v1(i, 1:nencmin) = pack(nbody_system%plpl_encounter%v1(i, 1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%v2(i, 1:nencmin) = pack(nbody_system%plpl_encounter%v2(i, 1:nenc_old), lmask(1:nenc_old)) end do end if end if @@ -1831,7 +1831,7 @@ module subroutine swiftest_util_rescale_system(self, param, mscale, dscale, tsca !! author: David A. Minton !! !! Rescales an nbody system to a new set of units. Inputs are the multipliers on the mass (mscale), distance (dscale), and time units (tscale). - !! Rescales all united quantities in the system, as well as the mass conversion factors, gravitational constant, and Einstein's constant in the parameter object. + !! Rescales all united quantities in the nbody_system, as well as the mass conversion factors, gravitational constant, and Einstein's constant in the parameter object. implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters. Returns with new values of the scale vactors and GU @@ -1843,11 +1843,11 @@ module subroutine swiftest_util_rescale_system(self, param, mscale, dscale, tsca param%DU2M = param%DU2M * dscale param%TU2S = param%TU2S * tscale - ! Calculate the G for the system units + ! Calculate the G for the nbody_system units param%GU = GC / (param%DU2M**3 / (param%MU2KG * param%TU2S**2)) if (param%lgr) then - ! Calculate the inverse speed of light in the system units + ! Calculate the inverse speed of light in the nbody_system units param%inv_c2 = einsteinC * param%TU2S / param%DU2M param%inv_c2 = (param%inv_c2)**(-2) end if @@ -2357,10 +2357,10 @@ end subroutine swiftest_util_set_ir3h module subroutine swiftest_util_set_msys(self) !! author: David A. Minton !! - !! Sets the value of msys and the vector mass quantities based on the total mass of the system + !! Sets the value of msys and the vector mass quantities based on the total mass of the nbody_system implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nobdy system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nobdy nbody_system object self%Gmtot = self%cb%Gmass + sum(self%pl%Gmass(1:self%pl%nbody), self%pl%status(1:self%pl%nbody) /= INACTIVE) @@ -2541,24 +2541,24 @@ module subroutine swiftest_util_set_rhill_approximate(self,cb) end subroutine swiftest_util_set_rhill_approximate - module subroutine swiftest_util_snapshot_system(self, param, system, t, arg) + module subroutine swiftest_util_snapshot_system(self, param, nbody_system, t, arg) !! author: David A. Minton !! - !! Takes a snapshot of the system for later file storage + !! Takes a snapshot of the nbody_system for later file storage implicit none ! Arguments class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from nbody_system time character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) self%iframe = self%iframe + 1 self%nt = self%iframe - self%frame(self%iframe) = system ! Store a snapshot of the system for posterity + self%frame(self%iframe) = nbody_system ! Store a snapshot of the nbody_system for posterity self%nid = self%nid + 1 ! Central body - if (allocated(system%pl)) self%nid = self%nid + system%pl%nbody - if (allocated(system%tp)) self%nid = self%nid + system%tp%nbody + if (allocated(nbody_system%pl)) self%nid = self%nid + nbody_system%pl%nbody + if (allocated(nbody_system%tp)) self%nid = self%nid + nbody_system%tp%nbody return end subroutine swiftest_util_snapshot_system diff --git a/src/symba/symba_discard.f90 b/src/symba/symba_discard.f90 index 5cdf5eab5..cdeeeb0fe 100644 --- a/src/symba/symba_discard.f90 +++ b/src/symba/symba_discard.f90 @@ -11,7 +11,7 @@ use swiftest contains - subroutine symba_discard_cb_pl(pl, system, param) + subroutine symba_discard_cb_pl(pl, nbody_system, param) !! author: David A. Minton !! !! Check to see if planets should be discarded based on their positions relative to the central body. @@ -24,15 +24,15 @@ subroutine symba_discard_cb_pl(pl, system, param) implicit none ! Arguments class(symba_pl), intent(inout) :: pl !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i real(DP) :: energy, vb2, rb2, rh2, rmin2, rmax2, rmaxu2 character(len=STRMAX) :: idstr, timestr, message - associate(npl => pl%nbody, cb => system%cb) - call system%set_msys() + associate(npl => pl%nbody, cb => nbody_system%cb) + call nbody_system%set_msys() rmin2 = param%rmin**2 rmax2 = param%rmax**2 rmaxu2 = param%rmaxu**2 @@ -44,55 +44,55 @@ subroutine symba_discard_cb_pl(pl, system, param) pl%lcollision(i) = .false. pl%status(i) = DISCARDED_RMAX write(idstr, *) pl%id(i) - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too far from the central body at t = " // trim(adjustl(timestr)) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & "***********************************************************") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & "***********************************************************") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") - call pl%info(i)%set_value(status="DISCARDED_RMAX", discard_time=system%t, discard_rh=pl%rh(:,i), & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call pl%info(i)%set_value(status="DISCARDED_RMAX", discard_time=nbody_system%t, discard_rh=pl%rh(:,i), & discard_vh=pl%vh(:,i)) else if ((param%rmin >= 0.0_DP) .and. (rh2 < rmin2)) then pl%ldiscard(i) = .true. pl%lcollision(i) = .false. pl%status(i) = DISCARDED_RMIN write(idstr, *) pl%id(i) - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too close to the central body at t = " // trim(adjustl(timestr)) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "************************************************************" // & "************************************************************") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "************************************************************" // & "************************************************************") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") - call pl%info(i)%set_value(status="DISCARDED_RMIN", discard_time=system%t, discard_rh=pl%rh(:,i), & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call pl%info(i)%set_value(status="DISCARDED_RMIN", discard_time=nbody_system%t, discard_rh=pl%rh(:,i), & discard_vh=pl%vh(:,i), discard_body_id=cb%id) else if (param%rmaxu >= 0.0_DP) then rb2 = dot_product(pl%rb(:,i), pl%rb(:,i)) vb2 = dot_product(pl%vb(:,i), pl%vb(:,i)) - energy = 0.5_DP * vb2 - system%Gmtot / sqrt(rb2) + energy = 0.5_DP * vb2 - nbody_system%Gmtot / sqrt(rb2) if ((energy > 0.0_DP) .and. (rb2 > rmaxu2)) then pl%ldiscard(i) = .true. pl%lcollision(i) = .false. pl%status(i) = DISCARDED_RMAXU write(idstr, *) pl%id(i) - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " is unbound and too far from barycenter at t = " // trim(adjustl(timestr)) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "************************************************************" // & "************************************************************") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "************************************************************" // & "************************************************************") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") - call pl%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=system%t, discard_rh=pl%rh(:,i), & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call pl%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=nbody_system%t, discard_rh=pl%rh(:,i), & discard_vh=pl%vh(:,i)) end if end if @@ -104,14 +104,14 @@ subroutine symba_discard_cb_pl(pl, system, param) end subroutine symba_discard_cb_pl - subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) + subroutine symba_discard_conserve_mtm(pl, nbody_system, param, ipl, lescape_body) !! author: David A. Minton !! - !! Conserves system momentum when a body is lost from the system or collides with central body + !! Conserves nbody_system momentum when a body is lost from the nbody_system or collides with central body implicit none ! Arguments class(symba_pl), intent(inout) :: pl - class(symba_nbody_system), intent(inout) :: system + class(symba_nbody_system), intent(inout) :: nbody_system class(swiftest_parameters), intent(inout) :: param integer(I4B), intent(in) :: ipl logical, intent(in) :: lescape_body @@ -120,7 +120,7 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) real(DP) :: pe, ke_orbit, ke_spin integer(I4B) :: i, oldstat - select type(cb => system%cb) + select type(cb => nbody_system%cb) class is (symba_cb) ! Add the potential and kinetic energy of the lost body to the records @@ -135,7 +135,7 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) ! Add the pre-collision ke of the central body to the records ! Add planet mass to central body accumulator if (lescape_body) then - system%GMescape = system%GMescape + pl%Gmass(ipl) + nbody_system%GMescape = nbody_system%GMescape + pl%Gmass(ipl) do i = 1, pl%nbody if (i == ipl) cycle pe = pe - pl%Gmass(i) * pl%mass(ipl) / norm2(pl%rb(:, ipl) - pl%rb(:, i)) @@ -158,8 +158,8 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) Ltot(:) = Ltot(:) - Lpl(:) end do Ltot(:) = Ltot(:) - cb%mass * (cb%rb(:) .cross. cb%vb(:)) - system%Lescape(:) = system%Lescape(:) + Ltot(:) - if (param%lrotation) system%Lescape(:) = system%Lescape + pl%mass(ipl) * pl%radius(ipl)**2 & + nbody_system%Lescape(:) = nbody_system%Lescape(:) + Ltot(:) + if (param%lrotation) nbody_system%Lescape(:) = nbody_system%Lescape + pl%mass(ipl) * pl%radius(ipl)**2 & * pl%Ip(3, ipl) * pl%rot(:, ipl) else @@ -194,11 +194,11 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) ! We must do this for proper book-keeping, since we can no longer track this body's contribution to energy directly if (lescape_body) then - system%Ecollisions = system%Ecollisions + ke_orbit + ke_spin + pe - system%Euntracked = system%Euntracked - (ke_orbit + ke_spin + pe) + nbody_system%Ecollisions = nbody_system%Ecollisions + ke_orbit + ke_spin + pe + nbody_system%Euntracked = nbody_system%Euntracked - (ke_orbit + ke_spin + pe) else - system%Ecollisions = system%Ecollisions + pe - system%Euntracked = system%Euntracked - pe + nbody_system%Ecollisions = nbody_system%Ecollisions + pe + nbody_system%Euntracked = nbody_system%Euntracked - pe end if end select @@ -206,7 +206,7 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) end subroutine symba_discard_conserve_mtm - subroutine symba_discard_nonplpl(pl, system, param) + subroutine symba_discard_nonplpl(pl, nbody_system, param) !! author: David A. Minton !! !! Check to see if planets should be discarded based on their positions or because they are unbound @@ -217,7 +217,7 @@ subroutine symba_discard_nonplpl(pl, system, param) implicit none ! Arguments class(symba_pl), intent(inout) :: pl !! SyMBA test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals logical, dimension(pl%nbody) :: ldiscard @@ -225,12 +225,12 @@ subroutine symba_discard_nonplpl(pl, system, param) class(symba_pl), allocatable :: plsub ! First check for collisions with the central body - associate(npl => pl%nbody, cb => system%cb, pl_discards => system%pl_discards) + associate(npl => pl%nbody, cb => nbody_system%cb, pl_discards => nbody_system%pl_discards) if (npl == 0) return if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. (param%rmaxu >= 0.0_DP)) then - call symba_discard_cb_pl(pl, system, param) + call symba_discard_cb_pl(pl, nbody_system, param) end if - if (param%qmin >= 0.0_DP) call symba_discard_peri_pl(pl, system, param) + if (param%qmin >= 0.0_DP) call symba_discard_peri_pl(pl, nbody_system, param) if (any(pl%ldiscard(1:npl))) then ldiscard(1:npl) = pl%ldiscard(1:npl) @@ -248,15 +248,15 @@ subroutine symba_discard_nonplpl(pl, system, param) end subroutine symba_discard_nonplpl - subroutine symba_discard_nonplpl_conservation(pl, system, param) + subroutine symba_discard_nonplpl_conservation(pl, nbody_system, param) !! author: David A. Minton !! !! If there are any bodies that are removed due to either colliding with the central body or escaping the systme, - !! we need to track the conserved quantities with the system bookkeeping terms. + !! we need to track the conserved quantities with the nbody_system bookkeeping terms. implicit none ! Arguments class(symba_pl), intent(inout) :: pl !! SyMBA test particle object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, ndiscard, dstat @@ -279,7 +279,7 @@ subroutine symba_discard_nonplpl_conservation(pl, system, param) cycle end if ! Conserve all the quantities - call symba_discard_conserve_mtm(pl, system, param, discard_index_list(i), lescape) + call symba_discard_conserve_mtm(pl, nbody_system, param, discard_index_list(i), lescape) end do end associate @@ -287,7 +287,7 @@ subroutine symba_discard_nonplpl_conservation(pl, system, param) end subroutine symba_discard_nonplpl_conservation - subroutine symba_discard_peri_pl(pl, system, param) + subroutine symba_discard_peri_pl(pl, nbody_system, param) !! author: David A. Minton !! !! Check to see if a test particle should be discarded because its perihelion distance becomes too small @@ -297,7 +297,7 @@ subroutine symba_discard_peri_pl(pl, system, param) implicit none ! Arguments class(symba_pl), intent(inout) :: pl !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals logical, save :: lfirst = .true. @@ -309,10 +309,10 @@ subroutine symba_discard_peri_pl(pl, system, param) lfirst_orig = pl%lfirst pl%lfirst = lfirst if (lfirst) then - call pl%get_peri(system, param) + call pl%get_peri(nbody_system, param) lfirst = .false. else - call pl%get_peri(system, param) + call pl%get_peri(nbody_system, param) do i = 1, pl%nbody if (pl%status(i) == ACTIVE) then if ((pl%isperi(i) == 0) .and. (pl%nplenc(i)== 0)) then @@ -320,12 +320,12 @@ subroutine symba_discard_peri_pl(pl, system, param) pl%ldiscard(i) = .true. pl%lcollision(i) = .false. pl%status(i) = DISCARDED_PERI - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(idstr, *) pl%id(i) write(*, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // & ") perihelion distance too small at t = " // trim(adjustl(timestr)) - call pl%info(i)%set_value(status="DISCARDED_PERI", discard_time=system%t, & - discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), discard_body_id=system%cb%id) + call pl%info(i)%set_value(status="DISCARDED_PERI", discard_time=nbody_system%t, & + discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), discard_body_id=nbody_system%cb%id) end if end if end if @@ -337,47 +337,47 @@ subroutine symba_discard_peri_pl(pl, system, param) end subroutine symba_discard_peri_pl - module subroutine symba_discard_pl(self, system, param) + module subroutine symba_discard_pl(self, nbody_system, param) !! author: David A. Minton !! - !! Call the various flavors of discards for massive bodies in SyMBA runs, including discards due to colliding with the central body or escaping the system + !! Call the various flavors of discards for massive bodies in SyMBA runs, including discards due to colliding with the central body or escaping the nbody_system implicit none ! Arguments class(symba_pl), intent(inout) :: self !! SyMBA test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals real(DP) :: Eorbit_before, Eorbit_after - select type(system) + select type(nbody_system) class is (symba_nbody_system) select type(param) class is (swiftest_parameters) - associate(pl => self, plpl_encounter => system%plpl_encounter, plpl_collision => system%plpl_collision) - call pl%vb2vh(system%cb) - call pl%rh2rb(system%cb) + associate(pl => self, plpl_encounter => nbody_system%plpl_encounter, plpl_collision => nbody_system%plpl_collision) + call pl%vb2vh(nbody_system%cb) + call pl%rh2rb(nbody_system%cb) !call plpl_encounter%write(pl, pl, param) TODO: write the encounter list writer for NetCDF - call symba_discard_nonplpl(self, system, param) + call symba_discard_nonplpl(self, nbody_system, param) if (.not.any(pl%ldiscard(:))) return if (param%lenergy) then - call system%get_energy_and_momentum(param) - Eorbit_before = system%te + call nbody_system%get_energy_and_momentum(param) + Eorbit_before = nbody_system%te end if - call symba_discard_nonplpl_conservation(self, system, param) + call symba_discard_nonplpl_conservation(self, nbody_system, param) ! Save the add/discard information to file - call system%write_discard(param) + call nbody_system%write_discard(param) - call pl%rearray(system, param) + call pl%rearray(nbody_system, param) if (param%lenergy) then - call system%get_energy_and_momentum(param) - Eorbit_after = system%te - system%Ecollisions = system%Ecollisions + (Eorbit_after - Eorbit_before) + call nbody_system%get_energy_and_momentum(param) + Eorbit_after = nbody_system%te + nbody_system%Ecollisions = nbody_system%Ecollisions + (Eorbit_after - Eorbit_before) end if end associate diff --git a/src/symba/symba_drift.f90 b/src/symba/symba_drift.f90 index 126196c6c..e6cc0e761 100644 --- a/src/symba/symba_drift.f90 +++ b/src/symba/symba_drift.f90 @@ -11,23 +11,23 @@ use swiftest contains - module subroutine symba_drift_pl(self, system, param, dt) + module subroutine symba_drift_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Wrapper function used to call the body drift routine from a symba_pl structure implicit none ! Arguments class(symba_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize if (self%nbody == 0) return associate(pl => self, npl => self%nbody) - select type(system) + select type(nbody_system) class is (symba_nbody_system) - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec - call helio_drift_body(pl, system, param, dt) + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == nbody_system%irec + call helio_drift_body(pl, nbody_system, param, dt) pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE end select end associate @@ -36,23 +36,23 @@ module subroutine symba_drift_pl(self, system, param, dt) end subroutine symba_drift_pl - module subroutine symba_drift_tp(self, system, param, dt) + module subroutine symba_drift_tp(self, nbody_system, param, dt) !! author: David A. Minton !! !! Wrapper function used to call the body drift routine from a symba_pl structure implicit none ! Arguments class(symba_tp), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize if (self%nbody == 0) return associate (tp => self, ntp => self%nbody) - select type(system) + select type(nbody_system) class is (symba_nbody_system) - tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec - call helio_drift_body(tp, system, param, dt) + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == nbody_system%irec + call helio_drift_body(tp, nbody_system, param, dt) tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE end select end associate diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index d0fc96990..c454fffb0 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -11,7 +11,7 @@ use swiftest contains - module function symba_encounter_check_pl(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_pl(self, param, nbody_system, dt, irec) result(lany_encounter) !! author: David A. Minton !! !! Check for an encounter between massive bodies. @@ -20,7 +20,7 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l ! Arguments class(symba_pl), intent(inout) :: self !! SyMBA test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level ! Result @@ -34,7 +34,7 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l lany_encounter = .false. if (self%nbody == 0) return - associate(pl => self, plpl_encounter => system%plpl_encounter, cb => system%cb) + associate(pl => self, plpl_encounter => nbody_system%plpl_encounter, cb => nbody_system%cb) npl = pl%nbody nplm = pl%nplm @@ -59,7 +59,7 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l if (lany_encounter) then do k = 1_I8B, nenc - plpl_encounter%t = system%t + plpl_encounter%t = nbody_system%t i = plpl_encounter%index1(k) j = plpl_encounter%index2(k) plpl_encounter%id1(k) = pl%id(i) @@ -87,11 +87,11 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l end function symba_encounter_check_pl - module function symba_encounter_check_list_plpl(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_list_plpl(self, param, nbody_system, dt, irec) result(lany_encounter) implicit none class(symba_list_plpl), intent(inout) :: self !! SyMBA pl-pl encounter list object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical :: lany_encounter !! Returns true if there is at least one close encounter @@ -105,7 +105,7 @@ module function symba_encounter_check_list_plpl(self, param, system, dt, irec) r lany_encounter = .false. if (self%nenc == 0) return - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (symba_pl) allocate(lencmask(self%nenc)) lencmask(:) = (self%status(1:self%nenc) == ACTIVE) .and. (self%level(1:self%nenc) == irec - 1) @@ -155,11 +155,11 @@ module function symba_encounter_check_list_plpl(self, param, system, dt, irec) r end function symba_encounter_check_list_plpl - module function symba_encounter_check_list_pltp(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_list_pltp(self, param, nbody_system, dt, irec) result(lany_encounter) implicit none class(symba_list_pltp), intent(inout) :: self !! SyMBA pl-tp encounter list object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical :: lany_encounter !! Returns true if there is at least one close encounter @@ -173,9 +173,9 @@ module function symba_encounter_check_list_pltp(self, param, system, dt, irec) r lany_encounter = .false. if (self%nenc == 0) return - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (symba_pl) - select type(tp => system%tp) + select type(tp => nbody_system%tp) class is (symba_tp) allocate(lencmask(self%nenc)) lencmask(:) = (self%status(1:self%nenc) == ACTIVE) .and. (self%level(1:self%nenc) == irec - 1) @@ -226,7 +226,7 @@ module function symba_encounter_check_list_pltp(self, param, system, dt, irec) r end function symba_encounter_check_list_pltp - module function symba_encounter_check_tp(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_tp(self, param, nbody_system, dt, irec) result(lany_encounter) !! author: David A. Minton !! !! Check for an encounter between test particles and massive bodies. @@ -235,7 +235,7 @@ module function symba_encounter_check_tp(self, param, system, dt, irec) result(l ! Arguments class(symba_tp), intent(inout) :: self !! SyMBA test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level ! Result @@ -249,13 +249,13 @@ module function symba_encounter_check_tp(self, param, system, dt, irec) result(l lany_encounter = .false. if (self%nbody == 0) return - associate(tp => self, ntp => self%nbody, pl => system%pl, npl => system%pl%nbody) + associate(tp => self, ntp => self%nbody, pl => nbody_system%pl, npl => nbody_system%pl%nbody) call pl%set_renc(irec) call encounter_check_all_pltp(param, npl, ntp, pl%rh, pl%vb, tp%rh, tp%vb, pl%renc, dt, nenc, index1, index2, lvdotr) lany_encounter = nenc > 0 if (lany_encounter) then - associate(pltp_encounter => system%pltp_encounter) + associate(pltp_encounter => nbody_system%pltp_encounter) call pltp_encounter%resize(nenc) pltp_encounter%status(1:nenc) = ACTIVE pltp_encounter%level(1:nenc) = irec diff --git a/src/symba/symba_gr.f90 b/src/symba/symba_gr.f90 index 5457417e0..65a55c559 100644 --- a/src/symba/symba_gr.f90 +++ b/src/symba/symba_gr.f90 @@ -11,7 +11,7 @@ use swiftest contains - pure module subroutine symba_gr_p4_pl(self, system, param, dt) + pure module subroutine symba_gr_p4_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to massive bodies due to p**4 term in the post-Newtonian correction @@ -21,17 +21,17 @@ pure module subroutine symba_gr_p4_pl(self, system, param, dt) implicit none ! Arguments class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size if (self%nbody == 0) return associate(pl => self, npl => self%nbody) - select type(system) + select type(nbody_system) class is (symba_nbody_system) - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec - call helio_gr_p4_pl(pl, system, param, dt) + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == nbody_system%irec + call helio_gr_p4_pl(pl, nbody_system, param, dt) pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE end select end associate @@ -40,7 +40,7 @@ pure module subroutine symba_gr_p4_pl(self, system, param, dt) end subroutine symba_gr_p4_pl - pure module subroutine symba_gr_p4_tp(self, system, param, dt) + pure module subroutine symba_gr_p4_tp(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to test particles due to p**4 term in the post-Newtonian correction @@ -50,17 +50,17 @@ pure module subroutine symba_gr_p4_tp(self, system, param, dt) implicit none ! Arguments class(symba_tp), intent(inout) :: self !! SyMBA test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size if (self%nbody == 0) return associate(tp => self, ntp => self%nbody) - select type(system) + select type(nbody_system) class is (symba_nbody_system) - tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec - call helio_gr_p4_tp(tp, system, param, dt) + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == nbody_system%irec + call helio_gr_p4_tp(tp, nbody_system, param, dt) tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE end select end associate diff --git a/src/symba/symba_kick.f90 b/src/symba/symba_kick.f90 index 4e9cdd1d4..5ab8480d1 100644 --- a/src/symba/symba_kick.f90 +++ b/src/symba/symba_kick.f90 @@ -55,7 +55,7 @@ module subroutine symba_kick_getacch_int_pl(self, param) end subroutine symba_kick_getacch_int_pl - module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) + module subroutine symba_kick_getacch_pl(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of massive bodies @@ -65,7 +65,7 @@ module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) implicit none ! Arguments class(symba_pl), intent(inout) :: self !! SyMBA massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step @@ -75,11 +75,11 @@ module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) integer(I4B), dimension(:,:), allocatable :: k_plpl_enc if (self%nbody == 0) return - select type(system) + select type(nbody_system) class is (symba_nbody_system) - associate(pl => self, npl => self%nbody, nplm => self%nplm, plpl_encounter => system%plpl_encounter, radius => self%radius) + associate(pl => self, npl => self%nbody, nplm => self%nplm, plpl_encounter => nbody_system%plpl_encounter, radius => self%radius) ! Apply kicks to all bodies (including those in the encounter list) - call helio_kick_getacch_pl(pl, system, param, t, lbeg) + call helio_kick_getacch_pl(pl, nbody_system, param, t, lbeg) if (plpl_encounter%nenc > 0) then ! Remove kicks from bodies involved currently in the encounter list, as these are dealt with separately. ah_enc(:,:) = 0.0_DP @@ -98,7 +98,7 @@ module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) end subroutine symba_kick_getacch_pl - module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine symba_kick_getacch_tp(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of test particles @@ -108,7 +108,7 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) implicit none ! Arguments class(symba_tp), intent(inout) :: self !! SyMBA test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step @@ -118,11 +118,11 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) real(DP), dimension(NDIM) :: dx if (self%nbody == 0) return - select type(system) + select type(nbody_system) class is (symba_nbody_system) - associate(tp => self, cb => system%cb, pl => system%pl, & - pltp_encounter => system%pltp_encounter, npltpenc => system%pltp_encounter%nenc) - call helio_kick_getacch_tp(tp, system, param, t, lbeg) + associate(tp => self, cb => nbody_system%cb, pl => nbody_system%pl, & + pltp_encounter => nbody_system%pltp_encounter, npltpenc => nbody_system%pltp_encounter%nenc) + call helio_kick_getacch_tp(tp, nbody_system, param, t, lbeg) ! Remove accelerations from encountering pairs do k = 1, npltpenc i = pltp_encounter%index1(k) @@ -144,7 +144,7 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) end subroutine symba_kick_getacch_tp - module subroutine symba_kick_list_plpl(self, system, dt, irec, sgn) + module subroutine symba_kick_list_plpl(self, nbody_system, dt, irec, sgn) !! author: David A. Minton !! !! Kick barycentric velocities of massive bodies within SyMBA recursion. @@ -154,7 +154,7 @@ module subroutine symba_kick_list_plpl(self, system, dt, irec, sgn) implicit none ! Arguments class(symba_list_plpl), intent(in) :: self !! SyMBA pl-tp encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration @@ -168,7 +168,7 @@ module subroutine symba_kick_list_plpl(self, system, dt, irec, sgn) if (self%nenc == 0) return - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (symba_pl) associate(npl => pl%nbody, nenc => self%nenc) if (npl == 0) return @@ -249,7 +249,7 @@ module subroutine symba_kick_list_plpl(self, system, dt, irec, sgn) end subroutine symba_kick_list_plpl - module subroutine symba_kick_list_pltp(self, system, dt, irec, sgn) + module subroutine symba_kick_list_pltp(self, nbody_system, dt, irec, sgn) !! author: David A. Minton !! !! Kick barycentric velocities of ACTIVE test particles within SyMBA recursion. @@ -259,7 +259,7 @@ module subroutine symba_kick_list_pltp(self, system, dt, irec, sgn) implicit none ! Arguments class(symba_list_pltp), intent(in) :: self !! SyMBA pl-tp encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration @@ -273,9 +273,9 @@ module subroutine symba_kick_list_pltp(self, system, dt, irec, sgn) if (self%nenc == 0) return - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (symba_pl) - select type(tp => system%tp) + select type(tp => nbody_system%tp) class is (symba_tp) associate(npl => pl%nbody, ntp => tp%nbody, nenc => self%nenc) if ((npl == 0) .or. (ntp == 0)) return diff --git a/src/symba/symba_module.f90 b/src/symba/symba_module.f90 index f8d8db5ec..280fe2af8 100644 --- a/src/symba/symba_module.f90 +++ b/src/symba/symba_module.f90 @@ -93,93 +93,93 @@ module symba type, extends(helio_nbody_system) :: symba_nbody_system - integer(I4B) :: irec !! System recursion level + integer(I4B) :: irec !! nbody_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 :: set_recur_levels => symba_step_set_recur_levels_system !! Sets recursion levels of bodies and encounter lists to the current nbody_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 final :: symba_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system interface - module subroutine symba_discard_pl(self, system, param) + module subroutine symba_discard_pl(self, nbody_system, param) implicit none class(symba_pl), intent(inout) :: self !! SyMBA test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine symba_discard_pl - module subroutine symba_drift_pl(self, system, param, dt) + module subroutine symba_drift_pl(self, nbody_system, param, dt) implicit none class(symba_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize end subroutine symba_drift_pl - module subroutine symba_drift_tp(self, system, param, dt) + module subroutine symba_drift_tp(self, nbody_system, param, dt) implicit none class(symba_tp), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize end subroutine symba_drift_tp - module function symba_encounter_check_pl(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_pl(self, param, nbody_system, dt, irec) result(lany_encounter) implicit none class(symba_pl), intent(inout) :: self !! SyMBA test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical :: lany_encounter !! Returns true if there is at least one close encounter end function symba_encounter_check_pl - module function symba_encounter_check_list_plpl(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_list_plpl(self, param, nbody_system, dt, irec) result(lany_encounter) implicit none class(symba_list_plpl), intent(inout) :: self !! SyMBA pl-pl encounter list object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical :: lany_encounter !! Returns true if there is at least one close encounter end function symba_encounter_check_list_plpl - module function symba_encounter_check_list_pltp(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_list_pltp(self, param, nbody_system, dt, irec) result(lany_encounter) implicit none class(symba_list_pltp), intent(inout) :: self !! SyMBA pl-tp encounter list object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical :: lany_encounter !! Returns true if there is at least one close encounter end function symba_encounter_check_list_pltp - module function symba_encounter_check_tp(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_tp(self, param, nbody_system, dt, irec) result(lany_encounter) implicit none class(symba_tp), intent(inout) :: self !! SyMBA test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical :: lany_encounter !! Returns true if there is at least one close encounter end function symba_encounter_check_tp - pure module subroutine symba_gr_p4_pl(self, system, param, dt) + pure module subroutine symba_gr_p4_pl(self, nbody_system, param, dt) implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size end subroutine symba_gr_p4_pl - pure module subroutine symba_gr_p4_tp(self, system, param, dt) + pure module subroutine symba_gr_p4_tp(self, nbody_system, param, dt) implicit none class(symba_tp), intent(inout) :: self !! SyMBA test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size end subroutine symba_gr_p4_tp @@ -207,37 +207,37 @@ module subroutine symba_kick_getacch_int_pl(self, param) class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters end subroutine symba_kick_getacch_int_pl - module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) + module subroutine symba_kick_getacch_pl(self, nbody_system, param, t, lbeg) implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine symba_kick_getacch_pl - module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine symba_kick_getacch_tp(self, nbody_system, param, t, lbeg) implicit none class(symba_tp), intent(inout) :: self !! SyMBA test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine symba_kick_getacch_tp - module subroutine symba_kick_list_plpl(self, system, dt, irec, sgn) + module subroutine symba_kick_list_plpl(self, nbody_system, dt, irec, sgn) implicit none class(symba_list_plpl), intent(in) :: self !! SyMBA pl-tp encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration end subroutine symba_kick_list_plpl - module subroutine symba_kick_list_pltp(self, system, dt, irec, sgn) + module subroutine symba_kick_list_pltp(self, nbody_system, dt, irec, sgn) implicit none class(symba_list_pltp), intent(in) :: self !! SyMBA pl-tp encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration @@ -245,7 +245,7 @@ end subroutine symba_kick_list_pltp module subroutine symba_setup_initialize_system(self, param) implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA system object + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine symba_setup_initialize_system diff --git a/src/symba/symba_setup.f90 b/src/symba/symba_setup.f90 index f6207ac90..20e713c5c 100644 --- a/src/symba/symba_setup.f90 +++ b/src/symba/symba_setup.f90 @@ -19,15 +19,15 @@ module subroutine symba_setup_initialize_system(self, param) !! implicit none ! Arguments - class(symba_nbody_system), intent(inout) :: self !! SyMBA system object + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Call parent method - associate(system => self) - call helio_setup_initialize_system(system, param) - call system%pltp_encounter%setup(0_I8B) - call system%plpl_encounter%setup(0_I8B) - call system%plpl_collision%setup(0_I8B) + associate(nbody_system => self) + call helio_setup_initialize_system(nbody_system, param) + call nbody_system%pltp_encounter%setup(0_I8B) + call nbody_system%plpl_encounter%setup(0_I8B) + call nbody_system%plpl_collision%setup(0_I8B) end associate return diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 274dc5279..8d641485e 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -78,34 +78,34 @@ module subroutine symba_step_interp_system(self, param, t, dt) class is (symba_tp) select type(cb => self%cb) class is (symba_cb) - associate(system => self) + associate(nbody_system => self) dth = 0.5_DP * dt - system%irec = -1 + nbody_system%irec = -1 if (pl%lfirst) call pl%vh2vb(cb) call pl%lindrift(cb, dth, lbeg=.true.) - call pl%kick(system, param, t, dth, lbeg=.true.) - if (param%lgr) call pl%gr_pos_kick(system, param, dth) - call pl%drift(system, param, dt) + call pl%kick(nbody_system, param, t, dth, lbeg=.true.) + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) + call pl%drift(nbody_system, param, dt) if (tp%nbody > 0) then if (tp%lfirst) call tp%vh2vb(vbcb = -cb%ptbeg) call tp%lindrift(cb, dth, lbeg=.true.) - call tp%kick(system, param, t, dth, lbeg=.true.) - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%drift(system, param, dt) + call tp%kick(nbody_system, param, t, dth, lbeg=.true.) + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%drift(nbody_system, param, dt) end if - call system%recursive_step(param, t, 0) - system%irec = -1 + call nbody_system%recursive_step(param, t, 0) + nbody_system%irec = -1 - if (param%lgr) call pl%gr_pos_kick(system, param, dth) - call pl%kick(system, param, t, dth, lbeg=.false.) + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) + call pl%kick(nbody_system, param, t, dth, lbeg=.false.) call pl%lindrift(cb, dth, lbeg=.false.) call pl%vb2vh(cb) if (tp%nbody > 0) then - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%kick(system, param, t, dth, lbeg=.false.) + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%kick(nbody_system, param, t, dth, lbeg=.false.) call tp%lindrift(cb, dth, lbeg=.false.) call tp%vb2vh(vbcb = -cb%ptend) end if @@ -136,7 +136,7 @@ module subroutine symba_step_set_recur_levels_system(self, ireci) class is (symba_pl) select type(tp => self%tp) class is (symba_tp) - associate(system => self, plpl_encounter => self%plpl_encounter, pltp_encounter => self%pltp_encounter, npl => self%pl%nbody, ntp => self%tp%nbody) + associate(nbody_system => self, plpl_encounter => self%plpl_encounter, pltp_encounter => self%pltp_encounter, npl => self%pl%nbody, ntp => self%tp%nbody) irecp = ireci + 1 @@ -153,7 +153,7 @@ module subroutine symba_step_set_recur_levels_system(self, ireci) endwhere end if - system%irec = ireci + nbody_system%irec = ireci end associate end select @@ -192,8 +192,8 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) class is (symba_list_plpl) select type(pltp_encounter => self%pltp_encounter) class is (symba_list_pltp) - associate(system => self, lplpl_collision => plpl_encounter%lcollision, lpltp_collision => pltp_encounter%lcollision, encounter_history => self%encounter_history) - system%irec = ireci + associate(nbody_system => self, lplpl_collision => plpl_encounter%lcollision, lpltp_collision => pltp_encounter%lcollision, encounter_history => self%encounter_history) + nbody_system%irec = ireci dtl = param%dt / (NTENC**ireci) dth = 0.5_DP * dtl IF (dtl / param%dt < VSMALL) THEN @@ -209,45 +209,45 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) nloops = NTENC end if do j = 1, nloops - lencounter = plpl_encounter%encounter_check(param, system, dtl, irecp) & - .or. pltp_encounter%encounter_check(param, system, dtl, irecp) + lencounter = plpl_encounter%encounter_check(param, nbody_system, dtl, irecp) & + .or. pltp_encounter%encounter_check(param, nbody_system, dtl, irecp) - call plpl_encounter%kick(system, dth, irecp, 1) - call pltp_encounter%kick(system, dth, irecp, 1) + call plpl_encounter%kick(nbody_system, dth, irecp, 1) + call pltp_encounter%kick(nbody_system, dth, irecp, 1) if (ireci /= 0) then - call plpl_encounter%kick(system, dth, irecp, -1) - call pltp_encounter%kick(system, dth, irecp, -1) + call plpl_encounter%kick(nbody_system, dth, irecp, -1) + call pltp_encounter%kick(nbody_system, dth, irecp, -1) end if if (param%lgr) then - call pl%gr_pos_kick(system, param, dth) - call tp%gr_pos_kick(system, param, dth) + call pl%gr_pos_kick(nbody_system, param, dth) + call tp%gr_pos_kick(nbody_system, param, dth) end if - call pl%drift(system, param, dtl) - call tp%drift(system, param, dtl) + call pl%drift(nbody_system, param, dtl) + call tp%drift(nbody_system, param, dtl) - if (lencounter) call system%recursive_step(param, t+(j-1)*dtl, irecp) - system%irec = ireci + if (lencounter) call nbody_system%recursive_step(param, t+(j-1)*dtl, irecp) + nbody_system%irec = ireci if (param%lgr) then - call pl%gr_pos_kick(system, param, dth) - call tp%gr_pos_kick(system, param, dth) + call pl%gr_pos_kick(nbody_system, param, dth) + call tp%gr_pos_kick(nbody_system, param, dth) end if - call plpl_encounter%kick(system, dth, irecp, 1) - call pltp_encounter%kick(system, dth, irecp, 1) + call plpl_encounter%kick(nbody_system, dth, irecp, 1) + call pltp_encounter%kick(nbody_system, dth, irecp, 1) if (ireci /= 0) then - call plpl_encounter%kick(system, dth, irecp, -1) - call pltp_encounter%kick(system, dth, irecp, -1) + call plpl_encounter%kick(nbody_system, dth, irecp, -1) + call pltp_encounter%kick(nbody_system, dth, irecp, -1) end if if (param%lclose) then - call plpl_encounter%collision_check(system, param, t+j*dtl, dtl, ireci, lplpl_collision) - call pltp_encounter%collision_check(system, param, t+j*dtl, dtl, ireci, lpltp_collision) + call plpl_encounter%collision_check(nbody_system, param, t+j*dtl, dtl, ireci, lplpl_collision) + call pltp_encounter%collision_check(nbody_system, param, t+j*dtl, dtl, ireci, lpltp_collision) - if (lplpl_collision) call plpl_encounter%resolve_collision(system, param, t+j*dtl, dtl, ireci) - if (lpltp_collision) call pltp_encounter%resolve_collision(system, param, t+j*dtl, dtl, ireci) + if (lplpl_collision) call plpl_encounter%resolve_collision(nbody_system, param, t+j*dtl, dtl, ireci) + if (lpltp_collision) call pltp_encounter%resolve_collision(nbody_system, param, t+j*dtl, dtl, ireci) end if if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t+j*dtl, "trajectory") @@ -280,15 +280,15 @@ module subroutine symba_step_reset_system(self, param) integer(I4B) :: i integer(I8B) :: nenc_old - associate(system => self) - select type(pl => system%pl) + associate(nbody_system => self) + select type(pl => nbody_system%pl) class is (symba_pl) - select type(tp => system%tp) + select type(tp => nbody_system%tp) class is (symba_tp) associate(npl => pl%nbody, ntp => tp%nbody) - nenc_old = system%plpl_encounter%nenc - call system%plpl_encounter%setup(0_I8B) - call system%plpl_collision%setup(0_I8B) + nenc_old = nbody_system%plpl_encounter%nenc + call nbody_system%plpl_encounter%setup(0_I8B) + call nbody_system%plpl_collision%setup(0_I8B) if (npl > 0) then pl%lcollision(1:npl) = .false. call pl%reset_kinship([(i, i=1, npl)]) @@ -301,26 +301,26 @@ module subroutine symba_step_reset_system(self, param) pl%ldiscard(1:npl) = .false. pl%lmask(1:npl) = .true. call pl%set_renc(0) - call system%plpl_encounter%setup(nenc_old) ! This resizes the pl-pl encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step - system%plpl_encounter%nenc = 0 ! Sets the true number of encounters back to 0 after resizing - system%plpl_encounter%lcollision = .false. + call nbody_system%plpl_encounter%setup(nenc_old) ! This resizes the pl-pl encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step + nbody_system%plpl_encounter%nenc = 0 ! Sets the true number of encounters back to 0 after resizing + nbody_system%plpl_encounter%lcollision = .false. end if - nenc_old = system%pltp_encounter%nenc - call system%pltp_encounter%setup(0_I8B) + nenc_old = nbody_system%pltp_encounter%nenc + call nbody_system%pltp_encounter%setup(0_I8B) if (ntp > 0) then tp%nplenc(1:ntp) = 0 tp%levelg(1:ntp) = -1 tp%levelm(1:ntp) = -1 tp%lmask(1:ntp) = .true. tp%ldiscard(1:ntp) = .false. - call system%pltp_encounter%setup(nenc_old)! This resizes the pl-tp encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step - system%pltp_encounter%nenc = 0 ! Sets the true number of encounters back to 0 after resizing - system%pltp_encounter%lcollision = .false. + call nbody_system%pltp_encounter%setup(nenc_old)! This resizes the pl-tp encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step + nbody_system%pltp_encounter%nenc = 0 ! Sets the true number of encounters back to 0 after resizing + nbody_system%pltp_encounter%lcollision = .false. end if - call system%pl_adds%setup(0, param) - call system%pl_discards%setup(0, param) + call nbody_system%pl_adds%setup(0, param) + call nbody_system%pl_discards%setup(0, param) tp%lfirst = param%lfirstkick pl%lfirst = param%lfirstkick diff --git a/src/tides/tides_getacch_pl.f90 b/src/tides/tides_getacch_pl.f90 index 680c22704..f3da3cfc5 100644 --- a/src/tides/tides_getacch_pl.f90 +++ b/src/tides/tides_getacch_pl.f90 @@ -2,7 +2,7 @@ use swiftest contains - module subroutine tides_kick_getacch_pl(self, system) + module subroutine tides_kick_getacch_pl(self, nbody_system) !! author: Jennifer L.L. Pouplin, Carlisle A. wishard, and David A. Minton !! !! Calculated tidal torques from central body to any planet and from any planet to central body @@ -18,7 +18,7 @@ module subroutine tides_kick_getacch_pl(self, system) implicit none ! Arguments class(base_object), intent(inout) :: self !! Swiftest massive body object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object ! Internals integer(I4B) :: i real(DP) :: rmag, vmag @@ -27,9 +27,9 @@ module subroutine tides_kick_getacch_pl(self, system) select type(pl => self) class is (swiftest_pl) - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) - associate(npl => pl%nbody, cb => system%cb) + associate(npl => pl%nbody, cb => nbody_system%cb) pl%atide(:,:) = 0.0_DP cb%atide(:) = 0.0_DP do i = 1, npl diff --git a/src/tides/tides_module.f90 b/src/tides/tides_module.f90 index 6d9c5f465..828575f76 100644 --- a/src/tides/tides_module.f90 +++ b/src/tides/tides_module.f90 @@ -47,10 +47,10 @@ function tidederiv(x, t, dt, rbeg, rend) result(y) interface - module subroutine tides_kick_getacch_pl(self, system) + module subroutine tides_kick_getacch_pl(self, nbody_system) implicit none class(base_object), intent(inout) :: self !! Swiftest massive body object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object end subroutine tides_kick_getacch_pl module function tides_derivs_init(lambda, dt, rbeg, rend) result(f) diff --git a/src/tides/tides_spin_step.f90 b/src/tides/tides_spin_step.f90 index adf602b77..40a8f1659 100644 --- a/src/tides/tides_spin_step.f90 +++ b/src/tides/tides_spin_step.f90 @@ -6,7 +6,7 @@ module subroutine tides_step_spin_system(self, param, t, dt) !! author: Jennifer L.L. Pouplin and David A. Minton !! - !! Integrates the spin equations for central and massive bodies of the system subjected to tides. + !! Integrates the spin equations for central and massive bodies of the nbody_system subjected to tides. implicit none ! Arguments class(base_nbody_system), intent(inout) :: self !! Swiftest nbody system object diff --git a/src/whm/whm_drift.f90 b/src/whm/whm_drift.f90 index 31d041505..21a092793 100644 --- a/src/whm/whm_drift.f90 +++ b/src/whm/whm_drift.f90 @@ -11,7 +11,7 @@ use swiftest contains - module subroutine whm_drift_pl(self, system, param, dt) + module subroutine whm_drift_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Loop through planets and call Danby drift routine @@ -21,7 +21,7 @@ module subroutine whm_drift_pl(self, system, param, dt) implicit none ! Arguments class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! WHM nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! WHM nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize ! Internals diff --git a/src/whm/whm_gr.f90 b/src/whm/whm_gr.f90 index dc694a168..b0891f006 100644 --- a/src/whm/whm_gr.f90 +++ b/src/whm/whm_gr.f90 @@ -70,7 +70,7 @@ pure module subroutine whm_gr_kick_getacch_tp(self, param) end subroutine whm_gr_kick_getacch_tp - pure module subroutine whm_gr_p4_pl(self, system, param, dt) + pure module subroutine whm_gr_p4_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to massive bodies due to p**4 term in the post-Newtonian correction @@ -80,7 +80,7 @@ pure module subroutine whm_gr_p4_pl(self, system, param, dt) implicit none ! Arguments class(whm_pl), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size ! Internals @@ -97,7 +97,7 @@ pure module subroutine whm_gr_p4_pl(self, system, param, dt) end subroutine whm_gr_p4_pl - pure module subroutine whm_gr_p4_tp(self, system, param, dt) + pure module subroutine whm_gr_p4_tp(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to test particles due to p**4 term in the post-Newtonian correction @@ -107,7 +107,7 @@ pure module subroutine whm_gr_p4_tp(self, system, param, dt) implicit none ! Arguments class(whm_tp), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size ! Internals diff --git a/src/whm/whm_kick.f90 b/src/whm/whm_kick.f90 index 0b0746b87..6469809e5 100644 --- a/src/whm/whm_kick.f90 +++ b/src/whm/whm_kick.f90 @@ -11,7 +11,7 @@ use swiftest contains - module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) + module subroutine whm_kick_getacch_pl(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of planets @@ -21,7 +21,7 @@ module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) implicit none ! Arguments class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest central body particle data structure + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest central body particle data structure class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step @@ -31,7 +31,7 @@ module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) if (self%nbody == 0) return - associate(cb => system%cb, pl => self, npl => self%nbody) + associate(cb => nbody_system%cb, pl => self, npl => self%nbody) call pl%set_ir3() ah0(:) = whm_kick_getacch_ah0(pl%Gmass(2:npl), pl%rh(:,2:npl), npl-1) @@ -44,7 +44,7 @@ module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) call pl%accel_int(param) if (param%loblatecb) then - call pl%accel_obl(system) + call pl%accel_obl(nbody_system) if (lbeg) then cb%aoblbeg = cb%aobl else @@ -53,21 +53,21 @@ module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) ! TODO: Implement tides ! if (param%ltides) then ! cb%atidebeg = cb%aobl - ! call pl%accel_tides(system) + ! call pl%accel_tides(nbody_system) ! cb%atideend = cb%atide ! end if end if if (param%lgr) call pl%accel_gr(param) - if (param%lextra_force) call pl%accel_user(system, param, t, lbeg) + if (param%lextra_force) call pl%accel_user(nbody_system, param, t, lbeg) end associate return end subroutine whm_kick_getacch_pl - module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine whm_kick_getacch_tp(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of test particles @@ -77,7 +77,7 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) implicit none ! Arguments class(whm_tp), intent(inout) :: self !! WHM test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest central body particle data structure + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest central body particle data structure class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step @@ -85,9 +85,9 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) integer(I4B) :: i real(DP), dimension(NDIM) :: ah0 - associate(tp => self, ntp => self%nbody, pl => system%pl, cb => system%cb, npl => system%pl%nbody) + associate(tp => self, ntp => self%nbody, pl => nbody_system%pl, cb => nbody_system%cb, npl => nbody_system%pl%nbody) if (ntp == 0 .or. npl == 0) return - system%lbeg = lbeg + nbody_system%lbeg = lbeg if (lbeg) then ah0(:) = whm_kick_getacch_ah0(pl%Gmass(1:npl), pl%rbeg(:, 1:npl), npl) @@ -103,8 +103,8 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) call tp%accel_int(param, pl%Gmass(1:npl), pl%rend(:, 1:npl), npl) end if - if (param%loblatecb) call tp%accel_obl(system) - if (param%lextra_force) call tp%accel_user(system, param, t, lbeg) + if (param%loblatecb) call tp%accel_obl(nbody_system) + if (param%lextra_force) call tp%accel_user(nbody_system, param, t, lbeg) if (param%lgr) call tp%accel_gr(param) end associate @@ -200,7 +200,7 @@ pure subroutine whm_kick_getacch_ah2(cb, pl) end subroutine whm_kick_getacch_ah2 - module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) + module subroutine whm_kick_vh_pl(self, nbody_system, param, t, dt, lbeg) !! author: David A. Minton !! !! Kick heliocentric velocities of massive bodies @@ -210,7 +210,7 @@ module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) implicit none ! Arguments class(whm_pl), intent(inout) :: self !! WHM massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -218,19 +218,19 @@ module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) ! Internals integer(I4B) :: i - associate(pl => self, npl => self%nbody, cb => system%cb) + associate(pl => self, npl => self%nbody, cb => nbody_system%cb) if (npl == 0) return if (lbeg) then if (pl%lfirst) then call pl%h2j(cb) pl%ah(:, 1:npl) = 0.0_DP - call pl%accel(system, param, t, lbeg) + call pl%accel(nbody_system, param, t, lbeg) pl%lfirst = .false. end if call pl%set_beg_end(rbeg = pl%rh) else pl%ah(:, 1:npl) = 0.0_DP - call pl%accel(system, param, t, lbeg) + call pl%accel(nbody_system, param, t, lbeg) call pl%set_beg_end(rend = pl%rh) end if do concurrent(i = 1:npl, pl%lmask(i)) @@ -242,7 +242,7 @@ module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) end subroutine whm_kick_vh_pl - module subroutine whm_kick_vh_tp(self, system, param, t, dt, lbeg) + module subroutine whm_kick_vh_tp(self, nbody_system, param, t, dt, lbeg) !! author: David A. Minton !! !! Kick heliocentric velocities of test particles @@ -252,7 +252,7 @@ module subroutine whm_kick_vh_tp(self, system, param, t, dt, lbeg) implicit none ! Arguments class(whm_tp), intent(inout) :: self !! WHM massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -267,14 +267,14 @@ module subroutine whm_kick_vh_tp(self, system, param, t, dt, lbeg) do concurrent(i = 1:ntp, tp%lmask(i)) tp%ah(:, i) = 0.0_DP end do - call tp%accel(system, param, t, lbeg=.true.) + call tp%accel(nbody_system, param, t, lbeg=.true.) tp%lfirst = .false. end if if (.not.lbeg) then do concurrent(i = 1:ntp, tp%lmask(i)) tp%ah(:, i) = 0.0_DP end do - call tp%accel(system, param, t, lbeg) + call tp%accel(nbody_system, param, t, lbeg) end if do concurrent(i = 1:ntp, tp%lmask(i)) tp%vh(:, i) = tp%vh(:, i) + tp%ah(:, i) * dt diff --git a/src/whm/whm_module.f90 b/src/whm/whm_module.f90 index c3f2ce96f..fad0d8a55 100644 --- a/src/whm/whm_module.f90 +++ b/src/whm/whm_module.f90 @@ -74,7 +74,7 @@ module whm !> Replace the abstract procedures with concrete ones procedure :: initialize => whm_setup_initialize_system !! Performs WHM-specific initilization steps, like calculating the Jacobi masses procedure :: step => whm_step_system !! Advance the WHM nbody system forward in time by one step - final :: whm_final_system !! Finalizes the WHM system object - deallocates all allocatables + final :: whm_final_system !! Finalizes the WHM nbody_system object - deallocates all allocatables end type whm_nbody_system interface @@ -96,48 +96,48 @@ module subroutine whm_coord_vh2vj_pl(self, cb) class(swiftest_cb), intent(inout) :: cb !! Swiftest central body particle data structuree end subroutine whm_coord_vh2vj_pl - module subroutine whm_drift_pl(self, system, param, dt) + module subroutine whm_drift_pl(self, nbody_system, param, dt) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! WHM nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! WHM nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize end subroutine whm_drift_pl !> Get heliocentric accelration of massive bodies - module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) + module subroutine whm_kick_getacch_pl(self, nbody_system, param, t, lbeg) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! WHM nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! WHM nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine whm_kick_getacch_pl !> Get heliocentric accelration of the test particle - module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine whm_kick_getacch_tp(self, nbody_system, param, t, lbeg) implicit none class(whm_tp), intent(inout) :: self !! WHM test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! WHM nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! WHM nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine whm_kick_getacch_tp - module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) + module subroutine whm_kick_vh_pl(self, nbody_system, param, t, dt, lbeg) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. end subroutine whm_kick_vh_pl - module subroutine whm_kick_vh_tp(self, system, param, t, dt, lbeg) + module subroutine whm_kick_vh_tp(self, nbody_system, param, t, dt, lbeg) implicit none class(whm_tp), intent(inout) :: self !! WHM test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -156,18 +156,18 @@ pure module subroutine whm_gr_kick_getacch_tp(self, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine whm_gr_kick_getacch_tp - pure module subroutine whm_gr_p4_pl(self, system, param, dt) + pure module subroutine whm_gr_p4_pl(self, nbody_system, param, dt) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size end subroutine whm_gr_p4_pl - pure module subroutine whm_gr_p4_tp(self, system, param, dt) + pure module subroutine whm_gr_p4_tp(self, nbody_system, param, dt) implicit none class(whm_tp), intent(inout) :: self !! WHM test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size end subroutine whm_gr_p4_tp @@ -186,10 +186,10 @@ module subroutine whm_setup_initialize_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine whm_setup_initialize_system - module subroutine whm_step_pl(self, system, param, t, dt) + module subroutine whm_step_pl(self, nbody_system, param, t, dt) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Simulation time real(DP), intent(in) :: dt !! Current stepsize @@ -197,16 +197,16 @@ end subroutine whm_step_pl module subroutine whm_step_system(self, param, t, dt) implicit none - class(whm_nbody_system), intent(inout) :: self !! WHM system object + class(whm_nbody_system), intent(inout) :: self !! WHM nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Simulation time real(DP), intent(in) :: dt !! Current stepsize end subroutine whm_step_system - module subroutine whm_step_tp(self, system, param, t, dt) + module subroutine whm_step_tp(self, nbody_system, param, t, dt) implicit none class(whm_tp), intent(inout) :: self !! WHM test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Stepsize diff --git a/src/whm/whm_setup.f90 b/src/whm/whm_setup.f90 index 6a150d7b9..fe4745777 100644 --- a/src/whm/whm_setup.f90 +++ b/src/whm/whm_setup.f90 @@ -49,7 +49,7 @@ module subroutine whm_util_set_mu_eta_pl(self, cb) !! Sets the Jacobi mass value eta for all massive bodies implicit none ! Arguments - class(whm_pl), intent(inout) :: self !! WHM system object + class(whm_pl), intent(inout) :: self !! WHM nbody_system object class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object ! Internals integer(I4B) :: i diff --git a/src/whm/whm_step.f90 b/src/whm/whm_step.f90 index f592bdf66..e4ea4262d 100644 --- a/src/whm/whm_step.f90 +++ b/src/whm/whm_step.f90 @@ -25,17 +25,17 @@ module subroutine whm_step_system(self, param, t, dt) real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current stepsize - associate(system => self, cb => self%cb, pl => self%pl, tp => self%tp) + associate(nbody_system => self, cb => self%cb, pl => self%pl, tp => self%tp) tp%lfirst = pl%lfirst - call pl%step(system, param, t, dt) - call tp%step(system, param, t, dt) - ! if (param%ltides) call system%step_spin(param, t, dt) + call pl%step(nbody_system, param, t, dt) + call tp%step(nbody_system, param, t, dt) + ! if (param%ltides) call nbody_system%step_spin(param, t, dt) end associate return end subroutine whm_step_system - module subroutine whm_step_pl(self, system, param, t, dt) + module subroutine whm_step_pl(self, nbody_system, param, t, dt) !! author: David A. Minton !! !! Step planets ahead using kick-drift-kick algorithm @@ -46,7 +46,7 @@ module subroutine whm_step_pl(self, system, param, t, dt) implicit none ! Arguments class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current stepsize @@ -55,22 +55,22 @@ module subroutine whm_step_pl(self, system, param, t, dt) if (self%nbody == 0) return - associate(pl => self, cb => system%cb) + associate(pl => self, cb => nbody_system%cb) dth = 0.5_DP * dt - call pl%kick(system, param, t, dth,lbeg=.true.) + call pl%kick(nbody_system, param, t, dth,lbeg=.true.) call pl%vh2vj(cb) - if (param%lgr) call pl%gr_pos_kick(system, param, dth) - call pl%drift(system, param, dt) - if (param%lgr) call pl%gr_pos_kick(system, param, dth) + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) + call pl%drift(nbody_system, param, dt) + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) call pl%j2h(cb) - call pl%kick(system, param, t + dt, dth, lbeg=.false.) + call pl%kick(nbody_system, param, t + dt, dth, lbeg=.false.) end associate return end subroutine whm_step_pl - module subroutine whm_step_tp(self, system, param, t, dt) + module subroutine whm_step_tp(self, nbody_system, param, t, dt) !! author: David A. Minton !! !! Step active test particles ahead using kick-drift-kick algorithm @@ -80,7 +80,7 @@ module subroutine whm_step_tp(self, system, param, t, dt) implicit none ! Arguments class(whm_tp), intent(inout) :: self !! WHM test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current stepsize @@ -89,15 +89,15 @@ module subroutine whm_step_tp(self, system, param, t, dt) if (self%nbody == 0) return - select type(system) + select type(nbody_system) class is (whm_nbody_system) - associate(tp => self, cb => system%cb, pl => system%pl) + associate(tp => self, cb => nbody_system%cb, pl => nbody_system%pl) dth = 0.5_DP * dt - call tp%kick(system, param, t, dth, lbeg=.true.) - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%drift(system, param, dt) - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%kick(system, param, t + dt, dth, lbeg=.false.) + call tp%kick(nbody_system, param, t, dth, lbeg=.true.) + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%drift(nbody_system, param, dt) + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%kick(nbody_system, param, t + dt, dth, lbeg=.false.) end associate end select