Skip to content
This repository was archived by the owner on Aug 28, 2024. It is now read-only.

Commit

Permalink
Merge branch 'debug'
Browse files Browse the repository at this point in the history
  • Loading branch information
daminton committed Jan 11, 2023
2 parents ad0c049 + 310598f commit 079515a
Show file tree
Hide file tree
Showing 6 changed files with 47 additions and 23 deletions.
11 changes: 5 additions & 6 deletions src/collision/collision_io.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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)
Expand All @@ -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" )
Expand Down
5 changes: 3 additions & 2 deletions src/collision/collision_resolve.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
26 changes: 25 additions & 1 deletion src/collision/collision_util.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down
8 changes: 4 additions & 4 deletions src/encounter/encounter_io.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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) )
Expand Down
19 changes: 10 additions & 9 deletions src/swiftest/swiftest_io.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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" )
Expand Down Expand Up @@ -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" )
Expand All @@ -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" )
Expand All @@ -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
!!
Expand Down
1 change: 0 additions & 1 deletion src/swiftest/swiftest_util.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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'
Expand Down

0 comments on commit 079515a

Please sign in to comment.