diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 350f2f1d2..265cfde5c 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -209,47 +209,51 @@ module subroutine encounter_io_write_frame(self, nc, param) associate(pl => self%pl, tp => self%tp) select type (nc) class is (encounter_io_parameters) - - 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 - 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" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl Gmass_varid" ) - - if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl radius_varid" ) - - if (param%lrotation) then - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rotx_varid" ) - end if - - charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl name_varid" ) - charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl particle_type_varid" ) - end do - - ntp = tp%nbody - do i = 1, ntp - idslot = tp%id(i) + 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" ) - - charstring = trim(adjustl(tp%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp name_varid" ) - charstring = trim(adjustl(tp%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp particle_type_varid" ) - end do - - call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + select type (param) + class is (symba_parameters) + + 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 = param%encounter_history%idmap(pl%id(i)) + 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" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl Gmass_varid" ) + + if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl radius_varid" ) + + if (param%lrotation) then + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rotx_varid" ) + end if + + charstring = trim(adjustl(pl%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl name_varid" ) + charstring = trim(adjustl(pl%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl particle_type_varid" ) + end do + + ntp = tp%nbody + do i = 1, ntp + idslot = tp%id(i) + 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" ) + + charstring = trim(adjustl(tp%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp name_varid" ) + charstring = trim(adjustl(tp%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp particle_type_varid" ) + end do + + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end select end select end associate diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 45766a887..f5467b69f 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -180,7 +180,7 @@ module subroutine encounter_util_final_storage(self) end subroutine encounter_util_final_storage - module subroutine encounter_util_index_map_storage(self) + module subroutine encounter_util_index_map_encounter(self) !! author: David A. Minton !! !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id. @@ -229,11 +229,11 @@ module subroutine encounter_util_index_map_storage(self) self%nt = size(self%tvals) return - end subroutine encounter_util_index_map_storage + end subroutine encounter_util_index_map_encounter - module subroutine encounter_util_index_map_collision_storage(self) + module subroutine encounter_util_index_map_collision(self) !! author: David A. Minton !! !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id @@ -243,7 +243,7 @@ module subroutine encounter_util_index_map_collision_storage(self) ! Internals return - end subroutine encounter_util_index_map_collision_storage + end subroutine encounter_util_index_map_collision module subroutine encounter_util_resize_list(self, nnew) diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index d339b6660..f9ed5b896 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -68,7 +68,7 @@ module encounter_classes type, extends(swiftest_storage) :: collision_storage contains procedure :: dump => encounter_io_dump_collision !! Dumps contents of encounter history to file - procedure :: make_index_map => encounter_util_index_map_collision_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: make_index_map => encounter_util_index_map_collision !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id procedure :: take_snapshot => encounter_util_snapshot_collision !! Take a minimal snapshot of the system through an encounter final :: encounter_util_final_collision_storage end type collision_storage @@ -77,7 +77,7 @@ module encounter_classes type, extends(swiftest_storage) :: encounter_storage contains procedure :: dump => encounter_io_dump_encounter !! Dumps contents of encounter history to file - procedure :: make_index_map => encounter_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: make_index_map => encounter_util_index_map_encounter !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id procedure :: take_snapshot => encounter_util_snapshot_encounter !! Take a minimal snapshot of the system through an encounter final :: encounter_util_final_storage end type encounter_storage @@ -300,15 +300,15 @@ module subroutine encounter_util_final_storage(self) type(encounter_storage(*)), intent(inout) :: self !! SyMBA nbody system object end subroutine encounter_util_final_storage - module subroutine encounter_util_index_map_collision_storage(self) + module subroutine encounter_util_index_map_collision(self) implicit none class(collision_storage(*)), intent(inout) :: self !! E - end subroutine encounter_util_index_map_collision_storage + end subroutine encounter_util_index_map_collision - module subroutine encounter_util_index_map_storage(self) + module subroutine encounter_util_index_map_encounter(self) implicit none class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object - end subroutine encounter_util_index_map_storage + end subroutine encounter_util_index_map_encounter module subroutine encounter_util_resize_list(self, nnew) implicit none