diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 276750eb6..32946a125 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -544,7 +544,7 @@ module swiftest_classes type :: swiftest_storage(nframes) !! An class that establishes the pattern for various storage objects - integer(I4B), len :: nframes = 10 !! Total number of frames that can be stored + integer(I4B), len :: nframes = 32768 !! Total number of frames that can be stored type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames integer(I4B) :: iframe = 0 !! The current frame number contains diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 7c35e9ccb..1a9aae0c4 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -146,30 +146,34 @@ module subroutine symba_io_encounter_write_frame(self, nciu, param) class(symba_io_encounter_parameters), intent(inout) :: nciu !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: tslot,i,old_mode, n, idslot + integer(I4B) :: i, tslot, idslot, old_mode, n character(len=NAMELEN) :: charstring tslot = nciu%ienc_frame - call check( nf90_set_fill(nciu%id, nf90_nofill, old_mode), "symba_io_encounter_write_frame_base nf90_set_fill" ) - call check( nf90_put_var(nciu%id, nciu%time_varid, self%t, start=[tslot]), "symba_io_encounter_write_frame nf90_put_var time_varid" ) - - n = size(self%pl%id(:)) - do i = 1, n - idslot = self%pl%id(i) - charstring = trim(adjustl(self%pl%info(i)%name)) - call check( nf90_put_var(nciu%id, nciu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var name_varid" ) - charstring = trim(adjustl(self%pl%info(i)%particle_type)) - call check( nf90_put_var(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var particle_type_varid" ) - call check( nf90_put_var(nciu%id, nciu%id_varid, self%pl%id(i), start=[idslot]), "symba_io_encounter_write_frame_base nf90_put_var id_varid" ) - call check( nf90_put_var(nciu%id, nciu%rh_varid, self%pl%rh(:, i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var rh_varid" ) - call check( nf90_put_var(nciu%id, nciu%vh_varid, self%pl%vh(:, i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var vh_varid" ) - call check( nf90_put_var(nciu%id, nciu%Gmass_varid, self%pl%Gmass(i), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body Gmass_varid" ) - if (param%lclose) call check( nf90_put_var(nciu%id, nciu%radius_varid, self%pl%radius(i), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body radius_varid" ) - if (param%lrotation) then - call check( nf90_put_var(nciu%id, nciu%Ip_varid, self%pl%Ip(:, i), start=[1, idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body Ip_varid" ) - call check( nf90_put_var(nciu%id, nciu%rot_varid, self%pl%rot(:, i), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body rotx_varid" ) - end if - end do + select type(pl => self%pl) + class is (symba_pl) + n = size(pl%id(:)) + do i = 1, n + idslot = pl%id(i) + call check( nf90_set_fill(nciu%id, nf90_nofill, old_mode), "symba_io_encounter_write_frame_base nf90_set_fill" ) + call check( nf90_put_var(nciu%id, nciu%time_varid, self%t, start=[tslot]), "symba_io_encounter_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(nciu%id, nciu%id_varid, pl%id(i), start=[idslot]), "symba_io_encounter_write_frame_base nf90_put_var id_varid" ) + call check( nf90_put_var(nciu%id, nciu%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var rh_varid" ) + call check( nf90_put_var(nciu%id, nciu%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var vh_varid" ) + call check( nf90_put_var(nciu%id, nciu%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body Gmass_varid" ) + if (param%lclose) call check( nf90_put_var(nciu%id, nciu%radius_varid, pl%radius(i), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body radius_varid" ) + if (param%lrotation) then + call check( nf90_put_var(nciu%id, nciu%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body Ip_varid" ) + call check( nf90_put_var(nciu%id, nciu%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body rotx_varid" ) + end if + charstring = trim(adjustl(pl%info(i)%name)) + call check( nf90_put_var(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var particle_type_varid" ) + charstring = trim(adjustl(pl%info(i)%particle_type)) + call check( nf90_put_var(nciu%id, nciu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var name_varid" ) + end do + end select + + call check( nf90_set_fill(nciu%id, old_mode, old_mode) ) return end subroutine symba_io_encounter_write_frame diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 50521f7a8..6a0b337b2 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -939,7 +939,7 @@ module subroutine symba_util_resize_storage(self, nnew) allocate(symba_encounter_storage(nbig) :: tmp) if (lmalloc) then do i = 1, nold - if (allocated(self%encounter_history%frame(i)%item)) tmp%frame(i) = self%encounter_history%frame(i)%item + if (allocated(self%encounter_history%frame(i)%item)) call move_alloc(self%encounter_history%frame(i)%item, tmp%frame(i)%item) end do deallocate(self%encounter_history) end if @@ -1371,6 +1371,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) snapshot%pl%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) end do end if + call snapshot%pl%sort("id", ascending=.true.) end if ! Take snapshot of the currently encountering test particles @@ -1394,6 +1395,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) ! Save the snapshot self%encounter_history%iframe = self%encounter_history%iframe + 1 call self%resize_storage(self%encounter_history%iframe) + self%encounter_history%frame(self%encounter_history%iframe) = snapshot end select end select