From 310598f4f6abf40dba13ac9c4ae4353bc46e1a59 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 11 Jan 2023 10:07:49 -0500 Subject: [PATCH] Fixed issues with character variables not overwriting old data in NetCDF files. Also added more helfpul information to the collision log file and rearranged the pl vs plm order in the swiftest log file --- src/collision/collision_io.f90 | 11 +++++------ src/collision/collision_resolve.f90 | 5 +++-- src/collision/collision_util.f90 | 26 +++++++++++++++++++++++++- src/encounter/encounter_io.f90 | 8 ++++---- src/swiftest/swiftest_io.f90 | 19 ++++++++++--------- src/swiftest/swiftest_util.f90 | 1 - 6 files changed, 47 insertions(+), 23 deletions(-) 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'