crp/OpenMC
1
0
Fork 0
mirror of https://github.com/openmc-dev/openmc.git synced 2026-07-28 06:05:58 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions 5

Merge pull request #162 from nelsonag/valgrind

Browse source 
Addition of clear routines to significantly reduce Valgrind-reported memory leaks
This commit is contained in:
Paul Romano 2013-04-06 12:59:20 -07:00
commit eae7e5db25
7 changed files with 345 additions and 59 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/ace.F90
View file

@ -165,6 +165,10 @@ contains
if (allocated(mat % sab_names)) deallocate(mat % sab_names)
end do MATERIAL_LOOP2
! Avoid some valgrind leak errors
call already_read % clear()
end subroutine read_xs
!===============================================================================

148
src/ace_header.F90
View file

@ -16,6 +16,10 @@ module ace_header
integer, allocatable :: type(:) ! type of distribution
integer, allocatable :: location(:) ! location of each table
real(8), allocatable :: data(:) ! angular distribution data
! Type-Bound procedures
contains
procedure :: clear => distangle_clear ! Deallocates DistAngle
end type DistAngle
!===============================================================================
@ -31,6 +35,10 @@ module ace_header
! For reactions that may have multiple energy distributions such as (n.2n),
! this pointer allows multiple laws to be stored
type(DistEnergy), pointer :: next => null()
! Type-Bound procedures
contains
procedure :: clear => distenergy_clear ! Deallocates DistEnergy
end type DistEnergy
!===============================================================================
@ -48,7 +56,11 @@ module ace_header
logical :: has_angle_dist ! Angle distribution present?
logical :: has_energy_dist ! Energy distribution present?
type(DistAngle) :: adist ! Secondary angular distribution
type(DistEnergy), pointer :: edist ! Secondary energy distribution
type(DistEnergy), pointer :: edist => null() ! Secondary energy distribution
! Type-Bound procedures
contains
procedure :: clear => reaction_clear ! Deallocates Reaction
end type Reaction
!===============================================================================
@ -64,6 +76,10 @@ module ace_header
logical :: multiply_smooth ! multiply by smooth cross section?
real(8), allocatable :: energy(:) ! incident energies
real(8), allocatable :: prob(:,:,:) ! actual probabibility tables
! Type-Bound procedures
contains
procedure :: clear => urrdata_clear ! Deallocates UrrData
end type UrrData
!===============================================================================
@ -121,7 +137,10 @@ module ace_header
! Reactions
integer :: n_reaction ! # of reactions
type(Reaction), pointer :: reactions(:) => null()
! Type-Bound procedures
contains
procedure :: clear => nuclide_clear ! Deallocates Nuclide
end type Nuclide
!===============================================================================
@ -216,4 +235,129 @@ module ace_header
real(8) :: kappa_fission ! macroscopic energy-released from fission
end type MaterialMacroXS
contains
!===============================================================================
! DISTANGLE_CLEAR resets and deallocates data in Reaction.
!===============================================================================
subroutine distangle_clear(this)
class(DistAngle), intent(inout) :: this ! The DistAngle object to clear
if (allocated(this % energy)) &
deallocate(this % energy, this % type, this % location, this % data)
end subroutine distangle_clear
!===============================================================================
! DISTENERGY_CLEAR resets and deallocates data in DistEnergy.
!===============================================================================
recursive subroutine distenergy_clear(this)
class(DistEnergy), intent(inout) :: this ! The DistEnergy object to clear
! Clear p_valid
call this % p_valid % clear()
if (allocated(this % data)) &
deallocate(this % data)
if (associated(this % next)) then
! recursively clear this item
call this % next % clear()
deallocate(this % next)
end if
end subroutine distenergy_clear
!===============================================================================
! REACTION_CLEAR resets and deallocates data in Reaction.
!===============================================================================
subroutine reaction_clear(this)
class(Reaction), intent(inout) :: this ! The Reaction object to clear
if (allocated(this % sigma)) &
deallocate(this % sigma)
if (associated(this % edist)) then
call this % edist % clear()
deallocate(this % edist)
end if
call this % adist % clear()
end subroutine reaction_clear
!===============================================================================
! URRDATA_CLEAR resets and deallocates data in Reaction.
!===============================================================================
subroutine urrdata_clear(this)
class(UrrData), intent(inout) :: this ! The UrrData object to clear
if (allocated(this % energy)) &
deallocate(this % energy, this % prob)
end subroutine urrdata_clear
!===============================================================================
! NUCLIDE_CLEAR resets and deallocates data in Nuclide.
!===============================================================================
subroutine nuclide_clear(this)
class(Nuclide), intent(inout) :: this ! The Nuclide object to clear
integer :: i ! Loop counter
if (allocated(this % grid_index)) &
deallocate(this % grid_index)
if (allocated(this % energy)) &
deallocate(this % total, this % elastic, this % fission, &
this % nu_fission, this % absorption)
if (allocated(this % heating)) &
deallocate(this % heating)
if (allocated(this % index_fission)) &
deallocate(this % index_fission)
if (allocated(this % nu_t_data)) &
deallocate(this % nu_t_data)
if (allocated(this % nu_p_data)) &
deallocate(this % nu_p_data)
if (allocated(this % nu_d_data)) &
deallocate(this % nu_d_data)
if (allocated(this % nu_d_precursor_data)) &
deallocate(this % nu_d_precursor_data)
if (associated(this % nu_d_edist)) then
do i = 1, size(this % nu_d_edist)
call this % nu_d_edist(i) % clear()
end do
deallocate(this % nu_d_edist)
end if
if (associated(this % urr_data)) then
call this % urr_data % clear()
deallocate(this % urr_data)
end if
if (associated(this % reactions)) then
do i = 1, size(this % reactions)
call this % reactions(i) % clear()
end do
deallocate(this % reactions)
end if
end subroutine nuclide_clear
end module ace_header

112
src/dict_header.F90
View file

@ -64,10 +64,10 @@ module dict_header
type(HashListCI), pointer :: table(:) => null()
contains
procedure :: add_key => dict_add_key_ci
procedure :: delete => dict_delete_ci
procedure :: get_key => dict_get_key_ci
procedure :: has_key => dict_has_key_ci
procedure :: keys => dict_keys_ci
procedure :: clear => dict_clear_ci
procedure, private :: get_elem => dict_get_elem_ci
end type DictCharInt
@ -76,10 +76,10 @@ module dict_header
type(HashListII), pointer :: table(:) => null()
contains
procedure :: add_key => dict_add_key_ii
procedure :: delete => dict_delete_ii
procedure :: get_key => dict_get_key_ii
procedure :: has_key => dict_has_key_ii
procedure :: keys => dict_keys_ii
procedure :: clear => dict_clear_ii
procedure, private :: get_elem => dict_get_elem_ii
end type DictIntInt
@ -150,54 +150,6 @@ contains
end subroutine dict_add_key_ii
!===============================================================================
! DICT_DELETE deletes all (key,value) pairs from the dictionary
!===============================================================================
subroutine dict_delete_ci(this)
class(DictCharInt) :: this
integer :: i
type(ElemKeyValueCI), pointer :: current
type(ElemKeyValueCI), pointer :: next
if (associated(this % table)) then
do i = 1, size(this % table)
current => this % table(i) % list
do while (associated(current))
next => current % next
deallocate(current)
current => next
end do
nullify(this % table(i) % list)
end do
end if
end subroutine dict_delete_ci
subroutine dict_delete_ii(this)
class(DictIntInt) :: this
integer :: i
type(ElemKeyValueII), pointer :: current
type(ElemKeyValueII), pointer :: next
if (associated(this % table)) then
do i = 1, size(this % table)
current => this % table(i) % list
do while (associated(current))
next => current % next
deallocate(current)
current => next
end do
nullify(this % table(i) % list)
end do
end if
end subroutine dict_delete_ii
!===============================================================================
! DICT_GET_ELEM returns a pointer to the (key,value) pair for a given key. This
! method is private.
@ -429,4 +381,64 @@ contains
end function dict_keys_ii
!===============================================================================
! DICT_CLEAR Deletes and deallocates the dictionary item
!===============================================================================
subroutine dict_clear_ci(this)
class(DictCharInt) :: this
integer :: i
type(ElemKeyValueCI), pointer :: current
type(ElemKeyValueCI), pointer :: next
if (associated(this % table)) then
do i = 1, size(this % table)
current => this % table(i) % list
do while (associated(current))
if (associated(current % next)) then
next => current % next
else
nullify(next)
end if
deallocate(current)
current => next
end do
if (associated(this % table(i) % list)) &
nullify(this % table(i) % list)
end do
deallocate(this % table)
end if
end subroutine dict_clear_ci
subroutine dict_clear_ii(this)
class(DictIntInt) :: this
integer :: i
type(ElemKeyValueII), pointer :: current
type(ElemKeyValueII), pointer :: next
if (associated(this % table)) then
do i = 1, size(this % table)
current => this % table(i) % list
do while (associated(current))
if (associated(current % next)) then
next => current % next
else
nullify(next)
end if
deallocate(current)
current => next
end do
if (associated(this % table(i) % list)) &
nullify(this % table(i) % list)
end do
deallocate(this % table)
end if
end subroutine dict_clear_ii
end module dict_header

22
src/endf_header.F90
View file

@ -13,6 +13,28 @@ module endf_header
integer :: n_pairs ! # of pairs of (x,y) values
real(8), allocatable :: x(:) ! values of abscissa
real(8), allocatable :: y(:) ! values of ordinate
! Type-Bound procedures
contains
procedure :: clear => Tab1_clear ! deallocates a Tab1 Object.
end type Tab1
contains
!===============================================================================
! TAB1_CLEAR deallocates the items in Tab1
!===============================================================================
subroutine tab1_clear(this)
class(Tab1), intent(inout) :: this ! The Tab1 to clear
if (allocated(this % nbt)) &
deallocate(this % nbt, this % int)
if (allocated(this % x)) &
deallocate(this % x, this % y)
end subroutine tab1_clear
end module endf_header

39
src/global.F90
View file

@ -371,11 +371,14 @@ module global
contains
!===============================================================================
! FREE_MEMORY deallocates all global allocatable arrays in the program
! FREE_MEMORY deallocates and clears all global allocatable arrays in the
! program
!===============================================================================
subroutine free_memory()
integer :: i ! Loop Index
! Deallocate cells, surfaces, materials
if (allocated(cells)) deallocate(cells)
if (allocated(universes)) deallocate(universes)
@ -385,14 +388,27 @@ contains
if (allocated(plots)) deallocate(plots)
! Deallocate cross section data, listings, and cache
if (allocated(nuclides)) deallocate(nuclides)
if (allocated(nuclides)) then
! First call the clear routines
do i = 1, size(nuclides)
call nuclides(i) % clear()
end do
deallocate(nuclides)
end if
if (allocated(sab_tables)) deallocate(sab_tables)
if (allocated(xs_listings)) deallocate(xs_listings)
if (allocated(micro_xs)) deallocate(micro_xs)
! Deallocate tally-related arrays
if (allocated(meshes)) deallocate(meshes)
if (allocated(tallies)) deallocate(tallies)
if (allocated(tallies)) then
! First call the clear routines
do i = 1, size(tallies)
call tallies(i) % clear()
end do
! Now deallocate the tally array
deallocate(tallies)
end if
if (allocated(tally_maps)) deallocate(tally_maps)
! Deallocate energy grid
@ -411,7 +427,20 @@ contains
call active_tracklength_tallies % clear()
call active_current_tallies % clear()
call active_tallies % clear()
! Deallocate dictionaries
call cell_dict % clear()
call universe_dict % clear()
call lattice_dict % clear()
call surface_dict % clear()
call material_dict % clear()
call mesh_dict % clear()
call tally_dict % clear()
call plot_dict % clear()
call nuclide_dict % clear()
call sab_dict % clear()
call xs_listing_dict % clear()
end subroutine free_memory
end module global

2
src/initialize.F90
View file

@ -400,7 +400,7 @@ contains
index_cell_in_univ(i_univ) = index_cell_in_univ(i_univ) + 1
univ % cells(index_cell_in_univ(i_univ)) = i
end do
end subroutine prepare_universes
!===============================================================================

77
src/tally_header.F90
View file

@ -55,6 +55,10 @@ module tally_header
integer :: n_bins = 0
integer, allocatable :: int_bins(:)
real(8), allocatable :: real_bins(:) ! Only used for energy filters
! Type-Bound procedures
contains
procedure :: clear => tallyfilter_clear ! Deallocates TallyFilter
end type TallyFilter
!===============================================================================
@ -119,7 +123,78 @@ module tally_header
! Number of realizations of tally random variables
integer :: n_realizations = 0
! Type-Bound procedures
contains
procedure :: clear => tallyobject_clear ! Deallocates TallyObject
end type TallyObject
contains
!===============================================================================
! TALLYFILTER_CLEAR deallocates a TallyFilter element and sets it to its as
! initialized state.
!===============================================================================
subroutine tallyfilter_clear(this)
class(TallyFilter), intent(inout) :: this ! The TallyFilter to be cleared
this % type = NONE
this % n_bins = 0
if (allocated(this % int_bins)) &
deallocate(this % int_bins)
if (allocated(this % real_bins)) &
deallocate(this % real_bins)
end subroutine tallyfilter_clear
!===============================================================================
! TALLYOBJECT_CLEAR deallocates a TallyObject element and sets it to its as
! initialized state.
!===============================================================================
subroutine tallyobject_clear(this)
class(TallyObject), intent(inout) :: this ! The TallyObject to be cleared
integer :: i ! Loop Index
! This routine will go through each item in TallyObject and set the value
! to its default, as-initialized values, including deallocations.
this % label = ""
if (allocated(this % filters)) then
do i = 1, size(this % filters)
call this % filters(i) % clear()
end do
deallocate(this % filters)
end if
if (allocated(this % matching_bins)) &
deallocate(this % matching_bins)
if (allocated(this % stride)) &
deallocate(this % stride)
this % find_filter = 0
this % n_nuclide_bins = 0
if (allocated(this % nuclide_bins)) &
deallocate(this % nuclide_bins)
this % all_nuclides = .false.
this % n_score_bins = 0
if (allocated(this % score_bins)) &
deallocate(this % score_bins)
if (allocated(this % scatt_order)) &
deallocate(this % scatt_order)
this % n_user_score_bins = 0
if (allocated(this % results)) &
deallocate(this % results)
this % reset = .false.
this % n_realizations = 0
end subroutine tallyobject_clear
end module tally_header