diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index eb9fb20d5..344a2e7d8 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -78,7 +78,7 @@ SET(FAST_MATH_FILES ${SRC}/util/util_final.f90 ${SRC}/util/util_flatten.f90 ${SRC}/util/util_get_energy_momentum.f90 - ${SRC}/util/util_index_array.f90 + ${SRC}/util/util_index.f90 ${SRC}/util/util_minimize_bfgs.f90 ${SRC}/util/util_peri.f90 ${SRC}/util/util_rescale.f90 diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 4789ab2bf..414c3854a 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -12,14 +12,14 @@ contains - module subroutine encounter_io_dump(self, param) + module subroutine encounter_io_dump_collision_storage(self, param) !! author: David A. Minton !! !! Dumps the time history of an encounter to file. implicit none ! Arguments - class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(collision_storage(*)), intent(inout) :: self !! Encounter storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i @@ -29,6 +29,30 @@ module subroutine encounter_io_dump(self, param) class is (fraggle_collision_snapshot) param%ioutput = i call snapshot%write_frame(self%nc,param) + end select + else + exit + end if + end do + + return + end subroutine encounter_io_dump_collision_storage + + + module subroutine encounter_io_dump_storage(self, param) + !! author: David A. Minton + !! + !! Dumps the time history of an encounter to file. + implicit none + ! Arguments + class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) class is (encounter_snapshot) param%ioutput = self%tslot(i) call snapshot%write_frame(self%nc,param) @@ -40,7 +64,7 @@ module subroutine encounter_io_dump(self, param) return - end subroutine encounter_io_dump + end subroutine encounter_io_dump_storage module subroutine encounter_io_initialize(self, param) diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 0d3a66d62..7d5094ede 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -152,6 +152,20 @@ module subroutine encounter_util_final_snapshot(self) end subroutine encounter_util_final_snapshot + module subroutine encounter_util_final_collision_storage(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_storage(*)), intent(inout) :: self !! SyMBA nbody system object + + call util_final_storage(self%swiftest_storage) + + return + end subroutine encounter_util_final_collision_storage + + module subroutine encounter_util_final_storage(self) !! author: David A. Minton !! @@ -166,6 +180,33 @@ module subroutine encounter_util_final_storage(self) end subroutine encounter_util_final_storage + module subroutine encounter_util_index_map_storage(self) + !! author: David A. Minton + !! + !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + implicit none + ! Arguments + class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + ! Internals + + return + end subroutine encounter_util_index_map_storage + + + + module subroutine encounter_util_index_map_collision_storage(self) + !! author: David A. Minton + !! + !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + implicit none + ! Arguments + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + ! Internals + + return + end subroutine encounter_util_index_map_collision_storage + + module subroutine encounter_util_resize_list(self, nnew) !! author: David A. Minton !! diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 4feb40dbe..4f5fec19b 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -12,7 +12,6 @@ contains - module subroutine fraggle_io_initialize_output(self, param) !! author: David A. Minton !! diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 95f230344..49065fc2a 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -68,10 +68,20 @@ module encounter_classes type, extends(swiftest_storage) :: encounter_storage class(encounter_io_parameters), allocatable :: nc !! NetCDF parameter object containing the details about the file attached to this storage object contains - procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file - final :: encounter_util_final_storage + procedure :: dump => encounter_io_dump_storage !! Dumps contents of encounter history to file + procedure :: mapid => encounter_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + final :: encounter_util_final_storage end type encounter_storage + !> A class that that is used to store simulation history data between file output + type, extends(swiftest_storage) :: collision_storage + class(encounter_io_parameters), allocatable :: nc !! NetCDF parameter object containing the details about the file attached to this storage object + contains + procedure :: dump => encounter_io_dump_collision_storage !! Dumps contents of encounter history to file + procedure :: mapid => 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 + final :: encounter_util_final_collision_storage + end type collision_storage + type encounter_bounding_box_1D integer(I4B) :: n !! Number of bodies with extents integer(I4B), dimension(:), allocatable :: ind !! Sorted minimum/maximum extent indices (value > n indicates an ending index) @@ -204,11 +214,17 @@ module subroutine encounter_check_sweep_aabb_single_list(self, n, x, v, renc, dt logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical array indicating which pairs are approaching end subroutine encounter_check_sweep_aabb_single_list - module subroutine encounter_io_dump(self, param) + module subroutine encounter_io_dump_collision_storage(self, param) + implicit none + class(collision_storage(*)), intent(inout) :: self !! Collision storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine encounter_io_dump_collision_storage + + module subroutine encounter_io_dump_storage(self, param) implicit none class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine encounter_io_dump + end subroutine encounter_io_dump_storage module subroutine encounter_io_initialize(self, param) implicit none @@ -264,6 +280,11 @@ module subroutine encounter_util_final_aabb(self) type(encounter_bounding_box_1D), intent(inout) :: self !!Bounding box structure along a single dimension end subroutine encounter_util_final_aabb + module subroutine encounter_util_final_collision_storage(self) + implicit none + type(collision_storage(*)), intent(inout) :: self !! SyMBA nbody system object + end subroutine encounter_util_final_collision_storage + module subroutine encounter_util_final_list(self) implicit none type(encounter_list), intent(inout) :: self !! Swiftest encounter list object @@ -279,6 +300,16 @@ 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) + implicit none + class(collision_storage(*)), intent(inout) :: self !! E + end subroutine encounter_util_index_map_collision_storage + + module subroutine encounter_util_index_map_storage(self) + implicit none + class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + end subroutine encounter_util_index_map_storage + module subroutine encounter_util_resize_list(self, nnew) implicit none class(encounter_list), intent(inout) :: self !! Swiftest encounter list diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 2dfbe8b5a..8d8e1c33e 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -285,17 +285,17 @@ end subroutine fraggle_util_construct_temporary_system module subroutine fraggle_util_final_colliders(self) implicit none - type(fraggle_colliders), intent(inout) :: self !! Fraggle encountar storage object + type(fraggle_colliders), intent(inout) :: self !! Fraggle colliders object end subroutine fraggle_util_final_colliders module subroutine fraggle_util_final_fragments(self) implicit none - type(fraggle_fragments), intent(inout) :: self !! Fraggle encountar storage object + type(fraggle_fragments), intent(inout) :: self !! Fraggle frgments object end subroutine fraggle_util_final_fragments module subroutine fraggle_util_final_snapshot(self) implicit none - type(fraggle_collision_snapshot), intent(inout) :: self !! Fraggle encountar storage object + type(fraggle_collision_snapshot), intent(inout) :: self !! Fraggle storage snapshot object end subroutine fraggle_util_final_snapshot module subroutine fraggle_util_get_energy_momentum(self, colliders, system, param, lbefore) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 9c60dd884..8624f8ece 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -153,14 +153,16 @@ module swiftest_classes type :: swiftest_storage(nframes) !! An class that establishes the pattern for various storage objects - integer(I4B), len :: nframes = 4096 !! Total number of frames that can be stored - type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames - integer(I4B) :: iframe = 0 !! Index of the last frame stored in the system - integer(I4B), dimension(nframes) :: tslot !! The value of the time dimension index associated with each frame - real(DP), dimension(nframes) :: tvals !! Stored time values for snapshots + integer(I4B), len :: nframes = 4096 !! Total number of frames that can be stored + type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames + integer(I4B) :: iframe = 0 !! Index of the last frame stored in the system + integer(I4B), dimension(nframes) :: tslot !! The value of the time dimension index associated with each frame + real(DP), dimension(nframes) :: tvals !! Stored time values for snapshots + integer(I4B), dimension(:), allocatable :: idmap !! The id value -> index map contains - procedure :: dump => io_dump_storage !! Dumps storage object contents to file - procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 + procedure :: dump => io_dump_storage !! Dumps storage object contents to file + procedure :: mapid => util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 final :: util_final_storage end type swiftest_storage @@ -1515,6 +1517,11 @@ module subroutine util_index_array(ind_arr, n) integer(I4B), intent(in) :: n !! The new size of the index array end subroutine util_index_array + module subroutine util_index_map_storage(self) + implicit none + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + end subroutine util_index_map_storage + module function util_minimize_bfgs(f, N, x0, eps, maxloop, lerr) result(x1) use lambda_function implicit none diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index a31d042f9..ff2597b5f 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -16,7 +16,7 @@ module symba_classes use swiftest_classes, only : swiftest_parameters, swiftest_base, swiftest_particle_info, swiftest_storage, netcdf_parameters use helio_classes, only : helio_cb, helio_pl, helio_tp, helio_nbody_system use fraggle_classes, only : fraggle_colliders, fraggle_fragments - use encounter_classes, only : encounter_list, encounter_snapshot, encounter_storage + use encounter_classes, only : encounter_list, encounter_snapshot, encounter_storage, collision_storage implicit none public @@ -192,7 +192,7 @@ module symba_classes class(fraggle_colliders), allocatable :: colliders !! Fraggle colliders object class(fraggle_fragments), allocatable :: fragments !! Fraggle fragmentation system object type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file - type(encounter_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file + type(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file contains procedure :: write_discard => symba_io_write_discard !! Write out information about discarded and merged planets and test particles in SyMBA procedure :: initialize => symba_setup_initialize_system !! Performs SyMBA-specific initilization steps diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index b573688c3..8cfc6432f 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -808,7 +808,7 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma call pl%info(i)%set_value(status="ACTIVE") end do allocate(plind(npl)) - plind(:) = pack([(i, i = 0, idmax-1)], plmask(:)) + plind(:) = pack([(i, i = 1, idmax)], plmask(:)) end if if (ntp > 0) then tp%status(:) = ACTIVE @@ -817,7 +817,7 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma call tp%info(i)%set_value(status="ACTIVE") end do allocate(tpind(ntp)) - tpind(:) = pack([(i, i = 0, idmax-1)], tpmask(:)) + tpind(:) = pack([(i, i = 1, idmax)], tpmask(:)) end if call check( nf90_get_var(nc%id, nc%id_varid, itemp), "netcdf_read_particle_info_system nf90_getvar id_varid" ) @@ -825,8 +825,8 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma pl%id(:) = pack(itemp, plmask) tp%id(:) = pack(itemp, tpmask) cb%id = 0 - pl%id(:) = pack([(i,i=0,idmax-1)],plmask) - tp%id(:) = pack([(i,i=0,idmax-1)],tpmask) + pl%id(:) = pack([(i,i=1,idmax)],plmask) + tp%id(:) = pack([(i,i=1,idmax)],tpmask) call check( nf90_get_var(nc%id, nc%name_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar name_varid" ) call cb%info%set_value(name=ctemp(1)) diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index ea822f45d..a107179a1 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -82,7 +82,7 @@ module subroutine setup_construct_system(system, param) end select end associate - allocate(encounter_storage :: system%collision_history) + allocate(collision_storage :: system%collision_history) associate (collision_history => system%collision_history) allocate(fraggle_io_parameters :: collision_history%nc) call collision_history%reset() diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 53e0a84bc..95d0dcf4f 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -494,7 +494,6 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid associate(idx_arr => parent_child_index_array(j)%idx, & id_arr => parent_child_index_array(j)%id, & ncj => nchild(j), & - pl => pl, & plkinj => pl%kin(idx_parent(j))) idx_arr(1) = idx_parent(j) if (ncj > 0) idx_arr(2:ncj + 1) = plkinj%child(1:ncj) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 5b840ad0c..60c3311c4 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -881,7 +881,7 @@ subroutine symba_util_save_collision(system, snapshot) type(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object ! Internals - type(encounter_storage(nframes=:)), allocatable :: tmp + type(collision_storage(nframes=:)), allocatable :: tmp integer(I4B) :: i, nnew, nold, nbig ! Advance the snapshot frame counter @@ -896,7 +896,7 @@ subroutine symba_util_save_collision(system, snapshot) do while (nbig < nnew) nbig = nbig * 2 end do - allocate(encounter_storage(nbig) :: tmp) + allocate(collision_storage(nbig) :: tmp) tmp%tvals(1:nold) = system%collision_history%tvals(1:nold) tmp%tvals(nold+1:nbig) = huge(1.0_DP) tmp%tslot(1:nold) = system%collision_history%tslot(1:nold) @@ -1347,26 +1347,28 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) real(DP), intent(in) :: t !! current time character(*), intent(in) :: stage !! Either before or after ! Arguments - class(fraggle_collision_snapshot), allocatable:: snapshot + class(fraggle_collision_snapshot), allocatable :: snapshot + type(symba_pl) :: pl integer(I4B) :: i,j select case(stage) case("before") ! Saves the states of the bodies involved in the collision before the collision is resolved associate (idx => self%colliders%idx, ncoll => self%colliders%ncoll) - allocate(symba_pl :: self%colliders%pl) - select type(pl => self%colliders%pl) - class is (symba_pl) - call pl%setup(ncoll, param) - pl%id(:) = self%pl%id(idx(:)) - pl%Gmass(:) = self%pl%Gmass(idx(:)) - pl%radius(:) = self%pl%radius(idx(:)) - pl%rot(:,:) = self%pl%rot(:,idx(:)) - pl%Ip(:,:) = self%pl%Ip(:,idx(:)) - pl%rh(:,:) = self%pl%rh(:,idx(:)) - pl%vh(:,:) = self%pl%vh(:,idx(:)) - pl%info(:) = self%pl%info(idx(:)) - end select + !allocate(symba_pl :: self%colliders%pl) + !select type(pl => self%colliders%pl) + !class is (symba_pl) + call pl%setup(ncoll, param) + pl%id(:) = self%pl%id(idx(:)) + pl%Gmass(:) = self%pl%Gmass(idx(:)) + pl%radius(:) = self%pl%radius(idx(:)) + pl%rot(:,:) = self%pl%rot(:,idx(:)) + pl%Ip(:,:) = self%pl%Ip(:,idx(:)) + pl%rh(:,:) = self%pl%rh(:,idx(:)) + pl%vh(:,:) = self%pl%vh(:,idx(:)) + pl%info(:) = self%pl%info(idx(:)) + !end select + allocate(self%colliders%pl, source=pl) end associate case("after") allocate(fraggle_collision_snapshot :: snapshot) diff --git a/src/util/util_index_array.f90 b/src/util/util_index.f90 similarity index 84% rename from src/util/util_index_array.f90 rename to src/util/util_index.f90 index b59e829e1..20772a2a6 100644 --- a/src/util/util_index_array.f90 +++ b/src/util/util_index.f90 @@ -44,4 +44,17 @@ module subroutine util_index_array(ind_arr, n) return end subroutine util_index_array + + module subroutine util_index_map_storage(self) + !! author: David A. Minton + !! + !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + implicit none + ! Arguments + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + ! Internals + + return + end subroutine util_index_map_storage + end submodule s_util_index_array \ No newline at end of file