From c50f05a3f3ce35de09a89e156384434446470123 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 13:47:24 -0500 Subject: [PATCH] Added write methods and fixed a a bug in symba_util --- src/symba/symba_io.f90 | 34 ++++++++++++++++++---------------- src/symba/symba_step.f90 | 7 ++++--- src/symba/symba_util.f90 | 2 ++ 3 files changed, 24 insertions(+), 19 deletions(-) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index c80c72e0f..944ef921d 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -144,28 +144,30 @@ 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 + integer(I4B) :: tslot,i,old_mode, n, idslot 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" ) - ! charstring = trim(adjustl(self%info(j)%name)) - ! call check( nf90_put_var(nciu%id, nciu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_info_base nf90_put_var name_varid" ) - - ! charstring = trim(adjustl(self%info(j)%particle_type)) - ! call check( nf90_put_var(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_info_base nf90_put_var particle_type_varid" ) - - - ! call check( nf90_put_var(nciu%id, nciu%rh_varid, self%rh(:, j), 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%vh(:, j), 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%Gmass(j), 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%radius(j), 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%Ip(:, j), 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%rot(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body rotx_varid" ) - ! end if + 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%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 return end subroutine symba_io_encounter_write_frame diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index e55a001ac..f8dca7ff7 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -37,8 +37,10 @@ module subroutine symba_step_system(self, param, t, dt) call self%reset(param) lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) if (lencounter) then + call self%snapshot(param, t) call self%interp(param, t, dt) - !call self%encounter_history%dump(param) + call self%snapshot(param, t+dt) + call self%encounter_history%dump(param) else self%irec = -1 call helio_step_system(self, param, t, dt) @@ -218,8 +220,6 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) call pl%drift(system, param, dtl) call tp%drift(system, param, dtl) - call system%snapshot(param, t+dtl) - if (lencounter) call system%recursive_step(param, t+dth,irecp) system%irec = ireci @@ -242,6 +242,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) end if + call system%snapshot(param, t+dtl) call self%set_recur_levels(ireci) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 919b11acb..6e0e46470 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1328,6 +1328,8 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) if (npl > 0) allocate(symba_pl :: snapshot%pl) if (ntp > 0) allocate(symba_tp :: snapshot%tp) if (npl + ntp == 0) return + npl_snap = npl + ntp_snap = ntp select type (pl => self%pl) class is (symba_pl)