diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index 99e758bf38..ede4374f1c 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -98,6 +98,9 @@ contains ! END OF RUN WRAPUP if (master) call header("SIMULATION FINISHED", level=1) + + ! Clear particle + call p % clear() end subroutine run_eigenvalue diff --git a/src/global.F90 b/src/global.F90 index a7a7bfb972..362a308b2a 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -409,6 +409,19 @@ contains if (allocated(xs_listings)) deallocate(xs_listings) if (allocated(micro_xs)) deallocate(micro_xs) + ! Deallocate external source + if (allocated(external_source % params_space)) & + deallocate(external_source % params_space) + if (allocated(external_source % params_angle)) & + deallocate(external_source % params_angle) + if (allocated(external_source % params_energy)) & + deallocate(external_source % params_energy) + + ! Deallocate k and entropy + if (allocated(k_generation)) deallocate(k_generation) + if (allocated(entropy)) deallocate(entropy) + if (allocated(entropy_p)) deallocate(entropy_p) + ! Deallocate tally-related arrays if (allocated(meshes)) deallocate(meshes) if (allocated(tallies)) then @@ -450,6 +463,9 @@ contains call nuclide_dict % clear() call sab_dict % clear() call xs_listing_dict % clear() + + ! Clear statepoint batch set + call statepoint_batch % clear() end subroutine free_memory diff --git a/src/initialize.F90 b/src/initialize.F90 index da9194915c..1a9cc021fb 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -417,6 +417,8 @@ contains integer, allocatable :: index_cell_in_univ(:) ! the index in the univ%cells ! array for each universe type(ElemKeyValueII), pointer :: pair_list => null() + type(ElemKeyValueII), pointer :: current => null() + type(ElemKeyValueII), pointer :: next => null() type(Universe), pointer :: univ => null() type(Cell), pointer :: c => null() @@ -428,11 +430,12 @@ contains ! cells_in_univ_dict, it's the id of the universe and the number of cells. pair_list => universe_dict % keys() - do while (associated(pair_list)) + current => pair_list + do while (associated(current)) ! find index of universe in universes array - i_univ = pair_list % value + i_univ = current % value univ => universes(i_univ) - univ % id = pair_list % key + univ % id = current % key ! check for lowest level universe if (univ % id == 0) BASE_UNIVERSE = i_univ @@ -445,7 +448,9 @@ contains univ % n_cells = n_cells_in_univ ! move to next universe - pair_list => pair_list % next + next => current % next + deallocate(current) + current => next end do ! Also allocate a list for keeping track of where cells have been assigned diff --git a/src/particle_header.F90 b/src/particle_header.F90 index 75d8ac1de4..3f396b15eb 100644 --- a/src/particle_header.F90 +++ b/src/particle_header.F90 @@ -77,6 +77,7 @@ module particle_header contains procedure :: initialize => initialize_particle + procedure :: clear => clear_particle end type Particle contains @@ -110,6 +111,9 @@ contains class(Particle) :: this + ! Clear coordinate lists + call this % clear() + ! Set particle to neutron that's alive this % type = NEUTRON this % alive = .true. @@ -126,9 +130,6 @@ contains this % wgt_bank = ZERO this % n_collision = 0 - ! remove any original coordinates - call deallocate_coord(this % coord0) - ! Set up base level coordinates allocate(this % coord0) this % coord0 % universe = BASE_UNIVERSE @@ -136,4 +137,20 @@ contains end subroutine initialize_particle +!=============================================================================== +! CLEAR_PARTICLE +!=============================================================================== + + subroutine clear_particle(this) + + class(Particle) :: this + + ! remove any coordinate levels + call deallocate_coord(this % coord0) + + ! Make sure coord pointer is nullified + nullify(this % coord) + + end subroutine clear_particle + end module particle_header