Skip to content

Commit eae7e5d

Browse files
paulromanopaulromano
committed
Merge pull request #162 from nelsonag/valgrind
Addition of clear routines to significantly reduce Valgrind-reported memory leaks
2 parents 367908a + bc1678b commit eae7e5d

File tree

7 files changed

+345
-59
lines changed

7 files changed

+345
-59
lines changed

‎src/ace.F90

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -165,6 +165,10 @@ subroutine read_xs()
165165
if (allocated(mat % sab_names)) deallocate(mat % sab_names)
166166

167167
end do MATERIAL_LOOP2
168+
169+
! Avoid some valgrind leak errors
170+
call already_read % clear()
171+
168172
end subroutine read_xs
169173

170174
!===============================================================================

‎src/ace_header.F90

Lines changed: 146 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,10 @@ module ace_header
1616
integer, allocatable :: type(:) ! type of distribution
1717
integer, allocatable :: location(:) ! location of each table
1818
real(8), allocatable :: data(:) ! angular distribution data
19+
20+
! Type-Bound procedures
21+
contains
22+
procedure :: clear => distangle_clear ! Deallocates DistAngle
1923
end type DistAngle
2024

2125
!===============================================================================
@@ -31,6 +35,10 @@ module ace_header
3135
! For reactions that may have multiple energy distributions such as (n.2n),
3236
! this pointer allows multiple laws to be stored
3337
type(DistEnergy), pointer :: next => null()
38+
39+
! Type-Bound procedures
40+
contains
41+
procedure :: clear => distenergy_clear ! Deallocates DistEnergy
3442
end type DistEnergy
3543

3644
!===============================================================================
@@ -48,7 +56,11 @@ module ace_header
4856
logical :: has_angle_dist ! Angle distribution present?
4957
logical :: has_energy_dist ! Energy distribution present?
5058
type(DistAngle) :: adist ! Secondary angular distribution
51-
type(DistEnergy), pointer :: edist ! Secondary energy distribution
59+
type(DistEnergy), pointer :: edist => null() ! Secondary energy distribution
60+
61+
! Type-Bound procedures
62+
contains
63+
procedure :: clear => reaction_clear ! Deallocates Reaction
5264
end type Reaction
5365

5466
!===============================================================================
@@ -64,6 +76,10 @@ module ace_header
6476
logical :: multiply_smooth ! multiply by smooth cross section?
6577
real(8), allocatable :: energy(:) ! incident energies
6678
real(8), allocatable :: prob(:,:,:) ! actual probabibility tables
79+
80+
! Type-Bound procedures
81+
contains
82+
procedure :: clear => urrdata_clear ! Deallocates UrrData
6783
end type UrrData
6884

6985
!===============================================================================
@@ -121,7 +137,10 @@ module ace_header
121137
! Reactions
122138
integer :: n_reaction ! # of reactions
123139
type(Reaction), pointer :: reactions(:) => null()
124-
140+
141+
! Type-Bound procedures
142+
contains
143+
procedure :: clear => nuclide_clear ! Deallocates Nuclide
125144
end type Nuclide
126145

127146
!===============================================================================
@@ -216,4 +235,129 @@ module ace_header
216235
real(8) :: kappa_fission ! macroscopic energy-released from fission
217236
end type MaterialMacroXS
218237

238+
contains
239+
240+
!===============================================================================
241+
! DISTANGLE_CLEAR resets and deallocates data in Reaction.
242+
!===============================================================================
243+
244+
subroutine distangle_clear(this)
245+
246+
class(DistAngle), intent(inout) :: this ! The DistAngle object to clear
247+
248+
if (allocated(this % energy)) &
249+
deallocate(this % energy, this % type, this % location, this % data)
250+
251+
end subroutine distangle_clear
252+
253+
!===============================================================================
254+
! DISTENERGY_CLEAR resets and deallocates data in DistEnergy.
255+
!===============================================================================
256+
257+
recursive subroutine distenergy_clear(this)
258+
259+
class(DistEnergy), intent(inout) :: this ! The DistEnergy object to clear
260+
261+
! Clear p_valid
262+
call this % p_valid % clear()
263+
264+
if (allocated(this % data)) &
265+
deallocate(this % data)
266+
267+
if (associated(this % next)) then
268+
! recursively clear this item
269+
call this % next % clear()
270+
deallocate(this % next)
271+
end if
272+
273+
end subroutine distenergy_clear
274+
275+
!===============================================================================
276+
! REACTION_CLEAR resets and deallocates data in Reaction.
277+
!===============================================================================
278+
279+
subroutine reaction_clear(this)
280+
281+
class(Reaction), intent(inout) :: this ! The Reaction object to clear
282+
283+
if (allocated(this % sigma)) &
284+
deallocate(this % sigma)
285+
286+
if (associated(this % edist)) then
287+
call this % edist % clear()
288+
deallocate(this % edist)
289+
end if
290+
291+
call this % adist % clear()
292+
293+
end subroutine reaction_clear
294+
295+
!===============================================================================
296+
! URRDATA_CLEAR resets and deallocates data in Reaction.
297+
!===============================================================================
298+
299+
subroutine urrdata_clear(this)
300+
301+
class(UrrData), intent(inout) :: this ! The UrrData object to clear
302+
303+
if (allocated(this % energy)) &
304+
deallocate(this % energy, this % prob)
305+
306+
end subroutine urrdata_clear
307+
308+
!===============================================================================
309+
! NUCLIDE_CLEAR resets and deallocates data in Nuclide.
310+
!===============================================================================
311+
312+
subroutine nuclide_clear(this)
313+
314+
class(Nuclide), intent(inout) :: this ! The Nuclide object to clear
315+
316+
integer :: i ! Loop counter
317+
318+
if (allocated(this % grid_index)) &
319+
deallocate(this % grid_index)
320+
321+
if (allocated(this % energy)) &
322+
deallocate(this % total, this % elastic, this % fission, &
323+
this % nu_fission, this % absorption)
324+
if (allocated(this % heating)) &
325+
deallocate(this % heating)
326+
327+
if (allocated(this % index_fission)) &
328+
deallocate(this % index_fission)
329+
330+
if (allocated(this % nu_t_data)) &
331+
deallocate(this % nu_t_data)
332+
333+
if (allocated(this % nu_p_data)) &
334+
deallocate(this % nu_p_data)
335+
336+
if (allocated(this % nu_d_data)) &
337+
deallocate(this % nu_d_data)
338+
339+
if (allocated(this % nu_d_precursor_data)) &
340+
deallocate(this % nu_d_precursor_data)
341+
342+
if (associated(this % nu_d_edist)) then
343+
do i = 1, size(this % nu_d_edist)
344+
call this % nu_d_edist(i) % clear()
345+
end do
346+
deallocate(this % nu_d_edist)
347+
end if
348+
349+
if (associated(this % urr_data)) then
350+
call this % urr_data % clear()
351+
deallocate(this % urr_data)
352+
end if
353+
354+
if (associated(this % reactions)) then
355+
do i = 1, size(this % reactions)
356+
call this % reactions(i) % clear()
357+
end do
358+
deallocate(this % reactions)
359+
end if
360+
361+
end subroutine nuclide_clear
362+
219363
end module ace_header

‎src/dict_header.F90

Lines changed: 62 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -64,10 +64,10 @@ module dict_header
6464
type(HashListCI), pointer :: table(:) => null()
6565
contains
6666
procedure :: add_key => dict_add_key_ci
67-
procedure :: delete => dict_delete_ci
6867
procedure :: get_key => dict_get_key_ci
6968
procedure :: has_key => dict_has_key_ci
7069
procedure :: keys => dict_keys_ci
70+
procedure :: clear => dict_clear_ci
7171
procedure, private :: get_elem => dict_get_elem_ci
7272
end type DictCharInt
7373

@@ -76,10 +76,10 @@ module dict_header
7676
type(HashListII), pointer :: table(:) => null()
7777
contains
7878
procedure :: add_key => dict_add_key_ii
79-
procedure :: delete => dict_delete_ii
8079
procedure :: get_key => dict_get_key_ii
8180
procedure :: has_key => dict_has_key_ii
8281
procedure :: keys => dict_keys_ii
82+
procedure :: clear => dict_clear_ii
8383
procedure, private :: get_elem => dict_get_elem_ii
8484
end type DictIntInt
8585

@@ -150,54 +150,6 @@ subroutine dict_add_key_ii(this, key, value)
150150

151151
end subroutine dict_add_key_ii
152152

153-
!===============================================================================
154-
! DICT_DELETE deletes all (key,value) pairs from the dictionary
155-
!===============================================================================
156-
157-
subroutine dict_delete_ci(this)
158-
159-
class(DictCharInt) :: this
160-
161-
integer :: i
162-
type(ElemKeyValueCI), pointer :: current
163-
type(ElemKeyValueCI), pointer :: next
164-
165-
if (associated(this % table)) then
166-
do i = 1, size(this % table)
167-
current => this % table(i) % list
168-
do while (associated(current))
169-
next => current % next
170-
deallocate(current)
171-
current => next
172-
end do
173-
nullify(this % table(i) % list)
174-
end do
175-
end if
176-
177-
end subroutine dict_delete_ci
178-
179-
subroutine dict_delete_ii(this)
180-
181-
class(DictIntInt) :: this
182-
183-
integer :: i
184-
type(ElemKeyValueII), pointer :: current
185-
type(ElemKeyValueII), pointer :: next
186-
187-
if (associated(this % table)) then
188-
do i = 1, size(this % table)
189-
current => this % table(i) % list
190-
do while (associated(current))
191-
next => current % next
192-
deallocate(current)
193-
current => next
194-
end do
195-
nullify(this % table(i) % list)
196-
end do
197-
end if
198-
199-
end subroutine dict_delete_ii
200-
201153
!===============================================================================
202154
! DICT_GET_ELEM returns a pointer to the (key,value) pair for a given key. This
203155
! method is private.
@@ -429,4 +381,64 @@ function dict_keys_ii(this) result(keys)
429381

430382
end function dict_keys_ii
431383

384+
!===============================================================================
385+
! DICT_CLEAR Deletes and deallocates the dictionary item
386+
!===============================================================================
387+
388+
subroutine dict_clear_ci(this)
389+
390+
class(DictCharInt) :: this
391+
392+
integer :: i
393+
type(ElemKeyValueCI), pointer :: current
394+
type(ElemKeyValueCI), pointer :: next
395+
396+
if (associated(this % table)) then
397+
do i = 1, size(this % table)
398+
current => this % table(i) % list
399+
do while (associated(current))
400+
if (associated(current % next)) then
401+
next => current % next
402+
else
403+
nullify(next)
404+
end if
405+
deallocate(current)
406+
current => next
407+
end do
408+
if (associated(this % table(i) % list)) &
409+
nullify(this % table(i) % list)
410+
end do
411+
deallocate(this % table)
412+
end if
413+
414+
end subroutine dict_clear_ci
415+
416+
subroutine dict_clear_ii(this)
417+
418+
class(DictIntInt) :: this
419+
420+
integer :: i
421+
type(ElemKeyValueII), pointer :: current
422+
type(ElemKeyValueII), pointer :: next
423+
424+
if (associated(this % table)) then
425+
do i = 1, size(this % table)
426+
current => this % table(i) % list
427+
do while (associated(current))
428+
if (associated(current % next)) then
429+
next => current % next
430+
else
431+
nullify(next)
432+
end if
433+
deallocate(current)
434+
current => next
435+
end do
436+
if (associated(this % table(i) % list)) &
437+
nullify(this % table(i) % list)
438+
end do
439+
deallocate(this % table)
440+
end if
441+
442+
end subroutine dict_clear_ii
443+
432444
end module dict_header

‎src/endf_header.F90

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,28 @@ module endf_header
1313
integer :: n_pairs ! # of pairs of (x,y) values
1414
real(8), allocatable :: x(:) ! values of abscissa
1515
real(8), allocatable :: y(:) ! values of ordinate
16+
17+
! Type-Bound procedures
18+
contains
19+
procedure :: clear => Tab1_clear ! deallocates a Tab1 Object.
1620
end type Tab1
21+
22+
contains
23+
24+
!===============================================================================
25+
! TAB1_CLEAR deallocates the items in Tab1
26+
!===============================================================================
27+
28+
subroutine tab1_clear(this)
29+
30+
class(Tab1), intent(inout) :: this ! The Tab1 to clear
31+
32+
if (allocated(this % nbt)) &
33+
deallocate(this % nbt, this % int)
34+
35+
if (allocated(this % x)) &
36+
deallocate(this % x, this % y)
37+
38+
end subroutine tab1_clear
1739

1840
end module endf_header

0 commit comments

Comments
 (0)