From 988773feb66750e6afae5bb84e8fd562c616b8fe Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 19 Aug 2021 12:25:13 -0400 Subject: [PATCH] Improved formatting of discard reporting to get rid of blank spaces around particle ids --- src/discard/discard.f90 | 10 +++++++--- src/symba/symba_discard.f90 | 10 +++++++--- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/src/discard/discard.f90 b/src/discard/discard.f90 index 2998e8804..f6e5dcf57 100644 --- a/src/discard/discard.f90 +++ b/src/discard/discard.f90 @@ -112,6 +112,7 @@ subroutine discard_cb_tp(tp, system, param) ! Internals integer(I4B) :: i real(DP) :: energy, vb2, rb2, rh2, rmin2, rmax2, rmaxu2 + character(len=STRMAX) :: idstr associate(ntp => tp%nbody, cb => system%cb, t => param%t, Gmtot => system%Gmtot) rmin2 = max(param%rmin * param%rmin, cb%radius * cb%radius) @@ -122,12 +123,14 @@ subroutine discard_cb_tp(tp, system, param) rh2 = dot_product(tp%xh(:, i), tp%xh(:, i)) if ((param%rmax >= 0.0_DP) .and. (rh2 > rmax2)) then tp%status(i) = DISCARDED_RMAX - write(*, *) "Particle ", tp%id(i), " too far from sun at t = ", t + write(idstr, *) tp%id(i) + write(*, *) "Particle " // trim(adjustl(idstr)) // " too far from the central body at t = ", t tp%ldiscard(i) = .true. tp%lmask(i) = .false. else if ((param%rmin >= 0.0_DP) .and. (rh2 < rmin2)) then tp%status(i) = DISCARDED_RMIN - write(*, *) "Particle ", tp%id(i), " too close to sun at t = ", t + write(idstr, *) tp%id(i) + write(*, *) "Particle " // trim(adjustl(idstr)) // " too close to the central body at t = ", t tp%ldiscard(i) = .true. tp%lmask(i) = .false. else if (param%rmaxu >= 0.0_DP) then @@ -136,7 +139,8 @@ subroutine discard_cb_tp(tp, system, param) energy = 0.5_DP * vb2 - Gmtot / sqrt(rb2) if ((energy > 0.0_DP) .and. (rb2 > rmaxu2)) then tp%status(i) = DISCARDED_RMAXU - write(*, *) "Particle ", tp%id(i), " is unbound and too far from barycenter at t = ", t + write(idstr, *) tp%id(i) + write(*, *) "Particle " // trim(adjustl(idstr)) // " is unbound and too far from barycenter at t = ", t tp%ldiscard(i) = .true. tp%lmask(i) = .false. end if diff --git a/src/symba/symba_discard.f90 b/src/symba/symba_discard.f90 index 2bf7b2a90..dfc8c615f 100644 --- a/src/symba/symba_discard.f90 +++ b/src/symba/symba_discard.f90 @@ -20,6 +20,7 @@ subroutine symba_discard_cb_pl(pl, system, param) ! Internals integer(I4B) :: i, j real(DP) :: energy, vb2, rb2, rh2, rmin2, rmax2, rmaxu2 + character(len=STRMAX) :: idstr associate(npl => pl%nbody, cb => system%cb) call system%set_msys() @@ -33,12 +34,14 @@ subroutine symba_discard_cb_pl(pl, system, param) pl%ldiscard(i) = .true. pl%lcollision(i) = .false. pl%status(i) = DISCARDED_RMAX - write(*, *) "Massive body ", pl%id(i), " too far from the central body at t = ", param%t + write(idstr, *) pl%id(i) + write(*, *) "Massive body " // trim(adjustl(idstr)) // " too far from the central body at t = ", param%t 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(*, *) "Massive body ", pl%id(i), " too close to the central body at t = ", param%t + write(idstr, *) pl%id(i) + write(*, *) "Massive body " // trim(adjustl(idstr)) // " too close to the central body at t = ", param%t else if (param%rmaxu >= 0.0_DP) then rb2 = dot_product(pl%xb(:,i), pl%xb(:,i)) vb2 = dot_product(pl%vb(:,i), pl%vb(:,i)) @@ -47,7 +50,8 @@ subroutine symba_discard_cb_pl(pl, system, param) pl%ldiscard(i) = .true. pl%lcollision(i) = .false. pl%status(i) = DISCARDED_RMAXU - write(*, *) "Massive body ", pl%id(i), " is unbound and too far from barycenter at t = ", param%t + write(idstr, *) pl%id(i) + write(*, *) "Massive body " // trim(adjustl(idstr)) // " is unbound and too far from barycenter at t = ", param%t end if end if end if