diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index 28870ba85..280ec6233 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -15,7 +15,7 @@ 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. + !! Prints a nicely formatted message about which bodies collided, including their names !! This subroutine appends the body names and ids to an input message. implicit none ! Arguments @@ -25,7 +25,6 @@ module subroutine collision_io_collider_message(pl, collidx, collider_message) ! Internals integer(I4B) :: i, n character(len=STRMAX) :: idstr - n = size(collidx) if (n == 0) return @@ -366,7 +365,7 @@ module subroutine collision_io_netcdf_write_frame_snapshot(self, history, param) class(base_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, idslot, old_mode, npl, stage - character(len=:), allocatable :: charstring + character(len=NAMELEN) :: charstring class(swiftest_pl), allocatable :: pl select type(nc => history%nc) @@ -378,7 +377,7 @@ module subroutine collision_io_netcdf_write_frame_snapshot(self, history, param) 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" ) 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_io_netcdf_write_frame_snapshot nf90_put_var regime_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[NAMELEN, 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%collider%before) @@ -398,9 +397,9 @@ module subroutine collision_io_netcdf_write_frame_snapshot(self, history, param) 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_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_io_netcdf_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=[NAMELEN, 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_io_netcdf_write_frame_snapshot nf90_put_var particle_type_varid" ) + 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, 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" ) diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index 7ba93e7c7..d89cdac8c 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -325,6 +325,7 @@ module subroutine collision_resolve_mergeaddsub(nbody_system, param, t, status) integer(I4B) :: merge_text_length character(len=NAMELEN) :: merge_text character(len=NAMELEN) :: newname, origin_type + character(len=STRMAX) :: message real(DP) :: volume select type(nbody_system) @@ -472,7 +473,7 @@ module subroutine collision_resolve_mergeaddsub(nbody_system, param, t, status) call pl_discards%append(plsub, lsource_mask=[(.true., i = 1, nimpactors)]) - ! Log the properties of the old and new bodies + ! Save the before/after snapshots select type(before => collider%before) class is (swiftest_nbody_system) call move_alloc(plsub, before%pl) @@ -597,7 +598,7 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) if (.not.lplpl_collision) exit if (loop == MAXCASCADE) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT,"An runaway collisional cascade has been detected in collision_resolve_plpl.") + call swiftest_io_log_one_message(COLLISION_LOG_OUT,"A runaway collisional cascade has been detected in collision_resolve_plpl.") call swiftest_io_log_one_message(COLLISION_LOG_OUT,"Consider reducing the step size or changing the parameters in the collisional model to reduce the number of fragments.") call base_util_exit(FAILURE) end if diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index acf85f893..797950d88 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -122,6 +122,8 @@ module subroutine collision_util_construct_constraint_system(collider, nbody_sys end associate call collision_resolve_mergeaddsub(tmpsys, param, nbody_system%t, status) + deallocate(tmpsys%collider%before) + deallocate(tmpsys%collider%after) call tmpsys%pl%rearray(tmpsys, param) end if call move_alloc(tmpsys, constraint_system) @@ -682,7 +684,8 @@ module subroutine collision_util_snapshot(self, param, nbody_system, t, arg) ! Arguments class(collision_snapshot), allocatable, save :: snapshot character(len=:), allocatable :: stage - integer(I4B) :: phase_val + integer(I4B) :: i,phase_val + character(len=STRMAX) :: message if (present(arg)) then stage = arg @@ -724,17 +727,38 @@ module subroutine collision_util_snapshot(self, param, nbody_system, t, arg) class is (swiftest_nbody_system) select type(before_orig => nbody_system%collider%before) class is (swiftest_nbody_system) + select type(plsub => before_orig%pl) + class is (swiftest_pl) + ! Log the properties of the old and new bodies + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Removing bodies:") + do i = 1, plsub%nbody + write(message,*) trim(adjustl(plsub%info(i)%name)), " (", trim(adjustl(plsub%info(i)%particle_type)),")" + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + end do + call move_alloc(before_orig%pl, before_snap%pl) end select end select + end select select type(after_snap => snapshot%collider%after ) class is (swiftest_nbody_system) select type(after_orig => nbody_system%collider%after) class is (swiftest_nbody_system) + select type(plnew => after_orig%pl) + class is (swiftest_pl) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Adding bodies:") + do i = 1, plnew%nbody + write(message,*) trim(adjustl(plnew%info(i)%name)), " (", trim(adjustl(plnew%info(i)%particle_type)),")" + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + end do + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & + "***********************************************************") + call move_alloc(after_orig%pl, after_snap%pl) end select end select + end select ! Save the snapshot for posterity call self%save(snapshot) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index f62ced49a..1333c05aa 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -263,9 +263,9 @@ module subroutine encounter_io_netcdf_write_frame_snapshot(self, history, param) 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_io_netcdf_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=[NAMELEN, 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_io_netcdf_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=[NAMELEN, 1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl particle_type_varid" ) end do ntp = tp%nbody @@ -276,9 +276,9 @@ module subroutine encounter_io_netcdf_write_frame_snapshot(self, history, param) 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_io_netcdf_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=[NAMELEN, 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_io_netcdf_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=[NAMELEN, 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) ) diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index f497e59b9..7567ff48d 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -219,7 +219,7 @@ module subroutine swiftest_io_display_run_information(self, param, integration_t character(*), parameter :: statusfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & '"; Number of active pl, tp = ", I6, ", ", I6)' character(*), parameter :: symbastatfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & - '"; Number of active plm, pl, tp = ", I6, ", ", I6, ", ", I6)' + '"; Number of active pl, plm, tp = ", I6, ", ", I6, ", ", I6)' character(*), parameter :: pbarfmt = '("Time = ", ES12.5," of ",ES12.5)' phase_val = 1 @@ -254,7 +254,7 @@ module subroutine swiftest_io_display_run_information(self, param, integration_t end if if (self%pl%nplm > 0) then - write(param%display_unit, symbastatfmt) self%t, tfrac, self%pl%nplm, self%pl%nbody, self%tp%nbody + write(param%display_unit, symbastatfmt) self%t, tfrac, self%pl%nbody, self%pl%nplm, self%tp%nbody else write(param%display_unit, statusfmt) self%t, tfrac, self%pl%nbody, self%tp%nbody end if @@ -1728,14 +1728,14 @@ module subroutine swiftest_io_netcdf_write_info_body(self, nc, param) call netcdf_io_check( nf90_put_var(nc%id, nc%status_varid, self%status(j), start=[idslot,tslot]), "netcdf_io_write_info_body nf90_put_var status_varid" ) charstring = trim(adjustl(self%info(j)%name)) - call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_body nf90_put_var name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_io_write_info_body nf90_put_var name_varid" ) charstring = trim(adjustl(self%info(j)%particle_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_body nf90_put_var particle_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_io_write_info_body nf90_put_var particle_type_varid" ) if (param%lclose) then charstring = trim(adjustl(self%info(j)%origin_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_body nf90_put_var origin_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_io_write_info_body nf90_put_var origin_type_varid" ) call netcdf_io_check( nf90_put_var(nc%id, nc%origin_time_varid, self%info(j)%origin_time, start=[idslot]), "netcdf_io_write_info_body nf90_put_var origin_time_varid" ) call netcdf_io_check( nf90_put_var(nc%id, nc%origin_rh_varid, self%info(j)%origin_rh(:), start=[1,idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var origin_rh_varid" ) call netcdf_io_check( nf90_put_var(nc%id, nc%origin_vh_varid, self%info(j)%origin_vh(:), start=[1,idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var origin_vh_varid" ) @@ -1765,7 +1765,7 @@ module subroutine swiftest_io_netcdf_write_info_cb(self, nc, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: idslot, old_mode - character(len=:), allocatable :: charstring + character(len=NAMELEN) :: charstring ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables call netcdf_io_check( nf90_set_fill(nc%id, NF90_NOFILL, old_mode), "netcdf_io_write_info_cb nf90_set_fill NF90_NOFILL" ) @@ -1774,14 +1774,14 @@ module subroutine swiftest_io_netcdf_write_info_cb(self, nc, param) call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, self%id, start=[idslot]), "netcdf_io_write_info_cb nf90_put_var id_varid" ) charstring = trim(adjustl(self%info%name)) - call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_cb nf90_put_var name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_io_write_info_cb nf90_put_var name_varid" ) charstring = trim(adjustl(self%info%particle_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_cb nf90_put_var ptype_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_io_write_info_cb nf90_put_var ptype_varid" ) if (param%lclose) then charstring = trim(adjustl(self%info%origin_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_body nf90_put_var cb origin_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_io_write_info_body nf90_put_var cb origin_type_varid" ) call netcdf_io_check( nf90_put_var(nc%id, nc%origin_time_varid, self%info%origin_time, start=[idslot]), "netcdf_io_write_info_body nf90_put_var cb origin_time_varid" ) call netcdf_io_check( nf90_put_var(nc%id, nc%origin_rh_varid, self%info%origin_rh(:), start=[1, idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var cb origin_rh_varid" ) @@ -1797,6 +1797,7 @@ module subroutine swiftest_io_netcdf_write_info_cb(self, nc, param) return end subroutine swiftest_io_netcdf_write_info_cb + module subroutine swiftest_io_remove_nul_char(string) !! author: David A. Minton !! diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 891038a6e..096fe72aa 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -2681,7 +2681,6 @@ module subroutine swiftest_util_setup_construct_system(nbody_system, param) class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - select case(param%integrator) case (INT_BS) write(*,*) 'Bulirsch-Stoer integrator not yet enabled'