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

Merge branch 'ListDictRefactor'

Browse source
This commit is contained in:
Paul Romano 2013-01-28 14:17:51 -05:00
commit f84615e755
17 changed files with 1567 additions and 1642 deletions
Download patch file Download diff file Expand all files Collapse all files

26
src/DEPENDENCIES
View file

@ -1,13 +1,12 @@
ace.o: ace_header.o
ace.o: constants.o
ace.o: datatypes.o
ace.o: datatypes_header.o
ace.o: endf.o
ace.o: error.o
ace.o: fission.o
ace.o: global.o
ace.o: material_header.o
ace.o: output.o
ace.o: set_header.o
ace.o: string.o
ace_header.o: constants.o
@ -38,7 +37,6 @@ cmfd_execute.o: tally.o
cmfd_header.o: constants.o
cmfd_input.o: cmfd_message_passing.o
cmfd_input.o: datatypes.o
cmfd_input.o: error.o
cmfd_input.o: global.o
cmfd_input.o: mesh_header.o
@ -113,17 +111,14 @@ cross_section.o: material_header.o
cross_section.o: random_lcg.o
cross_section.o: search.o
datatypes.o: datatypes_header.o
doppler.o: constants.o
endf.o: constants.o
endf.o: string.o
energy_grid.o: constants.o
energy_grid.o: datatypes.o
energy_grid.o: datatypes_header.o
energy_grid.o: global.o
energy_grid.o: list_header.o
energy_grid.o: output.o
error.o: global.o
@ -153,7 +148,6 @@ fixed_source.o: string.o
fixed_source.o: tally.o
geometry.o: constants.o
geometry.o: datatypes.o
geometry.o: error.o
geometry.o: geometry_header.o
geometry.o: global.o
@ -166,8 +160,8 @@ global.o: ace_header.o
global.o: bank_header.o
global.o: cmfd_header.o
global.o: constants.o
global.o: datatypes.o
global.o: datatypes_header.o
global.o: dict_header.o
global.o: list_header.o
global.o: geometry_header.o
global.o: material_header.o
global.o: mesh_header.o
@ -192,8 +186,7 @@ hdf5_interface.o: tally_header.o
initialize.o: ace.o
initialize.o: bank_header.o
initialize.o: constants.o
initialize.o: datatypes.o
initialize.o: datatypes_header.o
initialize.o: dict_header.o
initialize.o: energy_grid.o
initialize.o: error.o
initialize.o: geometry.o
@ -211,8 +204,7 @@ initialize.o: tally_initialize.o
input_xml.o: cmfd_input.o
input_xml.o: constants.o
input_xml.o: datatypes.o
input_xml.o: datatypes_header.o
input_xml.o: dict_header.o
input_xml.o: error.o
input_xml.o: geometry_header.o
input_xml.o: global.o
@ -235,6 +227,8 @@ interpolation.o: global.o
interpolation.o: search.o
interpolation.o: string.o
list_header.o: constants.o
main.o: constants.o
main.o: eigenvalue.o
main.o: finalize.o
@ -253,7 +247,6 @@ mesh.o: search.o
output.o: ace_header.o
output.o: constants.o
output.o: datatypes.o
output.o: endf.o
output.o: geometry_header.o
output.o: global.o
@ -305,6 +298,8 @@ random_lcg.o: global.o
search.o: error.o
search.o: global.o
set_header.o: list_header.o
source.o: bank_header.o
source.o: constants.o
source.o: error.o
@ -331,7 +326,6 @@ string.o: global.o
tally.o: ace_header.o
tally.o: constants.o
tally.o: datatypes_header.o
tally.o: error.o
tally.o: global.o
tally.o: math.o

5
src/OBJECTS
View file

@ -15,8 +15,7 @@ cmfd_prod_operator.o \
cmfd_snes_solver.o \
constants.o \
cross_section.o \
datatypes.o \
datatypes_header.o \
dict_header.o \
doppler.o \
eigenvalue.o \
endf.o \
@ -33,6 +32,7 @@ hdf5_interface.o \
initialize.o \
interpolation.o \
input_xml.o \
list_header.o \
main.o \
material_header.o \
math.o \
@ -46,6 +46,7 @@ plot_header.o \
ppmlib.o \
random_lcg.o \
search.o \
set_header.o \
source.o \
source_header.o \
state_point.o \

32
src/ace.F90
View file

@ -3,15 +3,13 @@ module ace
use ace_header, only: Nuclide, Reaction, SAlphaBeta, XsListing, &
DistEnergy
use constants
use datatypes, only: dict_create, dict_add_key, dict_get_key, &
dict_has_key, dict_delete, dict_keys
use datatypes_header, only: DictionaryCI, ListKeyValueCI
use endf, only: reaction_name
use error, only: fatal_error, warning
use fission, only: nu_total
use global
use material_header, only: Material
use output, only: write_message
use set_header, only: SetChar
use string, only: str_to_int, str_to_real, lower_case, to_str
implicit none
@ -41,10 +39,10 @@ contains
integer :: i_sab ! index in sab_tables
character(12) :: name ! name of isotope, e.g. 92235.03c
character(12) :: alias ! alias of nuclide, e.g. U-235.03c
type(Material), pointer :: mat => null()
type(Nuclide), pointer :: nuc => null()
type(Material), pointer :: mat => null()
type(Nuclide), pointer :: nuc => null()
type(SAlphaBeta), pointer :: sab => null()
type(DictionaryCI), pointer :: already_read => null()
type(SetChar) :: already_read
! allocate arrays for ACE table storage and cross section cache
allocate(nuclides(n_nuclides_total))
@ -54,8 +52,6 @@ contains
! ==========================================================================
! READ ALL ACE CROSS SECTION TABLES
call dict_create(already_read)
! Loop over all files
do i = 1, n_materials
mat => materials(i)
@ -63,9 +59,9 @@ contains
do j = 1, mat % n_nuclides
name = mat % names(j)
if (.not. dict_has_key(already_read, name)) then
i_listing = dict_get_key(xs_listing_dict, name)
i_nuclide = dict_get_key(nuclide_dict, name)
if (.not. already_read % contains(name)) then
i_listing = xs_listing_dict % get_key(name)
i_nuclide = nuclide_dict % get_key(name)
name = xs_listings(i_listing) % name
alias = xs_listings(i_listing) % alias
@ -78,30 +74,28 @@ contains
call read_ace_table(i_nuclide, i_listing)
! Add name and alias to dictionary
call dict_add_key(already_read, name, 0)
call dict_add_key(already_read, alias, 0)
call already_read % add(name)
call already_read % add(alias)
end if
end do
if (mat % has_sab_table) then
name = mat % sab_name
if (.not. dict_has_key(already_read, name)) then
i_listing = dict_get_key(xs_listing_dict, name)
i_sab = dict_get_key(sab_dict, name)
if (.not. already_read % contains(name)) then
i_listing = xs_listing_dict % get_key(name)
i_sab = sab_dict % get_key(name)
! Read the ACE table into the appropriate entry on the sab_tables
! array
call read_ace_table(i_sab, i_listing)
! Add name to dictionary
call dict_add_key(already_read, name, 0)
call already_read % add(name)
end if
end if
end do
call dict_delete(already_read)
! ==========================================================================
! ASSIGN S(A,B) TABLES TO SPECIFIC NUCLIDES WITHIN MATERIALS

3
src/cmfd_input.F90
View file

@ -188,7 +188,6 @@ contains
subroutine create_cmfd_tally()
use datatypes, only: dict_add_key, dict_get_key
use error, only: fatal_error, warning
use global
use mesh_header, only: StructuredMesh
@ -330,7 +329,7 @@ contains
m % volume_frac = ONE/real(product(m % dimension),8)
! Add mesh to dictionary
call dict_add_key(mesh_dict, m % id, n_user_meshes + 1)
call mesh_dict % add_key(m % id, n_user_meshes + 1)
! allocate tallies
if (.not. allocated(tallies)) allocate(tallies(n_tallies))

1098
src/datatypes.F90
View file

File diff suppressed because it is too large Load diff

113
src/datatypes_header.F90
View file

@ -1,113 +0,0 @@
module datatypes_header
!===============================================================================
! DATATYPES_HEADER module contains the derived types for (key,value) pairs,
! lists, and dictionaries. It would be nice to add sets as well. This module
! could be made a LOT cleaner by using unlimited polymorphism, but we will wait
! on that since compiler support is still limited (namely gfortran which doesn't
! support it yet)
!===============================================================================
implicit none
!===============================================================================
! KEYVALUECI stores the (key,value) pair for a dictionary where the key is a
! string and the value is an integer. Note that we need to store the key in
! addition to the value for collision resolution.
!===============================================================================
! Key length for dictionary
integer, parameter :: DICT_KEY_LENGTH = 255
type KeyValueCI
character(len=DICT_KEY_LENGTH) :: key
integer :: value
end type KeyValueCI
!===============================================================================
! KEYVALUEII stores the (key,value) pair for a dictionary where the key is an
! integer and the value is an integer. Note that we need to store the key in
! addition to the value for collision resolution.
!===============================================================================
type KeyValueII
integer :: key
integer :: value
end type KeyValueII
!===============================================================================
! LISTKEYVALUECI stores a linked list of (key,value) pairs where the key is a
! character and the value is an integer
!===============================================================================
type ListKeyValueCI
type(ListKeyValueCI), pointer :: next => null()
type(KeyValueCI) :: data
end type ListKeyValueCI
!===============================================================================
! LISTKEYVALUEII stores a linked list of (key,value) pairs where the key is a
! character and the value is an integer
!===============================================================================
type ListKeyValueII
type(ListKeyValueII), pointer :: next => null()
type(KeyValueII) :: data
end type ListKeyValueII
!===============================================================================
! LISTREAL stores a linked list of real values. This is used for constructing a
! unionized energy grid.
!===============================================================================
type ListReal
type(ListReal), pointer :: next => null()
real(8) :: data
end type ListReal
!===============================================================================
! LISTINT stores a linked list of integer values.
!===============================================================================
type ListInt
type(ListInt), pointer :: next => null()
integer :: data
end type ListInt
!===============================================================================
! HASHLISTCI - Since it's not possible to directly do an array of pointers, this
! derived type provides a pointer
!===============================================================================
type HashListCI
type(ListKeyValueCI), pointer :: list => null()
end type HashListCI
!===============================================================================
! HASHLISTII - Since it's not possible to directly do an array of pointers, this
! derived type provides a pointer
!===============================================================================
type HashListII
type(ListKeyValueII), pointer :: list => null()
end type HashListII
!===============================================================================
! DICTIONARYCI provides a dictionary data structure of (key,value) pairs where
! the keys are strings and values are integers.
!===============================================================================
type DictionaryCI
type(HashListCI), pointer :: table(:) => null()
end type DictionaryCI
!===============================================================================
! DICTIONARYII provides a dictionary data structure of (key,value) pairs where
! the keys and values are both integers.
!===============================================================================
type DictionaryII
type(HashListII), pointer :: table(:) => null()
end type DictionaryII
end module datatypes_header

432
src/dict_header.F90 Normal file
View file

@ -0,0 +1,432 @@
module dict_header
!===============================================================================
! DICT_HEADER module
!
! This module provides an implementation of a dictionary that has (key,value)
! pairs. This data structure is used to provide lookup features, e.g. cells and
! surfaces by name.
!
! The original version was roughly based on capabilities in the 'flibs' open
! source package. However, it was rewritten from scratch so that it could be
! used stand-alone without relying on the implementation of lists. As with
! lists, it was considered writing a single dictionary used unlimited
! polymorphism, but again compiler support is spotty and doesn't always prevent
! duplication of code.
!===============================================================================
implicit none
integer, parameter, private :: HASH_SIZE = 4993
integer, parameter, private :: HASH_MULTIPLIER = 31
integer, parameter, private :: DICT_NULL = -huge(0)
integer, parameter :: DICT_KEY_LENGTH = 255
!===============================================================================
! ELEMKEYVALUE* contains (key,value) pairs and a pointer to the next (key,value)
! pair
!===============================================================================
type ElemKeyValueCI
type(ElemKeyValueCI), pointer :: next => null()
character(len=DICT_KEY_LENGTH) :: key
integer :: value
end type ElemKeyValueCI
type ElemKeyValueII
type(ElemKeyValueII), pointer :: next => null()
integer :: key
integer :: value
end type ElemKeyValueII
!===============================================================================
! HASHLIST* types contain a single pointer to a linked list of (key,value)
! pairs. This type is necesssary so that the Dict types can be dynamically
! allocated.
!===============================================================================
type, private :: HashListCI
type(ElemKeyValueCI), pointer :: list => null()
end type HashListCI
type, private :: HashListII
type(ElemKeyValueII), pointer :: list => null()
end type HashListII
!===============================================================================
! DICT* is a dictionary of (key,value) pairs with convenience methods as
! type-bound procedures. DictCharInt has character(*) keys and integer values,
! and DictIntInt has integer keys and values.
!===============================================================================
type, public :: DictCharInt
private
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, private :: get_elem => dict_get_elem_ci
end type DictCharInt
type, public :: DictIntInt
private
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, private :: get_elem => dict_get_elem_ii
end type DictIntInt
contains
!===============================================================================
! DICT_ADD_KEY adds a (key,value) entry to a dictionary. If the key is already
! in the dictionary, the value is replaced by the new specified value.
!===============================================================================
subroutine dict_add_key_ci(this, key, value)
class(DictCharInt) :: this
character(*), intent(in) :: key
integer, intent(in) :: value
integer :: hash
type(ElemKeyValueCI), pointer :: elem => null()
type(ElemKeyValueCI), pointer :: new_elem => null()
elem => this % get_elem(key)
if (associated(elem)) then
elem % value = value
else
! Get hash
hash = dict_hash_key_ci(key)
! Create new element
allocate(new_elem)
new_elem % key = key
new_elem % value = value
! Add element to front of list
new_elem % next => this % table(hash) % list
this % table(hash) % list => new_elem
end if
end subroutine dict_add_key_ci
subroutine dict_add_key_ii(this, key, value)
class(DictIntInt) :: this
integer, intent(in) :: key
integer, intent(in) :: value
integer :: hash
type(ElemKeyValueII), pointer :: elem => null()
type(ElemKeyValueII), pointer :: new_elem => null()
elem => this % get_elem(key)
if (associated(elem)) then
elem % value = value
else
! Get hash
hash = dict_hash_key_ii(key)
! Create new element
allocate(new_elem)
new_elem % key = key
new_elem % value = value
! Add element to front of list
new_elem % next => this % table(hash) % list
this % table(hash) % list => new_elem
end if
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.
!===============================================================================
function dict_get_elem_ci(this, key) result(elem)
class(DictCharInt) :: this
character(*), intent(in) :: key
type(ElemKeyValueCI), pointer :: elem
integer :: hash
! Check for dictionary not being allocated
if (.not. associated(this % table)) then
allocate(this % table(HASH_SIZE))
end if
hash = dict_hash_key_ci(key)
elem => this % table(hash) % list
do while (associated(elem))
if (elem % key == key) exit
elem => elem % next
end do
end function dict_get_elem_ci
function dict_get_elem_ii(this, key) result(elem)
class(DictIntInt) :: this
integer, intent(in) :: key
type(ElemKeyValueII), pointer :: elem
integer :: hash
! Check for dictionary not being allocated
if (.not. associated(this % table)) then
allocate(this % table(HASH_SIZE))
end if
hash = dict_hash_key_ii(key)
elem => this % table(hash) % list
do while (associated(elem))
if (elem % key == key) exit
elem => elem % next
end do
end function dict_get_elem_ii
!===============================================================================
! DICT_GET_KEY returns the value matching a given key. If the dictionary does
! not contain the key, the value DICT_NULL is returned.
!===============================================================================
function dict_get_key_ci(this, key) result(value)
class(DictCharInt) :: this
character(*), intent(in) :: key
integer :: value
type(ElemKeyValueCI), pointer :: elem
elem => this % get_elem(key)
if (associated(elem)) then
value = elem % value
else
value = DICT_NULL
end if
end function dict_get_key_ci
function dict_get_key_ii(this, key) result(value)
class(DictIntInt) :: this
integer, intent(in) :: key
integer :: value
type(ElemKeyValueII), pointer :: elem
elem => this % get_elem(key)
if (associated(elem)) then
value = elem % value
else
value = DICT_NULL
end if
end function dict_get_key_ii
!===============================================================================
! DICT_HAS_KEY determines whether a dictionary has a (key,value) pair with a
! given key.
!===============================================================================
function dict_has_key_ci(this, key) result(has)
class(DictCharInt) :: this
character(*), intent(in) :: key
logical :: has
type(ElemKeyValueCI), pointer :: elem
elem => this % get_elem(key)
has = associated(elem)
end function dict_has_key_ci
function dict_has_key_ii(this, key) result(has)
class(DictIntInt) :: this
integer, intent(in) :: key
logical :: has
type(ElemKeyValueII), pointer :: elem
elem => this % get_elem(key)
has = associated(elem)
end function dict_has_key_ii
!===============================================================================
! DICT_HASH_KEY returns the hash value for a given key
!===============================================================================
function dict_hash_key_ci(key) result(val)
character(*), intent(in) :: key
integer :: val
integer :: i
val = 0
do i = 1, len_trim(key)
val = HASH_MULTIPLIER * val + ichar(key(i:i))
end do
! Added the absolute val on val-1 since the sum in the do loop is
! susceptible to integer overflow
val = 1 + mod(abs(val-1), HASH_SIZE)
end function dict_hash_key_ci
function dict_hash_key_ii(key) result(val)
integer, intent(in) :: key
integer :: val
val = 0
! Added the absolute val on val-1 since the sum in the do loop is
! susceptible to integer overflow
val = 1 + mod(abs(key-1), HASH_SIZE)
end function dict_hash_key_ii
!===============================================================================
! DICT_KEYS returns a pointer to a linked list of all (key,value) pairs
!===============================================================================
function dict_keys_ci(this) result(keys)
class(DictCharInt) :: this
type(ElemKeyValueCI), pointer :: keys
integer :: i
type(ElemKeyValueCI), pointer :: current => null()
type(ElemKeyValueCI), pointer :: elem => null()
keys => null()
do i = 1, size(this % table)
! Get pointer to start of bucket i
elem => this % table(i) % list
do while (associated(elem))
! Allocate (key,value) pair
if (.not. associated(keys)) then
allocate(keys)
current => keys
else
allocate(current % next)
current => current % next
end if
! Copy (key,value) pair
current % key = elem % key
current % value = elem % value
! Move to next element in bucket i
elem => elem % next
end do
end do
end function dict_keys_ci
function dict_keys_ii(this) result(keys)
class(DictIntInt) :: this
type(ElemKeyValueII), pointer :: keys
integer :: i
type(ElemKeyValueII), pointer :: current => null()
type(ElemKeyValueII), pointer :: elem => null()
keys => null()
do i = 1, size(this % table)
! Get pointer to start of bucket i
elem => this % table(i) % list
do while (associated(elem))
! Allocate (key,value) pair
if (.not. associated(keys)) then
allocate(keys)
current => keys
else
allocate(current % next)
current => current % next
end if
! Copy (key,value) pair
current % key = elem % key
current % value = elem % value
! Move to next element in bucket i
elem => elem % next
end do
end do
end function dict_keys_ii
end module dict_header

34
src/energy_grid.F90
View file

@ -1,11 +1,8 @@
module energy_grid
use constants, only: MAX_LINE_LEN
use datatypes, only: list_insert, list_size, list_delete, &
dict_create, dict_get_key, dict_has_key, &
dict_add_key, dict_delete
use datatypes_header, only: ListReal, DictionaryCI
use global
use list_header, only: ListElemReal
use output, only: write_message
contains
@ -20,10 +17,10 @@ contains
subroutine unionized_grid()
integer :: i ! index in nuclides array
type(ListReal), pointer :: list => null()
type(ListReal), pointer :: current => null()
type(Nuclide), pointer :: nuc => null()
integer :: i ! index in nuclides array
type(ListElemReal), pointer :: list => null()
type(ListElemReal), pointer :: current => null()
type(Nuclide), pointer :: nuc => null()
message = "Creating unionized energy grid..."
call write_message(5)
@ -34,8 +31,15 @@ contains
call add_grid_points(list, nuc % energy)
end do
! determine size of list
n_grid = 0
current => list
do while (associated(current))
n_grid = n_grid + 1
current => current % next
end do
! create allocated array from linked list
n_grid = list_size(list)
allocate(e_grid(n_grid))
current => list
do i = 1, n_grid
@ -44,7 +48,7 @@ contains
end do
! delete linked list and dictionary
call list_delete(list)
! call list_delete(list)
! Set pointers to unionized energy grid for each nuclide
call grid_pointers()
@ -58,16 +62,16 @@ contains
subroutine add_grid_points(list, energy)
type(ListReal), pointer :: list
type(ListElemReal), pointer :: list
real(8), intent(in) :: energy(:)
integer :: i ! index in energy array
integer :: n ! size of energy array
real(8) :: E ! actual energy value
type(ListReal), pointer :: current => null()
type(ListReal), pointer :: previous => null()
type(ListReal), pointer :: head => null()
type(ListReal), pointer :: tmp => null()
type(ListElemReal), pointer :: current => null()
type(ListElemReal), pointer :: previous => null()
type(ListElemReal), pointer :: head => null()
type(ListElemReal), pointer :: tmp => null()
i = 1
n = size(energy)

5
src/geometry.F90
View file

@ -1,7 +1,6 @@
module geometry
use constants
use datatypes, only: dict_get_key
use error, only: fatal_error
use geometry_header, only: Cell, Surface, Universe, Lattice
use global
@ -264,7 +263,7 @@ contains
! forward slightly so that if the mesh boundary is on the surface, it is
! still processed
if (associated(active_current_tallies)) then
if (active_current_tallies % size() > 0) then
! TODO: Find a better solution to score surface currents than
! physically moving the particle forward slightly
@ -298,7 +297,7 @@ contains
! particle to change -- artificially move the particle slightly back in
! case the surface crossing in coincident with a mesh boundary
if (associated(active_current_tallies)) then
if (active_current_tallies % size() > 0) then
p % coord0 % xyz = p % coord0 % xyz - TINY_BIT * p % coord0 % uvw
call score_surface_current()
p % coord0 % xyz = p % coord0 % xyz + TINY_BIT * p % coord0 % uvw

40
src/global.F90
View file

@ -5,8 +5,8 @@ module global
use bank_header, only: Bank
use cmfd_header
use constants
use datatypes, only: list_delete
use datatypes_header, only: DictionaryII, DictionaryCI, ListInt
use dict_header, only: DictCharInt, DictIntInt
use list_header, only: ListInt
use geometry_header, only: Cell, Universe, Lattice, Surface
use material_header, only: Material
use mesh_header, only: StructuredMesh
@ -54,13 +54,13 @@ module global
! These dictionaries provide a fast lookup mechanism -- the key is the
! user-specified identifier and the value is the index in the corresponding
! array
type(DictionaryII), pointer :: cell_dict => null()
type(DictionaryII), pointer :: universe_dict => null()
type(DictionaryII), pointer :: lattice_dict => null()
type(DictionaryII), pointer :: surface_dict => null()
type(DictionaryII), pointer :: material_dict => null()
type(DictionaryII), pointer :: mesh_dict => null()
type(DictionaryII), pointer :: tally_dict => null()
type(DictIntInt) :: cell_dict
type(DictIntInt) :: universe_dict
type(DictIntInt) :: lattice_dict
type(DictIntInt) :: surface_dict
type(DictIntInt) :: material_dict
type(DictIntInt) :: mesh_dict
type(DictIntInt) :: tally_dict
! ============================================================================
! CROSS SECTION RELATED VARIABLES
@ -79,9 +79,9 @@ module global
integer :: n_listings ! Number of listings in cross_sections.xml
! Dictionaries to look up cross sections and listings
type(DictionaryCI), pointer :: nuclide_dict => null()
type(DictionaryCI), pointer :: sab_dict => null()
type(DictionaryCI), pointer :: xs_listing_dict => null()
type(DictCharInt) :: nuclide_dict
type(DictCharInt) :: sab_dict
type(DictCharInt) :: xs_listing_dict
! Unionized energy grid
integer :: grid_method ! how to treat the energy grid
@ -147,10 +147,10 @@ module global
!=============================================================================
! ACTIVE TALLY-RELATED VARIABLES
type(ListInt), pointer :: active_analog_tallies => null()
type(ListInt), pointer :: active_tracklength_tallies => null()
type(ListInt), pointer :: active_current_tallies => null()
type(ListInt), pointer :: active_tallies => null()
type(ListInt) :: active_analog_tallies
type(ListInt) :: active_tracklength_tallies
type(ListInt) :: active_current_tallies
type(ListInt) :: active_tallies
! ============================================================================
! EIGENVALUE SIMULATION VARIABLES
@ -416,10 +416,10 @@ contains
call deallocate_cmfd(cmfd)
! Deallocate tally node lists
call list_delete(active_analog_tallies)
call list_delete(active_tracklength_tallies)
call list_delete(active_current_tallies)
call list_delete(active_tallies)
call active_analog_tallies % clear()
call active_tracklength_tallies % clear()
call active_current_tallies % clear()
call active_tallies % clear()
end subroutine free_memory

96
src/initialize.F90
View file

@ -3,9 +3,7 @@ module initialize
use ace, only: read_xs
use bank_header, only: Bank
use constants
use datatypes, only: dict_create, dict_get_key, dict_has_key, &
dict_keys
use datatypes_header, only: ListKeyValueII, DictionaryII
use dict_header, only: DictIntInt, ElemKeyValueII
use energy_grid, only: unionized_grid
use error, only: fatal_error
use geometry, only: neighbor_lists
@ -67,9 +65,6 @@ contains
call header("INITIALIZATION", level=1)
end if
! set up dictionaries
call create_dictionaries()
! Read XML input files
call read_input_xml()
@ -343,31 +338,6 @@ contains
end subroutine read_command_line
!===============================================================================
! CREATE_DICTIONARIES initializes the various dictionary variables. It would be
! nice to avoid this and just have a check at the beginning of
! dictionary_add_key.
!===============================================================================
subroutine create_dictionaries()
! Create all global dictionaries
call dict_create(cell_dict)
call dict_create(universe_dict)
call dict_create(lattice_dict)
call dict_create(surface_dict)
call dict_create(material_dict)
call dict_create(mesh_dict)
call dict_create(tally_dict)
call dict_create(xs_listing_dict)
call dict_create(nuclide_dict)
call dict_create(sab_dict)
! Create special dictionary used in input_xml
call dict_create(cells_in_univ_dict)
end subroutine create_dictionaries
!===============================================================================
! PREPARE_UNIVERSES allocates the universes array and determines the cells array
! for each universe.
@ -380,7 +350,7 @@ contains
integer :: n_cells_in_univ ! number of cells in a universe
integer, allocatable :: index_cell_in_univ(:) ! the index in the univ%cells
! array for each universe
type(ListKeyValueII), pointer :: key_list => null()
type(ElemKeyValueII), pointer :: pair_list => null()
type(Universe), pointer :: univ => null()
type(Cell), pointer :: c => null()
@ -391,25 +361,25 @@ contains
! pairs are the id of the universe and the index in the array. In
! cells_in_univ_dict, it's the id of the universe and the number of cells.
key_list => dict_keys(universe_dict)
do while (associated(key_list))
pair_list => universe_dict % keys()
do while (associated(pair_list))
! find index of universe in universes array
i_univ = key_list % data % value
i_univ = pair_list % value
univ => universes(i_univ)
univ % id = key_list % data % key
univ % id = pair_list % key
! check for lowest level universe
if (univ % id == 0) BASE_UNIVERSE = i_univ
! find cell count for this universe
n_cells_in_univ = dict_get_key(cells_in_univ_dict, univ % id)
n_cells_in_univ = cells_in_univ_dict % get_key(univ % id)
! allocate cell list for universe
allocate(univ % cells(n_cells_in_univ))
univ % n_cells = n_cells_in_univ
! move to next universe
key_list => key_list % next
pair_list => pair_list % next
end do
! Also allocate a list for keeping track of where cells have been assigned
@ -422,7 +392,7 @@ contains
c => cells(i)
! get pointer to corresponding universe
i_univ = dict_get_key(universe_dict, c % universe)
i_univ = universe_dict % get_key(c % universe)
univ => universes(i_univ)
! increment the index for the cells array within the Universe object and
@ -460,8 +430,8 @@ contains
do j = 1, c % n_surfaces
id = c % surfaces(j)
if (id < OP_DIFFERENCE) then
if (dict_has_key(surface_dict, abs(id))) then
i_array = dict_get_key(surface_dict, abs(id))
if (surface_dict % has_key(abs(id))) then
i_array = surface_dict % get_key(abs(id))
c % surfaces(j) = sign(i_array, id)
else
message = "Could not find surface " // trim(to_str(abs(id))) // &
@ -475,8 +445,8 @@ contains
! ADJUST UNIVERSE INDEX FOR EACH CELL
id = c % universe
if (dict_has_key(universe_dict, id)) then
c % universe = dict_get_key(universe_dict, id)
if (universe_dict % has_key(id)) then
c % universe = universe_dict % get_key(id)
else
message = "Could not find universe " // trim(to_str(id)) // &
" specified on cell " // trim(to_str(c % id))
@ -490,9 +460,9 @@ contains
if (id == MATERIAL_VOID) then
c % type = CELL_NORMAL
elseif (id /= 0) then
if (dict_has_key(material_dict, id)) then
if (material_dict % has_key(id)) then
c % type = CELL_NORMAL
c % material = dict_get_key(material_dict, id)
c % material = material_dict % get_key(id)
else
message = "Could not find material " // trim(to_str(id)) // &
" specified on cell " // trim(to_str(c % id))
@ -500,12 +470,12 @@ contains
end if
else
id = c % fill
if (dict_has_key(universe_dict, id)) then
if (universe_dict % has_key(id)) then
c % type = CELL_FILL
c % fill = dict_get_key(universe_dict, id)
elseif (dict_has_key(lattice_dict, id)) then
c % fill = universe_dict % get_key(id)
elseif (lattice_dict % has_key(id)) then
c % type = CELL_LATTICE
c % fill = dict_get_key(lattice_dict, id)
c % fill = lattice_dict % get_key(id)
else
message = "Specified fill " // trim(to_str(id)) // " on cell " // &
trim(to_str(c % id)) // " is neither a universe nor a lattice."
@ -522,8 +492,8 @@ contains
do j = 1, l % n_x
do k = 1, l % n_y
id = l % element(j,k)
if (dict_has_key(universe_dict, id)) then
l % element(j,k) = dict_get_key(universe_dict, id)
if (universe_dict % has_key(id)) then
l % element(j,k) = universe_dict % get_key(id)
else
message = "Invalid universe number " // trim(to_str(id)) &
// " specified on lattice " // trim(to_str(l % id))
@ -546,8 +516,8 @@ contains
do k = 1, t % filters(j) % n_bins
id = t % filters(j) % int_bins(k)
if (dict_has_key(cell_dict, id)) then
t % filters(j) % int_bins(k) = dict_get_key(cell_dict, id)
if (cell_dict % has_key(id)) then
t % filters(j) % int_bins(k) = cell_dict % get_key(id)
else
message = "Could not find cell " // trim(to_str(id)) // &
" specified on tally " // trim(to_str(t % id))
@ -559,8 +529,8 @@ contains
do k = 1, t % filters(j) % n_bins
id = t % filters(j) % int_bins(k)
if (dict_has_key(surface_dict, id)) then
t % filters(j) % int_bins(k) = dict_get_key(surface_dict, id)
if (surface_dict % has_key(id)) then
t % filters(j) % int_bins(k) = surface_dict % get_key(id)
else
message = "Could not find surface " // trim(to_str(id)) // &
" specified on tally " // trim(to_str(t % id))
@ -572,8 +542,8 @@ contains
do k = 1, t % filters(j) % n_bins
id = t % filters(j) % int_bins(k)
if (dict_has_key(universe_dict, id)) then
t % filters(j) % int_bins(k) = dict_get_key(universe_dict, id)
if (universe_dict % has_key(id)) then
t % filters(j) % int_bins(k) = universe_dict % get_key(id)
else
message = "Could not find universe " // trim(to_str(id)) // &
" specified on tally " // trim(to_str(t % id))
@ -585,8 +555,8 @@ contains
do k = 1, t % filters(j) % n_bins
id = t % filters(j) % int_bins(k)
if (dict_has_key(material_dict, id)) then
t % filters(j) % int_bins(k) = dict_get_key(material_dict, id)
if (material_dict % has_key(id)) then
t % filters(j) % int_bins(k) = material_dict % get_key(id)
else
message = "Could not find material " // trim(to_str(id)) // &
" specified on tally " // trim(to_str(t % id))
@ -597,8 +567,8 @@ contains
case (FILTER_MESH)
id = t % filters(j) % int_bins(1)
if (dict_has_key(mesh_dict, id)) then
t % filters(j) % int_bins(1) = dict_get_key(mesh_dict, id)
if (mesh_dict % has_key(id)) then
t % filters(j) % int_bins(1) = mesh_dict % get_key(id)
else
message = "Could not find mesh " // trim(to_str(id)) // &
" specified on tally " // trim(to_str(t % id))
@ -640,7 +610,7 @@ contains
sum_percent = ZERO
do j = 1, mat % n_nuclides
! determine atomic weight ratio
index_list = dict_get_key(xs_listing_dict, mat % names(j))
index_list = xs_listing_dict % get_key(mat % names(j))
awr = xs_listings(index_list) % awr
! if given weight percent, convert all values so that they are divided
@ -662,7 +632,7 @@ contains
if (.not. density_in_atom) then
sum_percent = ZERO
do j = 1, mat % n_nuclides
index_list = dict_get_key(xs_listing_dict, mat % names(j))
index_list = xs_listing_dict % get_key(mat % names(j))
awr = xs_listings(index_list) % awr
x = mat % atom_density(j)
sum_percent = sum_percent + x*awr

82
src/input_xml.F90
View file

@ -2,9 +2,7 @@ module input_xml
use cmfd_input, only: configure_cmfd
use constants
use datatypes, only: dict_add_key, dict_has_key, dict_get_key, &
dict_keys
use datatypes_header, only: ListKeyValueCI
use dict_header, only: DictIntInt, ElemKeyValueCI
use error, only: fatal_error, warning
use geometry_header, only: Cell, Surface, Lattice
use global
@ -18,8 +16,8 @@ module input_xml
implicit none
type(DictionaryII), pointer :: & ! used to count how many cells each
cells_in_univ_dict => null() ! universe contains
type(DictIntInt) :: cells_in_univ_dict ! used to count how many cells each
! universe contains
contains
@ -729,20 +727,20 @@ contains
end if
! Add cell to dictionary
call dict_add_key(cell_dict, c % id, i)
call cell_dict % add_key(c % id, i)
! For cells, we also need to check if there's a new universe --
! also for every cell add 1 to the count of cells for the
! specified universe
universe_num = cell_(i) % universe
if (.not. dict_has_key(cells_in_univ_dict, universe_num)) then
if (.not. cells_in_univ_dict % has_key(universe_num)) then
n_universes = n_universes + 1
n_cells_in_univ = 1
call dict_add_key(universe_dict, universe_num, n_universes)
call universe_dict % add_key(universe_num, n_universes)
else
n_cells_in_univ = 1 + dict_get_key(cells_in_univ_dict, universe_num)
n_cells_in_univ = 1 + cells_in_univ_dict % get_key(universe_num)
end if
call dict_add_key(cells_in_univ_dict, universe_num, n_cells_in_univ)
call cells_in_univ_dict % add_key(universe_num, n_cells_in_univ)
end do
@ -861,7 +859,7 @@ contains
end select
! Add surface to dictionary
call dict_add_key(surface_dict, s % id, i)
call surface_dict % add_key(s % id, i)
end do
@ -929,7 +927,7 @@ contains
end do
! Add lattice to dictionary
call dict_add_key(lattice_dict, l % id, i)
call lattice_dict % add_key(l % id, i)
end do
@ -1081,7 +1079,7 @@ contains
mat % names(j) = name
! Check that this nuclide is listed in the cross_sections.xml file
if (.not. dict_has_key(xs_listing_dict, name)) then
if (.not. xs_listing_dict % has_key(name)) then
message = "Could not find nuclide " // trim(name) // &
" in cross_sections.xml file!"
call fatal_error()
@ -1096,20 +1094,20 @@ contains
end if
! Find xs_listing and set the name/alias according to the listing
index_list = dict_get_key(xs_listing_dict, name)
index_list = xs_listing_dict % get_key(name)
name = xs_listings(index_list) % name
alias = xs_listings(index_list) % alias
! If this nuclide hasn't been encountered yet, we need to add its name
! and alias to the nuclide_dict
if (.not. dict_has_key(nuclide_dict, name)) then
if (.not. nuclide_dict % has_key(name)) then
index_nuclide = index_nuclide + 1
mat % nuclide(j) = index_nuclide
call dict_add_key(nuclide_dict, name, index_nuclide)
call dict_add_key(nuclide_dict, alias, index_nuclide)
call nuclide_dict % add_key(name, index_nuclide)
call nuclide_dict % add_key(alias, index_nuclide)
else
mat % nuclide(j) = dict_get_key(nuclide_dict, name)
mat % nuclide(j) = nuclide_dict % get_key(name)
end if
! Check if no atom/weight percents were specified or if both atom and
@ -1156,7 +1154,7 @@ contains
mat % sab_name = name
! Check that this nuclide is listed in the cross_sections.xml file
if (.not. dict_has_key(xs_listing_dict, name)) then
if (.not. xs_listing_dict % has_key(name)) then
message = "Could not find S(a,b) table " // trim(name) // &
" in cross_sections.xml file!"
call fatal_error()
@ -1165,20 +1163,20 @@ contains
! Find index in xs_listing and set the name and alias according to the
! listing
index_list = dict_get_key(xs_listing_dict, name)
index_list = xs_listing_dict % get_key(name)
name = xs_listings(index_list) % name
alias = xs_listings(index_list) % alias
! If this S(a,b) table hasn't been encountered yet, we need to add its
! name and alias to the sab_dict
if (.not. dict_has_key(sab_dict, name)) then
if (.not. sab_dict % has_key(name)) then
index_sab = index_sab + 1
mat % sab_table = index_sab
call dict_add_key(sab_dict, name, index_sab)
call dict_add_key(sab_dict, alias, index_sab)
call sab_dict % add_key(name, index_sab)
call sab_dict % add_key(alias, index_sab)
else
mat % sab_table = dict_get_key(sab_dict, name)
mat % sab_table = sab_dict % get_key(name)
end if
elseif (size(material_(i) % sab) > 1) then
@ -1187,7 +1185,7 @@ contains
end if
! Add material to dictionary
call dict_add_key(material_dict, mat % id, i)
call material_dict % add_key(mat % id, i)
end do
! Set total number of nuclides and S(a,b) tables
@ -1226,7 +1224,7 @@ contains
character(MAX_LINE_LEN) :: filename
character(MAX_WORD_LEN) :: word
character(MAX_WORD_LEN) :: score_name
type(ListKeyValueCI), pointer :: key_list => null()
type(ElemKeyValueCI), pointer :: pair_list => null()
type(TallyObject), pointer :: t => null()
type(StructuredMesh), pointer :: m => null()
type(TallyFilter), allocatable :: filters(:) ! temporary filters
@ -1395,7 +1393,7 @@ contains
m % volume_frac = ONE/real(product(m % dimension),8)
! Add mesh to dictionary
call dict_add_key(mesh_dict, m % id, i)
call mesh_dict % add_key(m % id, i)
end do
! ==========================================================================
@ -1536,8 +1534,8 @@ contains
id = int(str_to_int(tally_(i) % filter(j) % bins(1)),4)
! Get pointer to mesh
if (dict_has_key(mesh_dict, id)) then
i_mesh = dict_get_key(mesh_dict, id)
if (mesh_dict % has_key(id)) then
i_mesh = mesh_dict % get_key(id)
m => meshes(i_mesh)
else
message = "Could not find mesh " // trim(to_str(id)) // &
@ -1639,26 +1637,26 @@ contains
else
if (default_xs == '') then
! No default cross section specified, search through nuclides
key_list => dict_keys(nuclide_dict)
do while (associated(key_list))
if (starts_with(key_list % data % key, &
pair_list => nuclide_dict % keys()
do while (associated(pair_list))
if (starts_with(pair_list % key, &
tally_(i) % nuclides(j))) then
word = key_list % data % key
word = pair_list % key
exit
end if
! Advance to next
key_list => key_list % next
pair_list => pair_list % next
end do
! Check if no nuclide was found
if (.not. associated(key_list)) then
if (.not. associated(pair_list)) then
message = "Could not find the nuclide " // trim(&
tally_(i) % nuclides(j)) // " specified in tally " &
// trim(to_str(t % id)) // " in any material."
call fatal_error()
end if
deallocate(key_list)
deallocate(pair_list)
else
! Set nuclide to default xs
word = trim(tally_(i) % nuclides(j)) // "." // default_xs
@ -1666,14 +1664,14 @@ contains
end if
! Check to make sure nuclide specified is in problem
if (.not. dict_has_key(nuclide_dict, word)) then
if (.not. nuclide_dict % has_key(word)) then
message = "The nuclide " // trim(word) // " from tally " // &
trim(to_str(t % id)) // " is not present in any material."
call fatal_error()
end if
! Set bin to index in nuclides array
t % nuclide_bins(j) = dict_get_key(nuclide_dict, word)
t % nuclide_bins(j) = nuclide_dict % get_key(word)
end do
! Set number of nuclide bins
@ -2178,7 +2176,7 @@ contains
if (pl % color_by == PLOT_COLOR_CELLS) then
if (dict_has_key(cell_dict, col_id)) then
if (cell_dict % has_key(col_id)) then
pl % colors(col_id) % rgb = plot_(i) % col_spec_(j) % rgb
else
message = "Could not find cell " // trim(to_str(col_id)) // &
@ -2188,7 +2186,7 @@ contains
else if (pl % color_by == PLOT_COLOR_MATS) then
if (dict_has_key(material_dict, col_id)) then
if (material_dict % has_key(col_id)) then
pl % colors(col_id) % rgb = plot_(i) % col_spec_(j) % rgb
else
message = "Could not find material " // trim(to_str(col_id)) // &
@ -2334,8 +2332,8 @@ contains
end if
! create dictionary entry for both name and alias
call dict_add_key(xs_listing_dict, listing % name, i)
call dict_add_key(xs_listing_dict, listing % alias, i)
call xs_listing_dict % add_key(listing % name, i)
call xs_listing_dict % add_key(listing % alias, i)
end do
end subroutine read_cross_sections_xml

765
src/list_header.F90 Normal file
View file

@ -0,0 +1,765 @@
module list_header
!===============================================================================
! LIST_HEADER module
!
! This module contains a linked list structure with convenience methods such as
! append, contains, remove, index, get_item, size, etc. This is an updated
! implementation with type-bound procedures (F2003).
!===============================================================================
use constants, only: ERROR_INT, ERROR_REAL, MAX_WORD_LEN
implicit none
!===============================================================================
! LISTELEM* types hold one piece of data and a pointer to the next piece of data
!===============================================================================
type :: ListElemInt
integer :: data
type(ListElemInt), pointer :: next => null()
end type ListElemInt
type :: ListElemReal
real(8) :: data
type(ListElemReal), pointer :: next => null()
end type ListElemReal
type :: ListElemChar
character(MAX_WORD_LEN) :: data
type(ListElemChar), pointer :: next => null()
end type ListElemChar
!===============================================================================
! LIST* types contain the linked list with convenience methods. We originally
! considered using unlimited polymorphism to provide a single type, but compiler
! support is still spotty, and in many cases it doesn't prevent duplication of
! code. For the time being, a separate derived type exists for each datatype.
!===============================================================================
type, public :: ListInt
private
integer :: count = 0 ! Number of elements in list
! Used in get_item for fast sequential lookups
integer :: last_index = huge(0)
type(ListElemInt), pointer :: last_elem => null()
! Pointers to beginning and end of list
type(ListElemInt), public, pointer :: head => null()
type(ListElemInt), public, pointer :: tail => null()
contains
procedure :: append => list_append_int ! Add item to end of list
procedure :: clear => list_clear_int ! Remove all items
procedure :: contains => list_contains_int ! Does list contain?
procedure :: get_item => list_get_item_int ! Get i-th item in list
procedure :: index => list_index_int ! Determine index of given item
procedure :: insert => list_insert_int ! Insert item in i-th position
procedure :: remove => list_remove_int ! Remove specified item
procedure :: size => list_size_int ! Size of list
end type ListInt
type, public :: ListReal
private
integer :: count = 0 ! Number of elements in list
! Used in get_item for fast sequential lookups
integer :: last_index = huge(0)
type(ListElemReal), pointer :: last_elem => null()
! Pointers to beginning and end of list
type(ListElemReal), public, pointer :: head => null()
type(ListElemReal), public, pointer :: tail => null()
contains
procedure :: append => list_append_real ! Add item to end of list
procedure :: clear => list_clear_real ! Remove all items
procedure :: contains => list_contains_real ! Does list contain?
procedure :: get_item => list_get_item_real ! Get i-th item in list
procedure :: index => list_index_real ! Determine index of given item
procedure :: insert => list_insert_real ! Insert item in i-th position
procedure :: remove => list_remove_real ! Remove specified item
procedure :: size => list_size_real ! Size of list
end type ListReal
type, public :: ListChar
private
integer :: count = 0 ! Number of elements in list
! Used in get_item for fast sequential lookups
integer :: last_index = huge(0)
type(ListElemChar), pointer :: last_elem => null()
! Pointers to beginning and end of list
type(ListElemChar), public, pointer :: head => null()
type(ListElemChar), public, pointer :: tail => null()
contains
procedure :: append => list_append_char ! Add item to end of list
procedure :: clear => list_clear_char ! Remove all items
procedure :: contains => list_contains_char ! Does list contain?
procedure :: get_item => list_get_item_char ! Get i-th item in list
procedure :: index => list_index_char ! Determine index of given item
procedure :: insert => list_insert_char ! Insert item in i-th position
procedure :: remove => list_remove_char ! Remove specified item
procedure :: size => list_size_char ! Size of list
end type ListChar
contains
!===============================================================================
! LIST_APPEND appends an item to the end of the list. If the list is empty, it
! becomes the first item.
!===============================================================================
subroutine list_append_int(this, data)
class(ListInt) :: this
integer :: data
type(ListElemInt), pointer :: elem
! Create element and set dat
allocate(elem)
elem % data = data
if (.not. associated(this % head)) then
! If list is empty, set head and tail to new element
this % head => elem
this % tail => elem
else
! Otherwise append element at end of list
this % tail % next => elem
this % tail => this % tail % next
end if
this % count = this % count + 1
end subroutine list_append_int
subroutine list_append_real(this, data)
class(ListReal) :: this
real(8) :: data
type(ListElemReal), pointer :: elem
! Create element and set dat
allocate(elem)
elem % data = data
if (.not. associated(this % head)) then
! If list is empty, set head and tail to new element
this % head => elem
this % tail => elem
else
! Otherwise append element at end of list
this % tail % next => elem
this % tail => this % tail % next
end if
this % count = this % count + 1
end subroutine list_append_real
subroutine list_append_char(this, data)
class(ListChar) :: this
character(*) :: data
type(ListElemChar), pointer :: elem
! Create element and set dat
allocate(elem)
elem % data = data
if (.not. associated(this % head)) then
! If list is empty, set head and tail to new element
this % head => elem
this % tail => elem
else
! Otherwise append element at end of list
this % tail % next => elem
this % tail => this % tail % next
end if
this % count = this % count + 1
end subroutine list_append_char
!===============================================================================
! LIST_CLEAR removes all elements from the list
!===============================================================================
subroutine list_clear_int(this)
class(ListInt) :: this
type(ListElemInt), pointer :: current => null()
type(ListElemInt), pointer :: next => null()
if (this % count > 0) then
current => this % head
do while (associated(current))
! Set pointer to next element
next => current % next
! Deallocate memory for current element
deallocate(current)
! Move to next element
current => next
end do
nullify(this % head)
nullify(this % tail)
this % count = 0
end if
end subroutine list_clear_int
subroutine list_clear_real(this)
class(ListReal) :: this
type(ListElemReal), pointer :: current => null()
type(ListElemReal), pointer :: next => null()
if (this % count > 0) then
current => this % head
do while (associated(current))
! Set pointer to next element
next => current % next
! Deallocate memory for current element
deallocate(current)
! Move to next element
current => next
end do
nullify(this % head)
nullify(this % tail)
this % count = 0
end if
end subroutine list_clear_real
subroutine list_clear_char(this)
class(ListChar) :: this
type(ListElemChar), pointer :: current => null()
type(ListElemChar), pointer :: next => null()
if (this % count > 0) then
current => this % head
do while (associated(current))
! Set pointer to next element
next => current % next
! Deallocate memory for current element
deallocate(current)
! Move to next element
current => next
end do
nullify(this % head)
nullify(this % tail)
this % count = 0
end if
end subroutine list_clear_char
!===============================================================================
! LIST_CONTAINS determines whether the list contains a specified item. Since it
! relies on the index method, it is O(n).
!===============================================================================
function list_contains_int(this, data) result(in_list)
class(ListInt) :: this
integer :: data
logical :: in_list
in_list = (this % index(data) > 0)
end function list_contains_int
function list_contains_real(this, data) result(in_list)
class(ListReal) :: this
real(8) :: data
logical :: in_list
in_list = (this % index(data) > 0)
end function list_contains_real
function list_contains_char(this, data) result(in_list)
class(ListChar) :: this
character(*) :: data
logical :: in_list
in_list = (this % index(data) > 0)
end function list_contains_char
!===============================================================================
! LIST_GET_ITEM returns the item in the list at position 'i_list'. If the index
! is out of bounds, an error code is returned.
! ===============================================================================
function list_get_item_int(this, i_list) result(data)
class(ListInt) :: this
integer :: i_list
integer :: data
integer :: last_index
if (i_list < 1 .or. i_list > this % count) then
! Check for index out of bounds
data = ERROR_INT
elseif (i_list == 1) then
data = this % head % data
this % last_index = 1
this % last_elem => this % head
elseif (i_list == this % count) then
data = this % tail % data
this % last_index = this % count
this % last_elem => this % tail
else
if (i_list < this % last_index) then
this % last_index = 1
this % last_elem => this % head
end if
do last_index = this % last_index + 1, i_list
this % last_elem => this % last_elem % next
this % last_index = last_index
end do
data = this % last_elem % data
end if
end function list_get_item_int
function list_get_item_real(this, i_list) result(data)
class(ListReal) :: this
integer :: i_list
real(8) :: data
integer :: last_index
if (i_list < 1 .or. i_list > this % count) then
! Check for index out of bounds
data = ERROR_REAL
elseif (i_list == 1) then
data = this % head % data
this % last_index = 1
this % last_elem => this % head
elseif (i_list == this % count) then
data = this % tail % data
this % last_index = this % count
this % last_elem => this % tail
else
if (i_list < this % last_index) then
this % last_index = 1
this % last_elem => this % head
end if
do last_index = this % last_index + 1, i_list
this % last_elem => this % last_elem % next
this % last_index = last_index
end do
data = this % last_elem % data
end if
end function list_get_item_real
function list_get_item_char(this, i_list) result(data)
class(ListChar) :: this
integer :: i_list
character(MAX_WORD_LEN) :: data
integer :: last_index
if (i_list < 1 .or. i_list > this % count) then
! Check for index out of bounds
data = ""
elseif (i_list == 1) then
data = this % head % data
this % last_index = 1
this % last_elem => this % head
elseif (i_list == this % count) then
data = this % tail % data
this % last_index = this % count
this % last_elem => this % tail
else
if (i_list < this % last_index) then
this % last_index = 1
this % last_elem => this % head
end if
do last_index = this % last_index + 1, i_list
this % last_elem => this % last_elem % next
this % last_index = last_index
end do
data = this % last_elem % data
end if
end function list_get_item_char
!===============================================================================
! LIST_INDEX determines the first index in the list that contains 'data'. If
! 'data' is not present in the list, the return value is -1.
!===============================================================================
function list_index_int(this, data) result(i_list)
class(ListInt) :: this
integer :: data
integer :: i_list
type(ListElemInt), pointer :: elem
i_list = 0
elem => this % head
do while (associated(elem))
i_list = i_list + 1
if (data == elem % data) exit
elem => elem % next
end do
! Check if we reached the end of the list
if (.not. associated(elem)) i_list = -1
end function list_index_int
function list_index_real(this, data) result(i_list)
class(ListReal) :: this
real(8) :: data
integer :: i_list
type(ListElemReal), pointer :: elem
i_list = 0
elem => this % head
do while (associated(elem))
i_list = i_list + 1
if (data == elem % data) exit
elem => elem % next
end do
! Check if we reached the end of the list
if (.not. associated(elem)) i_list = -1
end function list_index_real
function list_index_char(this, data) result(i_list)
class(ListChar) :: this
character(*) :: data
integer :: i_list
type(ListElemChar), pointer :: elem
i_list = 0
elem => this % head
do while (associated(elem))
i_list = i_list + 1
if (data == elem % data) exit
elem => elem % next
end do
! Check if we reached the end of the list
if (.not. associated(elem)) i_list = -1
end function list_index_char
!===============================================================================
! LIST_INSERT inserts 'data' at index 'i_list' within the list. If 'i_list'
! exceeds the size of the list, the data is appends at the end of the list.
!===============================================================================
subroutine list_insert_int(this, i_list, data)
class(ListInt) :: this
integer :: i_list
integer :: data
integer :: i
type(ListElemInt), pointer :: elem => null()
type(ListElemInt), pointer :: new_elem => null()
if (i_list > this % count) then
! Check whether specified index is greater than number of elements -- if
! so, just append it to the end of the list
call this % append(data)
else if (i_list == 1) then
! Check for new head element
allocate(new_elem)
new_elem % data = data
new_elem % next => this % head
this % head => new_elem
this % count = this % count + 1
else
! Default case with new element somewhere in middle of list
i = 0
elem => this % head
do while (associated(elem))
i = i + 1
if (i == i_list - 1) then
! Allocate new element
allocate(new_elem)
new_elem % data = data
! Put it before the i-th element
new_elem % next => elem % next
elem % next => new_elem
this % count = this % count + 1
exit
end if
end do
end if
end subroutine list_insert_int
subroutine list_insert_real(this, i_list, data)
class(ListReal) :: this
integer :: i_list
real(8) :: data
integer :: i
type(ListElemReal), pointer :: elem => null()
type(ListElemReal), pointer :: new_elem => null()
if (i_list > this % count) then
! Check whether specified index is greater than number of elements -- if
! so, just append it to the end of the list
call this % append(data)
else if (i_list == 1) then
! Check for new head element
allocate(new_elem)
new_elem % data = data
new_elem % next => this % head
this % head => new_elem
this % count = this % count + 1
else
! Default case with new element somewhere in middle of list
i = 0
elem => this % head
do while (associated(elem))
i = i + 1
if (i == i_list - 1) then
! Allocate new element
allocate(new_elem)
new_elem % data = data
! Put it before the i-th element
new_elem % next => elem % next
elem % next => new_elem
this % count = this % count + 1
exit
end if
end do
end if
end subroutine list_insert_real
subroutine list_insert_char(this, i_list, data)
class(ListChar) :: this
integer :: i_list
character(*) :: data
integer :: i
type(ListElemChar), pointer :: elem => null()
type(ListElemChar), pointer :: new_elem => null()
if (i_list > this % count) then
! Check whether specified index is greater than number of elements -- if
! so, just append it to the end of the list
call this % append(data)
else if (i_list == 1) then
! Check for new head element
allocate(new_elem)
new_elem % data = data
new_elem % next => this % head
this % head => new_elem
this % count = this % count + 1
else
! Default case with new element somewhere in middle of list
i = 0
elem => this % head
do while (associated(elem))
i = i + 1
if (i == i_list - 1) then
! Allocate new element
allocate(new_elem)
new_elem % data = data
! Put it before the i-th element
new_elem % next => elem % next
elem % next => new_elem
this % count = this % count + 1
exit
end if
end do
end if
end subroutine list_insert_char
!===============================================================================
! LIST_REMOVE removes the first item in the list that contains 'data'. If 'data'
! is not in the list, no action is taken.
!===============================================================================
subroutine list_remove_int(this, data)
class(ListInt) :: this
integer :: data
type(ListElemInt), pointer :: elem => null()
type(ListElemInt), pointer :: prev => null()
elem => this % head
do while (associated(elem))
! Check for matching data
if (elem % data == data) then
! Determine whether the current element is the head, tail, or a middle
! element
if (associated(elem, this % head)) then
this % head => elem % next
if (associated(elem, this % tail)) nullify(this % tail)
deallocate(elem)
else if (associated(elem, this % tail)) then
this % tail => prev
deallocate(this % tail % next)
else
prev % next => elem % next
deallocate(elem)
end if
! Decrease count and exit
this % count = this % count - 1
exit
end if
! Advance pointers
prev => elem
elem => elem % next
end do
end subroutine list_remove_int
subroutine list_remove_real(this, data)
class(ListReal) :: this
real(8) :: data
type(ListElemReal), pointer :: elem => null()
type(ListElemReal), pointer :: prev => null()
elem => this % head
do while (associated(elem))
! Check for matching data
if (elem % data == data) then
! Determine whether the current element is the head, tail, or a middle
! element
if (associated(elem, this % head)) then
this % head => elem % next
if (associated(elem, this % tail)) nullify(this % tail)
deallocate(elem)
else if (associated(elem, this % tail)) then
this % tail => prev
deallocate(this % tail % next)
else
prev % next => elem % next
deallocate(elem)
end if
! Decrease count and exit
this % count = this % count - 1
exit
end if
! Advance pointers
prev => elem
elem => elem % next
end do
end subroutine list_remove_real
subroutine list_remove_char(this, data)
class(ListChar) :: this
character(*) :: data
type(ListElemChar), pointer :: elem => null()
type(ListElemChar), pointer :: prev => null()
elem => this % head
do while (associated(elem))
! Check for matching data
if (elem % data == data) then
! Determine whether the current element is the head, tail, or a middle
! element
if (associated(elem, this % head)) then
this % head => elem % next
if (associated(elem, this % tail)) nullify(this % tail)
deallocate(elem)
else if (associated(elem, this % tail)) then
this % tail => prev
deallocate(this % tail % next)
else
prev % next => elem % next
deallocate(elem)
end if
! Decrease count and exit
this % count = this % count - 1
exit
end if
! Advance pointers
prev => elem
elem => elem % next
end do
end subroutine list_remove_char
!===============================================================================
! LIST_SIZE returns the number of elements in the list
!===============================================================================
function list_size_int(this) result(size)
class(ListInt) :: this
integer :: size
size = this % count
end function list_size_int
function list_size_real(this) result(size)
class(ListReal) :: this
integer :: size
size = this % count
end function list_size_real
function list_size_char(this) result(size)
class(ListChar) :: this
integer :: size
size = this % count
end function list_size_char
end module list_header

3
src/output.F90
View file

@ -4,7 +4,6 @@ module output
use ace_header, only: Nuclide, Reaction, UrrData
use constants
use datatypes, only: dict_get_key
use endf, only: reaction_name
use geometry_header, only: Cell, Universe, Surface, BASE_UNIVERSE
use global
@ -346,7 +345,7 @@ contains
write(unit_,*) 'Cell ' // to_str(c % id)
! Find index in cells array and write
index_cell = dict_get_key(cell_dict, c % id)
index_cell = cell_dict % get_key(c % id)
write(unit_,*) ' Array Index = ' // to_str(index_cell)
! Write what universe this cell is in

8
src/physics.F90
View file

@ -100,7 +100,7 @@ contains
end do
! Score track-length tallies
if (associated(active_tracklength_tallies)) &
if (active_tracklength_tallies % size() > 0) &
call score_tracklength_tally(distance)
! Score track-length estimate of k-eff
@ -193,8 +193,7 @@ contains
! since the direction of the particle will change and we need to use the
! pre-collision direction to figure out what mesh surfaces were crossed
if (associated(active_current_tallies)) &
call score_surface_current()
if (active_current_tallies % size() > 0) call score_surface_current()
! Sample nuclide/reaction for the material the particle is in
call sample_reaction()
@ -218,8 +217,7 @@ contains
! occurred rather than before because we need information on the outgoing
! energy for any tallies with an outgoing energy filter
if (associated(active_analog_tallies)) &
call score_analog_tally()
if (active_analog_tallies % size() > 0) call score_analog_tally()
! Reset banked weight during collision
p % n_bank = 0

163
src/set_header.F90 Normal file
View file

@ -0,0 +1,163 @@
module set_header
!===============================================================================
! SET_HEADER module
!
! This module provides an implementation of sets based on the list
! implementation in list_header. The underlying datatype is a list, so adding an
! element just checks if the element is already in the list, and if not it's
! added. This results in much worse performance than an implementation based on
! hash tables or binary trees, but for our purposes, we don't expect to have
! gigantic sets where performance is critical.
!===============================================================================
use constants, only: MAX_WORD_LEN
use list_header
implicit none
!===============================================================================
! SET contains a list of elements and methods to add, remove, and perform other
! basic tasks.
!===============================================================================
type :: SetInt
private
type(ListInt) :: elements
contains
procedure :: add => set_add_int
procedure :: contains => set_contains_int
procedure :: get_item => set_get_item_int
procedure :: remove => set_remove_int
procedure :: size => set_size_int
end type SetInt
type :: SetChar
private
type(ListChar) :: elements
contains
procedure :: add => set_add_char
procedure :: contains => set_contains_char
procedure :: get_item => set_get_item_char
procedure :: remove => set_remove_char
procedure :: size => set_size_char
end type SetChar
contains
!===============================================================================
! SET_ADD adds an item to a set if it is not already present in the set
!===============================================================================
subroutine set_add_int(this, data)
class(SetInt) :: this
integer :: data
if (.not. this % elements % contains(data)) then
call this % elements % append(data)
end if
end subroutine set_add_int
subroutine set_add_char(this, data)
class(SetChar) :: this
character(*) :: data
if (.not. this % elements % contains(data)) then
call this % elements % append(data)
end if
end subroutine set_add_char
!===============================================================================
! SET_CONTAINS determines if a specified item is in a set
!===============================================================================
function set_contains_int(this, data) result(in_set)
class(SetInt) :: this
integer :: data
logical :: in_set
in_set = this % elements % contains(data)
end function set_contains_int
function set_contains_char(this, data) result(in_set)
class(SetChar) :: this
character(*) :: data
logical :: in_set
in_set = this % elements % contains(data)
end function set_contains_char
!===============================================================================
! SET_GET_ITEM returns the i-th item in the set
!===============================================================================
function set_get_item_int(this, i_list) result(data)
class(SetInt) :: this
integer :: i_list
integer :: data
data = this % elements % get_item(i_list)
end function set_get_item_int
function set_get_item_char(this, i_list) result(data)
class(SetChar) :: this
integer :: i_list
character(MAX_WORD_LEN) :: data
data = this % elements % get_item(i_list)
end function set_get_item_char
!===============================================================================
! SET_REMOVE removes the specified item from the set. If it is not in the set,
! no action is taken.
!===============================================================================
subroutine set_remove_int(this, data)
class(SetInt) :: this
integer :: data
call this % elements % remove(data)
end subroutine set_remove_int
subroutine set_remove_char(this, data)
class(SetChar) :: this
character(*) :: data
call this % elements % remove(data)
end subroutine set_remove_char
!===============================================================================
! SET_SIZE returns the number of elements in the set
!===============================================================================
function set_size_int(this) result(size)
class(SetInt) :: this
integer :: size
size = this % elements % size()
end function set_size_int
function set_size_char(this) result(size)
class(SetChar) :: this
integer :: size
size = this % elements % size()
end function set_size_char
end module set_header

304
src/tally.F90
View file

@ -2,7 +2,6 @@ module tally
use ace_header, only: Reaction
use constants
use datatypes_header, only: ListInt
use error, only: fatal_error
use global
use math, only: t_percentile, calc_pn
@ -35,6 +34,8 @@ contains
subroutine score_analog_tally()
integer :: i
integer :: i_tally
integer :: j ! loop index for scoring bins
integer :: k ! loop index for nuclide bins
integer :: n ! loop index for scattering order
@ -52,31 +53,25 @@ contains
real(8) :: macro_scatt ! material macro scatt xs
logical :: found_bin ! scoring bin found?
type(TallyObject), pointer :: t => null()
type(ListInt), pointer :: curr_ptr => null()
! Copy particle's pre- and post-collision weight and angle
last_wgt = p % last_wgt
wgt = p % wgt
mu = p % mu
! set current pointer to active analog tallies
curr_ptr => active_analog_tallies
! A loop over all tallies is necessary because we need to simultaneously
! determine different filter bins for the same tally in order to score to it
TALLY_LOOP: do while (associated(curr_ptr))
t => tallies(analog_tallies(curr_ptr % data))
TALLY_LOOP: do i = 1, active_analog_tallies % size()
! Get index of tally and pointer to tally
i_tally = active_analog_tallies % get_item(i)
t => tallies(analog_tallies(i_tally))
! =======================================================================
! DETERMINE SCORING BIN COMBINATION
call get_scoring_bins(analog_tallies(curr_ptr % data), found_bin)
if (.not. found_bin) then
curr_ptr => curr_ptr % next
cycle
end if
call get_scoring_bins(analog_tallies(i_tally), found_bin)
if (.not. found_bin) cycle
! =======================================================================
! CALCULATE RESULTS AND ACCUMULATE TALLY
@ -370,16 +365,11 @@ contains
if (assume_separate) exit TALLY_LOOP
! select next active tally
curr_ptr => curr_ptr % next
end do TALLY_LOOP
! Reset tally map positioning
position = 0
nullify(curr_ptr)
end subroutine score_analog_tally
!===============================================================================
@ -446,6 +436,8 @@ contains
real(8), intent(in) :: distance
integer :: i
integer :: i_tally
integer :: j ! loop index for scoring bins
integer :: k ! loop index for nuclide bins
integer :: l ! loop index for nuclides in material
@ -462,39 +454,33 @@ contains
real(8) :: atom_density ! atom density of single nuclide in atom/b-cm
logical :: found_bin ! scoring bin found?
type(TallyObject), pointer :: t => null()
type(Material), pointer :: mat => null()
type(ListInt), pointer :: curr_ptr => null()
type(Reaction), pointer :: rxn => null()
type(Material), pointer :: mat => null()
type(Reaction), pointer :: rxn => null()
! Determine track-length estimate of flux
flux = p % wgt * distance
! set current pointer to active tracklength tallies
curr_ptr => active_tracklength_tallies
! A loop over all tallies is necessary because we need to simultaneously
! determine different filter bins for the same tally in order to score to it
TALLY_LOOP: do while (associated(curr_ptr))
t => tallies(tracklength_tallies(curr_ptr % data))
TALLY_LOOP: do i = 1, active_tracklength_tallies % size()
! Get index of tally and pointer to tally
i_tally = active_tracklength_tallies % get_item(i)
t => tallies(tracklength_tallies(i_tally))
! Check if this tally has a mesh filter -- if so, we treat it separately
! since multiple bins can be scored to with a single track
if (t % find_filter(FILTER_MESH) > 0) then
call score_tl_on_mesh(tracklength_tallies(curr_ptr % data), distance)
curr_ptr => curr_ptr % next ! select next tally
call score_tl_on_mesh(tracklength_tallies(i_tally), distance)
cycle
end if
! =======================================================================
! DETERMINE SCORING BIN COMBINATION
call get_scoring_bins(tracklength_tallies(curr_ptr % data), found_bin)
if (.not. found_bin) then
curr_ptr => curr_ptr % next
cycle
end if
call get_scoring_bins(tracklength_tallies(i_tally), found_bin)
if (.not. found_bin) cycle
! =======================================================================
! CALCULATE RESULTS AND ACCUMULATE TALLY
@ -507,7 +493,7 @@ contains
filter_index = sum((t % matching_bins - 1) * t % stride) + 1
if (t % all_nuclides) then
call score_all_nuclides(tracklength_tallies(curr_ptr % data), flux, &
call score_all_nuclides(tracklength_tallies(i_tally), flux, &
filter_index)
else
@ -728,16 +714,11 @@ contains
if (assume_separate) exit TALLY_LOOP
! select next active tally
curr_ptr => curr_ptr % next
end do TALLY_LOOP
! Reset tally map positioning
position = 0
nullify(curr_ptr)
end subroutine score_tracklength_tally
!===============================================================================
@ -1387,6 +1368,8 @@ contains
subroutine score_surface_current()
integer :: i
integer :: i_tally
integer :: j ! loop indices
integer :: k ! loop indices
integer :: ijk0(3) ! indices of starting coordinates
@ -1409,18 +1392,15 @@ contains
logical :: z_same ! same starting/ending z index (k)
type(TallyObject), pointer :: t => null()
type(StructuredMesh), pointer :: m => null()
type(ListInt), pointer :: curr_ptr => null()
! set current pointer to active current tallies
curr_ptr => active_current_tallies
TALLY_LOOP: do while (associated(curr_ptr))
TALLY_LOOP: do i = 1, active_current_tallies % size()
! Copy starting and ending location of particle
xyz0 = p % last_xyz
xyz1 = p % coord0 % xyz
! Get pointer to tally
t => tallies(current_tallies(curr_ptr % data))
i_tally = active_current_tallies % get_item(i)
t => tallies(current_tallies(i_tally))
! Get index for mesh and surface filters
i_filter_mesh = t % find_filter(FILTER_MESH)
@ -1435,7 +1415,6 @@ contains
! intersects with mesh
if ((.not. start_in_mesh) .and. (.not. end_in_mesh)) then
if (.not. mesh_intersects(m, xyz0, xyz1)) then
curr_ptr => curr_ptr % next ! select next tally
cycle
end if
end if
@ -1443,7 +1422,6 @@ contains
! Calculate number of surface crossings
n_cross = sum(abs(ijk1 - ijk0))
if (n_cross == 0) then
curr_ptr => curr_ptr % next ! select next tally
cycle
end if
@ -1457,7 +1435,6 @@ contains
! check if energy of the particle is within energy bins
if (p % E < t % filters(j) % real_bins(1) .or. &
p % E > t % filters(j) % real_bins(n + 1)) then
curr_ptr => curr_ptr % next ! select next tally
cycle
end if
@ -1500,7 +1477,6 @@ contains
end if
end do
end if
curr_ptr => curr_ptr % next ! select next tally
cycle
elseif (x_same .and. z_same) then
! Only y crossings
@ -1529,7 +1505,6 @@ contains
end if
end do
end if
curr_ptr => curr_ptr % next ! select next tally
cycle
elseif (y_same .and. z_same) then
! Only x crossings
@ -1558,7 +1533,6 @@ contains
end if
end do
end if
curr_ptr => curr_ptr % next ! select next tally
cycle
end if
@ -1686,13 +1660,8 @@ contains
xyz0 = xyz0 + distance * uvw
end do
! select next active tally
curr_ptr => curr_ptr % next
end do TALLY_LOOP
nullify(curr_ptr)
end subroutine score_surface_current
!===============================================================================
@ -1757,7 +1726,7 @@ contains
subroutine synchronize_tallies()
type(ListInt), pointer :: curr_ptr => null()
integer :: i
#ifdef MPI
! Combine tally results onto master process
@ -1774,10 +1743,8 @@ contains
! Accumulate on master only unless run is not reduced then do it on all
if (master .or. (.not. reduce_tallies)) then
! Accumulate results for each tally
curr_ptr => active_tallies
do while(associated(curr_ptr))
call accumulate_tally(tallies(curr_ptr % data))
curr_ptr => curr_ptr % next
do i = 1, active_tallies % size()
call accumulate_tally(tallies(active_tallies % get_item(i)))
end do
if (run_mode == MODE_EIGENVALUE) then
@ -1792,8 +1759,6 @@ contains
call accumulate_result(global_tallies)
end if
if (associated(curr_ptr)) nullify(curr_ptr)
end subroutine synchronize_tallies
!===============================================================================
@ -1803,6 +1768,7 @@ contains
#ifdef MPI
subroutine reduce_tally_results()
integer :: i
integer :: n ! number of filter bins
integer :: m ! number of score bins
integer :: n_bins ! total number of bins
@ -1810,11 +1776,9 @@ contains
real(8) :: global_temp(N_GLOBAL_TALLIES)
real(8) :: dummy ! temporary receive buffer for non-root reduces
type(TallyObject), pointer :: t => null()
type(ListInt), pointer :: curr_ptr => null()
curr_ptr => active_tallies
do while(associated(curr_ptr))
t => tallies(curr_ptr % data)
do i = 1, active_tallies % size()
t => tallies(active_tallies % get_item(i))
m = t % total_score_bins
n = t % total_filter_bins
@ -1842,7 +1806,6 @@ contains
end if
deallocate(tally_temp)
curr_ptr => curr_ptr % next
end do
! Copy global tallies into array to be reduced
@ -1874,8 +1837,6 @@ contains
0, MPI_COMM_WORLD, mpi_err)
end if
if (associated(curr_ptr)) nullify(curr_ptr)
end subroutine reduce_tally_results
#endif
@ -1987,125 +1948,26 @@ contains
subroutine setup_active_usertallies()
integer :: i ! loop counter
type(ListInt), pointer :: curr_ptr ! pointer to current list node
type(ListInt), pointer :: tall_ptr ! pointer to active tallies only
!============================================================
! TALLIES
! traverse to end of tally list
tall_ptr => active_tallies
do while(associated(tall_ptr))
tall_ptr => tall_ptr % next
end do
!============================================================
! ANALOG TALLIES
! check to see if analog tallies have already been allocated
curr_ptr => null()
if (associated(active_analog_tallies)) then
! traverse to the end of the linked list
curr_ptr => active_analog_tallies
do while(associated(curr_ptr))
curr_ptr => curr_ptr % next
end do
end if
integer :: i ! loop counter
! append all analog tallies
do i = n_user_analog_tallies,1,-1
! allocate node
allocate(curr_ptr)
! set the tally index
curr_ptr % data = i
curr_ptr % next => active_analog_tallies
active_analog_tallies => curr_ptr
! set indices in active tallies
allocate(tall_ptr)
tall_ptr % data = analog_tallies(i)
tall_ptr % next => active_tallies
active_tallies => tall_ptr
do i = 1, n_user_analog_tallies
call active_analog_tallies % append(i)
call active_tallies % append(analog_tallies(i))
end do
!============================================================
! TRACKLENGTH TALLIES
! check to see if tracklength tallies have already been allocated
curr_ptr => null()
if (associated(active_tracklength_tallies)) then
! traverse to the end of the linked list
curr_ptr => active_tracklength_tallies
do while(associated(curr_ptr))
curr_ptr => curr_ptr % next
end do
end if
! append all tracklength tallies
do i = n_user_tracklength_tallies,1,-1
! allocate node
allocate(curr_ptr)
! set the tally index
curr_ptr % data = i
curr_ptr % next => active_tracklength_tallies
active_tracklength_tallies => curr_ptr
! set indices in active tallies
allocate(tall_ptr)
tall_ptr % data = tracklength_tallies(i)
tall_ptr % next => active_tallies
active_tallies => tall_ptr
do i = 1, n_user_tracklength_tallies
call active_tracklength_tallies % append(i)
call active_tallies % append(tracklength_tallies(i))
end do
!============================================================
! CURRENT TALLIES
! check to see if current tallies have already been allocated
curr_ptr => null()
if (associated(active_current_tallies)) then
! traverse to the end of the linked list
curr_ptr => active_current_tallies
do while(associated(curr_ptr))
curr_ptr => curr_ptr % next
end do
end if
! append all current tallies
do i = n_user_current_tallies,1,-1
! allocate node
allocate(curr_ptr)
! set the tally index
curr_ptr % data = i
curr_ptr % next => active_current_tallies
active_current_tallies => curr_ptr
! set indices in active tallies
allocate(tall_ptr)
tall_ptr % data = current_tallies(i)
tall_ptr % next => active_tallies
active_tallies => tall_ptr
do i = 1, n_user_current_tallies
call active_current_tallies % append(i)
call active_tallies % append(current_tallies(i))
end do
! nullify the temporary pointer
if (associated(curr_ptr)) nullify(curr_ptr)
end subroutine setup_active_usertallies
!===============================================================================
@ -2114,91 +1976,49 @@ contains
subroutine setup_active_cmfdtallies()
integer :: i ! loop counter
type(ListInt), pointer :: curr_ptr ! pointer to current list node
type(ListInt), pointer :: tall_ptr ! pointer to active tallies only
integer :: i ! loop counter
! check to see if actives tallies has been allocated
tall_ptr => active_tallies
if (associated(active_tallies)) then
message = 'Active tallies should not exist before CMFD tallies!'
if (active_tallies % size() > 0) then
message = "Active tallies should not exist before CMFD tallies!"
call fatal_error()
end if
! check to see if analog tallies have already been allocated
curr_ptr => null()
if (associated(active_analog_tallies)) then
if (active_analog_tallies % size() > 0) then
message = 'Active analog tallies should not exist before CMFD tallies!'
call fatal_error()
end if
do i = n_cmfd_analog_tallies + n_user_analog_tallies, n_user_analog_tallies + 1, -1
! allocate node
allocate(curr_ptr)
! set the tally index
curr_ptr % data = i
curr_ptr % next => active_analog_tallies
active_analog_tallies => curr_ptr
! set indices in active tallies
allocate(tall_ptr)
tall_ptr % data = analog_tallies(i)
tall_ptr % next => active_tallies
active_tallies => tall_ptr
do i = n_user_analog_tallies + 1, &
n_user_analog_tallies + n_cmfd_analog_tallies
call active_analog_tallies % append(i)
call active_tallies % append(analog_tallies(i))
end do
! check to see if tracklength tallies have already been allocated
curr_ptr => null()
if (associated(active_tracklength_tallies)) then
message = 'Active tracklength tallies should not exist before CMFD tallies!'
if (active_tracklength_tallies % size() > 0) then
message = "Active tracklength tallies should not exist before CMFD &
&tallies!"
call fatal_error()
end if
do i = n_cmfd_tracklength_tallies + n_user_tracklength_tallies, n_user_tracklength_tallies + 1, -1
! allocate node
allocate(curr_ptr)
! set the tally index
curr_ptr % data = i
curr_ptr % next => active_tracklength_tallies
active_tracklength_tallies => curr_ptr
! set indices in active tallies
allocate(tall_ptr)
tall_ptr % data = tracklength_tallies(i)
tall_ptr % next => active_tallies
active_tallies => tall_ptr
do i = n_user_tracklength_tallies + 1, &
n_user_tracklength_tallies + n_cmfd_tracklength_tallies
call active_tracklength_tallies % append(i)
call active_tallies % append(tracklength_tallies(i))
end do
! check to see if current tallies have already been allocated
curr_ptr => null()
if (associated(active_current_tallies)) then
message = 'Active current tallies should not exist before CMFD tallies!'
if (active_current_tallies % size() > 0) then
message = "Active current tallies should not exist before CMFD tallies!"
call fatal_error()
end if
do i = n_cmfd_current_tallies + n_user_current_tallies, &
n_user_current_tallies + 1, -1
! allocate node
allocate(curr_ptr)
! set the tally index
curr_ptr % data = i
curr_ptr % next => active_current_tallies
active_current_tallies => curr_ptr
! set indices in active tallies
allocate(tall_ptr)
tall_ptr % data = current_tallies(i)
tall_ptr % next => active_tallies
active_tallies => tall_ptr
do i = n_user_current_tallies + 1, &
n_user_current_tallies + n_cmfd_current_tallies
call active_current_tallies % append(i)
call active_tallies % append(current_tallies(i))
end do
end subroutine setup_active_cmfdtallies