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

Commit

Permalink
Merge branch 'encounter_storage' into debug
Browse files Browse the repository at this point in the history
  • Loading branch information
@daminton
daminton committed Dec 14, 2022
2 parents 8cfb3c9 + 632d6dc commit 9150e0f
Show file tree
Hide file tree
Showing 9 changed files with 100 additions and 74 deletions.
11 changes: 6 additions & 5 deletions src/encounter/encounter_io.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -112,9 +112,10 @@ module subroutine encounter_io_initialize(self, param)
integer(I4B) :: nvar, varid, vartype
real(DP) :: dfill
real(SP) :: sfill
integer(I4B), parameter :: NO_FILL = 0
logical :: fileExists
character(len=STRMAX) :: errmsg
integer(I4B) :: ndims, i
integer(I4B) :: ndims

associate(nc => self)
dfill = ieee_value(dfill, IEEE_QUIET_NAN)
Expand Down Expand Up @@ -167,13 +168,13 @@ module subroutine encounter_io_initialize(self, param)
call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize nf90_inquire_variable" )
select case(vartype)
case(NF90_INT)
call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "encounter_io_initialize nf90_def_var_fill NF90_INT" )
call check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "encounter_io_initialize nf90_def_var_fill NF90_INT" )
case(NF90_FLOAT)
call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "encounter_io_initialize nf90_def_var_fill NF90_FLOAT" )
call check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "encounter_io_initialize nf90_def_var_fill NF90_FLOAT" )
case(NF90_DOUBLE)
call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "encounter_io_initialize nf90_def_var_fill NF90_DOUBLE" )
call check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "encounter_io_initialize nf90_def_var_fill NF90_DOUBLE" )
case(NF90_CHAR)
call check( nf90_def_var_fill(nc%id, varid, 0, 0), "encounter_io_initialize nf90_def_var_fill NF90_CHAR" )
call check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "encounter_io_initialize nf90_def_var_fill NF90_CHAR" )
end select
end do

Expand Down
2 changes: 2 additions & 0 deletions src/encounter/encounter_util.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -690,6 +690,8 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg)
vrel(:) = plplenc_list%v2(:,k) - plplenc_list%v1(:,k)
call orbel_xv2aqt(Gmtot, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), a, q, capm, tperi)
snapshot%t = t + tperi
if ((snapshot%t < maxval(pl_snap%info(:)%origin_time)) .or. &
(snapshot%t > minval(pl_snap%info(:)%discard_time))) cycle

! Computer the center mass of the pair
rcom(:) = (plplenc_list%r1(:,k) * pl_snap%Gmass(1) + plplenc_list%r2(:,k) * pl_snap%Gmass(2)) / Gmtot
Expand Down
11 changes: 6 additions & 5 deletions src/fraggle/fraggle_io.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,9 +26,10 @@ module subroutine fraggle_io_initialize_output(self, param)
integer(I4B) :: nvar, varid, vartype
real(DP) :: dfill
real(SP) :: sfill
integer(I4B), parameter :: NO_FILL = 0
logical :: fileExists
character(len=STRMAX) :: errmsg
integer(I4B) :: i, ndims
integer(I4B) :: ndims

select type(param)
class is (symba_parameters)
Expand Down Expand Up @@ -120,13 +121,13 @@ module subroutine fraggle_io_initialize_output(self, param)
call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "fraggle_io_initialize nf90_inquire_variable" )
select case(vartype)
case(NF90_INT)
call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "fraggle_io_initialize nf90_def_var_fill NF90_INT" )
call check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "fraggle_io_initialize nf90_def_var_fill NF90_INT" )
case(NF90_FLOAT)
call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "fraggle_io_initialize nf90_def_var_fill NF90_FLOAT" )
call check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "fraggle_io_initialize nf90_def_var_fill NF90_FLOAT" )
case(NF90_DOUBLE)
call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "fraggle_io_initialize nf90_def_var_fill NF90_DOUBLE" )
call check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "fraggle_io_initialize nf90_def_var_fill NF90_DOUBLE" )
case(NF90_CHAR)
call check( nf90_def_var_fill(nc%id, varid, 0, 0), "fraggle_io_initialize nf90_def_var_fill NF90_CHAR" )
call check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "fraggle_io_initialize nf90_def_var_fill NF90_CHAR" )
end select
end do
! Take the file out of define mode
Expand Down
6 changes: 3 additions & 3 deletions src/io/io.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -294,11 +294,11 @@ module subroutine io_dump_storage(self, param)
integer(I8B) :: iloop_start

if (self%iframe == 0) return
iloop_start = param%iloop - int(param%istep_out * param%dump_cadence, kind=I8B) + 1
iloop_start = max(param%iloop - int(param%istep_out * param%dump_cadence, kind=I8B) + 1_I8B,0_I8B)
call self%make_index_map()
do i = 1, param%dump_cadence
param%ioutput = iloop_start + self%tmap(i)
do i = 1, self%iframe
if (allocated(self%frame(i)%item)) then
param%ioutput = iloop_start + self%tmap(i)
select type(system => self%frame(i)%item)
class is (swiftest_nbody_system)
call system%write_frame(param)
Expand Down
31 changes: 18 additions & 13 deletions src/modules/symba_classes.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -232,18 +232,20 @@ module subroutine symba_collision_make_colliders_pl(self,idx)
integer(I4B), dimension(2), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision
end subroutine symba_collision_make_colliders_pl

module subroutine symba_resolve_collision_fragmentations(self, system, param)
module subroutine symba_resolve_collision_fragmentations(self, system, param, t)
implicit none
class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list
class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object
class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions
real(DP), intent(in) :: t !! Time of collision
end subroutine symba_resolve_collision_fragmentations

module subroutine symba_resolve_collision_mergers(self, system, param)
module subroutine symba_resolve_collision_mergers(self, system, param, t)
implicit none
class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list
class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object
class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions
real(DP), intent(in) :: t !! Time of collision
end subroutine symba_resolve_collision_mergers

module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, irec)
Expand Down Expand Up @@ -343,25 +345,28 @@ pure module subroutine symba_gr_p4_tp(self, system, param, dt)
real(DP), intent(in) :: dt !! Step size
end subroutine symba_gr_p4_tp

module function symba_collision_casedisruption(system, param) result(status)
module function symba_collision_casedisruption(system, param, t) result(status)
implicit none
class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object
class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions
integer(I4B) :: status !! Status flag assigned to this outcome
class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object
class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions
real(DP), intent(in) :: t !! Time of collision
integer(I4B) :: status !! Status flag assigned to this outcome
end function symba_collision_casedisruption

module function symba_collision_casehitandrun(system, param) result(status)
module function symba_collision_casehitandrun(system, param, t) result(status)
implicit none
class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object
class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions
integer(I4B) :: status !! Status flag assigned to this outcome
class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions
real(DP), intent(in) :: t !! Time of collision
integer(I4B) :: status !! Status flag assigned to this outcome
end function symba_collision_casehitandrun

module function symba_collision_casemerge(system, param) result(status)
module function symba_collision_casemerge(system, param, t) result(status)
implicit none
class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object
class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions
integer(I4B) :: status !! Status flag assigned to this outcome
class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object
class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions
real(DP), intent(in) :: t !! Time of collision
integer(I4B) :: status !! Status flag assigned to this outcome
end function symba_collision_casemerge

module subroutine symba_util_set_renc(self, scale)
Expand Down
26 changes: 20 additions & 6 deletions src/netcdf/netcdf.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -157,6 +157,7 @@ module subroutine netcdf_initialize_output(self, param)
integer(I4B) :: nvar, varid, vartype
real(DP) :: dfill
real(SP) :: sfill
integer(I4B), parameter :: NO_FILL = 0
logical :: fileExists
character(len=STRMAX) :: errmsg
integer(I4B) :: ndims
Expand Down Expand Up @@ -281,16 +282,24 @@ module subroutine netcdf_initialize_output(self, param)
call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "netcdf_initialize_output nf90_inquire_variable" )
select case(vartype)
case(NF90_INT)
call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "netcdf_initialize_output nf90_def_var_fill NF90_INT" )
call check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "netcdf_initialize_output nf90_def_var_fill NF90_INT" )
case(NF90_FLOAT)
call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "netcdf_initialize_output nf90_def_var_fill NF90_FLOAT" )
call check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "netcdf_initialize_output nf90_def_var_fill NF90_FLOAT" )
case(NF90_DOUBLE)
call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "netcdf_initialize_output nf90_def_var_fill NF90_DOUBLE" )
call check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "netcdf_initialize_output nf90_def_var_fill NF90_DOUBLE" )
case(NF90_CHAR)
call check( nf90_def_var_fill(nc%id, varid, 0, 0), "netcdf_initialize_output nf90_def_var_fill NF90_CHAR" )
call check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "netcdf_initialize_output nf90_def_var_fill NF90_CHAR" )
end select
end do

! Set special fill mode for discard time so that we can make use of it for non-discarded bodies.
select case (vartype)
case(NF90_FLOAT)
call check( nf90_def_var_fill(nc%id, nc%discard_time_varid, NO_FILL, huge(1.0_SP)), "netcdf_initialize_output nf90_def_var_fill discard_time NF90_FLOAT" )
case(NF90_DOUBLE)
call check( nf90_def_var_fill(nc%id, nc%discard_time_varid, NO_FILL, huge(1.0_DP)), "netcdf_initialize_output nf90_def_var_fill discard_time NF90_DOUBLE" )
end select

! Take the file out of define mode
call check( nf90_enddef(nc%id), "netcdf_initialize_output nf90_enddef" )

Expand Down Expand Up @@ -944,7 +953,7 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma
if (status == nf90_noerr) then
call check( nf90_get_var(nc%id, nc%collision_id_varid, itemp), "netcdf_read_particle_info_system nf90_getvar collision_id_varid" )
else
itemp = 0.0_DP
itemp = 0
end if

do i = 1, npl
Expand All @@ -958,7 +967,12 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma
if (status == nf90_noerr) then
call check( nf90_get_var(nc%id, nc%discard_time_varid, rtemp), "netcdf_read_particle_info_system nf90_getvar discard_time_varid" )
else
rtemp = 0.0_DP
select case (param%out_type)
case("NETCDF_FLOAT")
rtemp(:) = huge(0.0_SP)
case("NETCDF_DOUBLE")
rtemp(:) = huge(0.0_DP)
end select
end if

call cb%info%set_value(discard_time=rtemp(1))
Expand Down
2 changes: 1 addition & 1 deletion src/setup/setup.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -248,7 +248,7 @@ module subroutine setup_body(self, n, param)
origin_time = -huge(1.0_DP), &
origin_rh = [0.0_DP, 0.0_DP, 0.0_DP], &
origin_vh = [0.0_DP, 0.0_DP, 0.0_DP], &
discard_time = -huge(1.0_DP), &
discard_time = huge(1.0_DP), &
discard_rh = [0.0_DP, 0.0_DP, 0.0_DP], &
discard_vh = [0.0_DP, 0.0_DP, 0.0_DP], &
discard_body_id = -1 &
Expand Down
Loading

0 comments on commit 9150e0f

Please sign in to comment.