diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index 907eb90ec..bae71daf5 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -365,9 +365,10 @@ module subroutine collision_io_netcdf_write_frame_snapshot(self, history, param) class(encounter_storage), intent(inout) :: history !! Collision history object class(base_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i, idslot, old_mode, npl, stage, tmp + integer(I4B) :: i, idslot, old_mode, npl, stage, tmp, ntp character(len=NAMELEN) :: charstring class(swiftest_pl), allocatable :: pl + class(swiftest_tp), allocatable :: tp select type(nc => history%nc) class is (collision_netcdf_parameters) @@ -387,13 +388,16 @@ module subroutine collision_io_netcdf_write_frame_snapshot(self, history, param) class is (swiftest_nbody_system) do stage = 1,2 if (allocated(pl)) deallocate(pl) + if (allocated(tp)) deallocate(tp) select case(stage) case(1) if (.not. allocated(before%pl)) cycle allocate(pl, source=before%pl) + if (allocated(before%tp)) allocate(tp, source=before%tp) case(2) if (.not. allocated(after%pl)) cycle allocate(pl, source=after%pl) + if (allocated(after%tp)) allocate(tp, source=after%tp) end select npl = pl%nbody @@ -415,6 +419,18 @@ module subroutine collision_io_netcdf_write_frame_snapshot(self, history, param) call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i)*RAD2DEG, start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var rotx_varid" ) end if end do + + ntp = pl%nbody + do i = 1, ntp + call nc%find_idslot(tp%id(i), idslot) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[ idslot ]), "collision_io_netcdf_write_frame_snapshot nf90_put_var id_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=[NAMELEN, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var 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, stage, eslot], count=[NAMELEN, 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, tp%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, tp%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var vh_varid" ) + end do end do end select end select diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index ed676b32b..0d355f3c4 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -709,6 +709,7 @@ module subroutine collision_resolve_pltp(self, nbody_system, param, t, dt, irec) integer(I4B), intent(in) :: irec !! Current recursion level ! Internals class(swiftest_pl), allocatable :: plsub + class(swiftest_tp), allocatable :: tpsub logical :: lpltp_collision character(len=STRMAX) :: timestr, idstr integer(I4B) :: i, j, nnew, loop @@ -767,6 +768,20 @@ module subroutine collision_resolve_pltp(self, nbody_system, param, t, dt, irec) call move_alloc(plsub, before%pl) end select + deallocate(lmask) + allocate(lmask, mold=tp%lmask) + lmask(:) = .false. + lmask(idx2(k)) = .true. + + allocate(tpsub, mold=tp) + call tp%spill(tpsub, lmask, ldestructive=.false.) + + ! Save the before snapshots + select type(before => collider%before) + class is (swiftest_nbody_system) + call move_alloc(tpsub, before%tp) + end select + call collision_history%take_snapshot(param,nbody_system, t, "particle") call impactors%dealloc()