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

Commit

Permalink
Lots of fixes to indexing of encounters and collisions
Browse files Browse the repository at this point in the history
  • Loading branch information
@daminton
daminton committed Dec 12, 2022
1 parent 682b6f3 commit 1b82c22
Show file tree
Hide file tree
Showing 8 changed files with 447 additions and 262 deletions.
160 changes: 78 additions & 82 deletions src/encounter/encounter_io.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,15 +27,17 @@ module subroutine encounter_io_dump_collision(self, param)
class is (fraggle_io_parameters)
if (self%iframe > 0) then
nc%file_number = nc%file_number + 1
nc%event_dimsize = self%iframe
call self%make_index_map()
nc%event_dimsize = self%nt
nc%id_dimsize = self%nid

write(nc%file_name, '("collision_",I0.6,".nc")') nc%file_number
call nc%initialize(param)

do i = 1, self%nframes
if (allocated(self%frame(i)%item)) then
select type(snapshot => self%frame(i)%item)
class is (fraggle_collision_snapshot)
class is (fraggle_snapshot)
param%ioutput = i
call snapshot%write_frame(nc,param)
end select
Expand Down Expand Up @@ -70,6 +72,8 @@ module subroutine encounter_io_dump_encounter(self, param)
! Create and save the output files for this encounter and fragmentation
nc%file_number = nc%file_number + 1
call self%make_index_map()
nc%time_dimsize = self%nt
nc%id_dimsize = self%nid
write(nc%file_name, '("encounter_",I0.6,".nc")') nc%file_number
call nc%initialize(param)

Expand Down Expand Up @@ -113,77 +117,72 @@ module subroutine encounter_io_initialize(self, param)
integer(I4B) :: ndims, i

associate(nc => self)
select type(param)
class is (symba_parameters)
dfill = ieee_value(dfill, IEEE_QUIET_NAN)
sfill = ieee_value(sfill, IEEE_QUIET_NAN)

select case (param%out_type)
case("NETCDF_FLOAT")
self%out_type = NF90_FLOAT
case("NETCDF_DOUBLE")
self%out_type = NF90_DOUBLE
end select
dfill = ieee_value(dfill, IEEE_QUIET_NAN)
sfill = ieee_value(sfill, IEEE_QUIET_NAN)

select case (param%out_type)
case("NETCDF_FLOAT")
self%out_type = NF90_FLOAT
case("NETCDF_DOUBLE")
self%out_type = NF90_DOUBLE
end select

! Check if the file exists, and if it does, delete it
inquire(file=nc%file_name, exist=fileExists)
if (fileExists) then
open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg)
close(unit=LUN, status="delete")
end if

call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_initialize nf90_create" )

! Dimensions
call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension
call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension
call check( nf90_def_dim(nc%id, nc%id_dimname, param%encounter_history%nid, nc%id_dimid), "encounter_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers
call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays)

! Dimension coordinates
call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize nf90_def_var time_varid" )
call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize nf90_def_var space_varid" )
call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "encounter_io_initialize nf90_def_var id_varid" )

! Variables
call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "encounter_io_initialize nf90_def_var name_varid" )
call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "encounter_io_initialize nf90_def_var ptype_varid" )
call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" )
call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" )
call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" )
call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize nf90_def_var loop_varid" )
if (param%lclose) then
call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" )
end if
if (param%lrotation) then
call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize nf90_def_var Ip_varid" )
call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize nf90_def_var rot_varid" )
end if

call check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize nf90_inquire nVariables" )
do varid = 1, nvar
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" )
case(NF90_FLOAT)
call check( nf90_def_var_fill(nc%id, varid, 0, 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" )
case(NF90_CHAR)
call check( nf90_def_var_fill(nc%id, varid, 0, 0), "encounter_io_initialize nf90_def_var_fill NF90_CHAR" )
end select
end do
! Check if the file exists, and if it does, delete it
inquire(file=nc%file_name, exist=fileExists)
if (fileExists) then
open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg)
close(unit=LUN, status="delete")
end if

! Take the file out of define mode
call check( nf90_enddef(nc%id), "encounter_io_initialize nf90_enddef" )
call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_initialize nf90_create" )

! Dimensions
call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension
call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension
call check( nf90_def_dim(nc%id, nc%id_dimname, nc%id_dimsize, nc%id_dimid), "encounter_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers
call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays)

! Dimension coordinates
call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize nf90_def_var time_varid" )
call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize nf90_def_var space_varid" )
call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "encounter_io_initialize nf90_def_var id_varid" )

! Variables
call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "encounter_io_initialize nf90_def_var name_varid" )
call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "encounter_io_initialize nf90_def_var ptype_varid" )
call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" )
call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" )
call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" )
call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize nf90_def_var loop_varid" )
if (param%lclose) then
call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" )
end if
if (param%lrotation) then
call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize nf90_def_var Ip_varid" )
call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize nf90_def_var rot_varid" )
end if

! Add in the space dimension coordinates
call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize nf90_put_var space" )
call check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize nf90_inquire nVariables" )
do varid = 1, nvar
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" )
case(NF90_FLOAT)
call check( nf90_def_var_fill(nc%id, varid, 0, 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" )
case(NF90_CHAR)
call check( nf90_def_var_fill(nc%id, varid, 0, 0), "encounter_io_initialize nf90_def_var_fill NF90_CHAR" )
end select
end do

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

! Add in the space dimension coordinates
call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize nf90_put_var space" )

! Pre-fill name slots with ids
!call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid+1)], start=[1], count=[param%maxid+1]), "encounter_io_initialize nf90_put_var pl id_varid" )
end select
end associate

return
Expand All @@ -205,25 +204,22 @@ module subroutine encounter_io_write_frame(self, nc, param)
class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset
class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters
! Internals
integer(I4B) :: i, tslot, idslot, old_mode, npl, ntp
integer(I4B) :: i, idslot, old_mode, npl, ntp
character(len=:), allocatable :: charstring

tslot = param%ioutput
associate(pl => self%pl, tp => self%tp)
select type (nc)
class is (encounter_io_parameters)
select type (param)
class is (symba_parameters)

select type (nc)
class is (encounter_io_parameters)
select type (param)
class is (symba_parameters)
associate(pl => self%pl, tp => self%tp, encounter_history => param%encounter_history, tslot => param%ioutput)
call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame nf90_set_fill" )

call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame nf90_put_var time_varid" )
call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame nf90_put_var pl loop_varid" )

npl = pl%nbody
do i = 1, npl
idslot = pl%id(i) + 1
idslot = findloc(param%encounter_history%idvals,pl%id(i),dim=1)
idslot = findloc(encounter_history%idvals,pl%id(i),dim=1)
call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" )
call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" )
call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" )
Expand All @@ -244,7 +240,7 @@ module subroutine encounter_io_write_frame(self, nc, param)

ntp = tp%nbody
do i = 1, ntp
idslot = tp%id(i) + 1
idslot = findloc(param%encounter_history%idvals,tp%id(i),dim=1)
call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var tp id_varid" )
call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp rh_varid" )
call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp vh_varid" )
Expand All @@ -256,9 +252,9 @@ module subroutine encounter_io_write_frame(self, nc, param)
end do

call check( nf90_set_fill(nc%id, old_mode, old_mode) )
end select
end associate
end select
end associate
end select

return
end subroutine encounter_io_write_frame
Expand Down
Loading

0 comments on commit 1b82c22

Please sign in to comment.