From d27dbe3c01f31f8bc4f8fdd9d8b8bc4195d35cfa Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 27 Jan 2013 15:25:55 -0500 Subject: [PATCH] Refactored to use new list, dictionary, and set implementations. Closes #56 on github. Closes #31 on github. --- src/DEPENDENCIES | 22 +- src/OBJECTS | 2 - src/ace.F90 | 32 +- src/cmfd_input.F90 | 3 +- src/datatypes.F90 | 1098 -------------------------------------- src/datatypes_header.F90 | 113 ---- src/energy_grid.F90 | 34 +- src/geometry.F90 | 5 +- src/global.F90 | 40 +- src/initialize.F90 | 96 ++-- src/input_xml.F90 | 82 ++- src/output.F90 | 3 +- src/physics.F90 | 8 +- src/tally.F90 | 304 +++-------- 14 files changed, 200 insertions(+), 1642 deletions(-) delete mode 100644 src/datatypes.F90 delete mode 100644 src/datatypes_header.F90 diff --git a/src/DEPENDENCIES b/src/DEPENDENCIES index 8a1b67997..16d5745ee 100644 --- a/src/DEPENDENCIES +++ b/src/DEPENDENCIES @@ -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 @@ -39,7 +38,6 @@ cmfd_execute.o: timing.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 @@ -117,17 +115,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 @@ -159,7 +154,6 @@ fixed_source.o: tally.o fixed_source.o: timing.o geometry.o: constants.o -geometry.o: datatypes.o geometry.o: error.o geometry.o: geometry_header.o geometry.o: global.o @@ -172,8 +166,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 @@ -198,8 +192,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 @@ -218,8 +211,7 @@ initialize.o: timing.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 @@ -262,7 +254,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 @@ -342,7 +333,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 diff --git a/src/OBJECTS b/src/OBJECTS index 3196594b3..9e4ce23c2 100644 --- a/src/OBJECTS +++ b/src/OBJECTS @@ -15,8 +15,6 @@ 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 \ diff --git a/src/ace.F90 b/src/ace.F90 index 1ac44db4e..c42e4cbec 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -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 diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 3d2dafc6d..d2e8fc360 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -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)) diff --git a/src/datatypes.F90 b/src/datatypes.F90 deleted file mode 100644 index 9578fee74..000000000 --- a/src/datatypes.F90 +++ /dev/null @@ -1,1098 +0,0 @@ -module datatypes - -!=============================================================================== -! DATATYPES module -! -! This module implements 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 from the 'flibs' open source package implemented another -! derived type called DICT_DATA that has been replaced here by a simple integer -! in ListData. If used in the original form , the dictionary can store derived -! types (changes made to ListData, dict_create, dict_add_key, and dict_get_key). -!=============================================================================== - - use datatypes_header - - implicit none - - integer, parameter, private :: HASH_SIZE = 4993 - integer, parameter, private :: HASH_MULTIPLIER = 31 - integer, parameter, private :: DICT_NULL = 0 - -!=============================================================================== -! LIST Interfaces -- these allow one to use a single subroutine or function for -! various types of lists, namely those consisting of integers, reals, or -! (key,value) pairs. -!=============================================================================== - - interface list_create - module procedure list_real_create, list_int_create - module procedure list_kvci_create, list_kvii_create - end interface list_create - interface list_insert - module procedure list_int_insert, list_real_insert - module procedure list_kvci_insert, list_kvii_insert - end interface list_insert - interface list_delete - module procedure list_int_delete, list_real_delete - module procedure list_kvci_delete, list_kvii_delete - end interface list_delete - interface list_size - module procedure list_int_size, list_real_size - module procedure list_kvci_size, list_kvii_size - end interface list_size - interface list_insert_head - module procedure list_int_insert_head, list_real_insert_head - module procedure list_kvci_insert_head, list_kvii_insert_head - end interface list_insert_head - interface list_delete_element - module procedure list_int_del_element, list_real_del_element - module procedure list_kvci_del_element, list_kvii_del_element - end interface list_delete_element - -!=============================================================================== -! DICTIONARY Interfaces -- these allow one to use a single subroutine or -! function for dictionaries with varying types of (key,value) pairs -!=============================================================================== - - interface dict_create - module procedure dict_ci_create, dict_ii_create - end interface dict_create - interface dict_delete - module procedure dict_ci_delete, dict_ii_delete - end interface dict_delete - interface dict_add_key - module procedure dict_ci_add_key, dict_ii_add_key - end interface dict_add_key - interface dict_delete_key - module procedure dict_ci_delete_key, dict_ii_delete_key - end interface dict_delete_key - interface dict_get_key - module procedure dict_ci_get_key, dict_ii_get_key - end interface dict_get_key - interface dict_has_key - module procedure dict_ci_has_key, dict_ii_has_key - end interface dict_has_key - interface dict_get_elem - module procedure dict_ci_get_elem, dict_ii_get_elem - end interface dict_get_elem - interface dict_hashkey - module procedure dict_ci_hashkey, dict_ii_hashkey - end interface dict_hashkey - interface dict_keys - module procedure dict_ci_keys, dict_ii_keys - end interface dict_keys - -contains - -!=============================================================================== -! LIST_INT_CREATE creates and initializes a list of integers -!=============================================================================== - - subroutine list_int_create(list, data) - - type(ListInt), pointer :: list - integer, intent(in) :: data - - allocate(list) - list%next => null() - list%data = data - - end subroutine list_int_create - -!=============================================================================== -! LIST_REAL_CREATE creates and initializes a list of real(8)s -!=============================================================================== - - subroutine list_real_create(list, data) - - type(ListReal), pointer :: list - real(8), intent(in) :: data - - allocate(list) - list%next => null() - list%data = data - - end subroutine list_real_create - -!=============================================================================== -! LIST_KVCI_CREATE creates and initializes a list of (key,value) pairs -!=============================================================================== - - subroutine list_kvci_create(list, data) - - type(ListKeyValueCI), pointer :: list - type(KeyValueCI), intent(in) :: data - - allocate(list) - list%next => null() - list%data = data - - end subroutine list_kvci_create - -!=============================================================================== -! LIST_KVII_CREATE creates and initializes a list of (key,value) pairs -!=============================================================================== - - subroutine list_kvii_create(list, data) - - type(ListKeyValueII), pointer :: list - type(KeyValueII), intent(in) :: data - - allocate(list) - list%next => null() - list%data = data - - end subroutine list_kvii_create - -!=============================================================================== -! LIST_INT_DELETE deallocates all data in a list of integers -!=============================================================================== - - subroutine list_int_delete(list) - - type(ListInt), pointer :: list - type(ListInt), pointer :: current - type(ListInt), pointer :: next - - if (associated(list)) then - current => list - do while (associated(current%next)) - next => current%next - deallocate(current) - current => next - end do - end if - - end subroutine list_int_delete - -!=============================================================================== -! LIST_REAL_DELETE deallocates all data in a list of real(8)s -!=============================================================================== - - subroutine list_real_delete(list) - - type(ListReal), pointer :: list - type(ListReal), pointer :: current - type(ListReal), pointer :: next - - if (associated(list)) then - current => list - do while (associated(current%next)) - next => current%next - deallocate(current) - current => next - end do - end if - - end subroutine list_real_delete - -!=============================================================================== -! LIST_KVCI_DELETE deallocates all data in a list of (key,value) pairs -!=============================================================================== - - subroutine list_kvci_delete(list) - - type(ListKeyValueCI), pointer :: list - type(ListKeyValueCI), pointer :: current - type(ListKeyValueCI), pointer :: next - - if (associated(list)) then - current => list - do while (associated(current%next)) - next => current%next - deallocate(current) - current => next - end do - end if - - end subroutine list_kvci_delete - -!=============================================================================== -! LIST_KVII_DELETE deallocates all data in a list of (key,value) pairs -!=============================================================================== - - subroutine list_kvii_delete(list) - - type(ListKeyValueII), pointer :: list - type(ListKeyValueII), pointer :: current - type(ListKeyValueII), pointer :: next - - if (associated(list)) then - current => list - do while (associated(current%next)) - next => current%next - deallocate(current) - current => next - end do - end if - - end subroutine list_kvii_delete - -!=============================================================================== -! LIST_INT_SIZE counts the number of items in a list of integers -!=============================================================================== - - function list_int_size(list) result(n) - - type(ListInt), pointer :: list - type(ListInt), pointer :: current - integer :: n - - if (associated(list)) then - n = 1 - current => list - do while (associated(current%next)) - current => current%next - n = n + 1 - end do - else - n = 0 - end if - - end function list_int_size - -!=============================================================================== -! LIST_REAL_SIZE counts the number of items in a list of real(8)s -!=============================================================================== - - function list_real_size(list) result(n) - - type(ListReal), pointer :: list - type(ListReal), pointer :: current - integer :: n - - if (associated(list)) then - n = 1 - current => list - do while (associated(current%next)) - current => current%next - n = n + 1 - end do - else - n = 0 - end if - - end function list_real_size - -!=============================================================================== -! LIST_KVCI_SIZE counts the number of items in a list of (key,value) -! pairs -!=============================================================================== - - function list_kvci_size(list) result(n) - - type(ListKeyValueCI), pointer :: list - type(ListKeyValueCI), pointer :: current - integer :: n - - if (associated(list)) then - n = 1 - current => list - do while (associated(current%next)) - current => current%next - n = n + 1 - end do - else - n = 0 - end if - - end function list_kvci_size - -!=============================================================================== -! LIST_KVII_SIZE counts the number of items in a list of (key,value) pairs -!=============================================================================== - - function list_kvii_size(list) result(n) - - type(ListKeyValueII), pointer :: list - type(ListKeyValueII), pointer :: current - integer :: n - - if (associated(list)) then - n = 1 - current => list - do while (associated(current%next)) - current => current%next - n = n + 1 - end do - else - n = 0 - end if - - end function list_kvii_size - -!=============================================================================== -! LIST_INT_INSERT inserts a new element -! Arguments: -! elem Element in the linked list after -! which to insert the new element -! data The data for the new element -!=============================================================================== - - subroutine list_int_insert(elem, data) - - type(ListInt), pointer :: elem - integer, intent(in) :: data - - type(ListInt), pointer :: next - - allocate(next) - - next%next => elem%next - elem%next => next - next%data = data - - end subroutine list_int_insert - -!=============================================================================== -! LIST_REAL_INSERT inserts a new element -! Arguments: -! elem Element in the linked list after -! which to insert the new element -! data The data for the new element -!=============================================================================== - - subroutine list_real_insert(elem, data) - - type(ListReal), pointer :: elem - real(8), intent(in) :: data - - type(ListReal), pointer :: next - - allocate(next) - - next%next => elem%next - elem%next => next - next%data = data - - end subroutine list_real_insert - -!=============================================================================== -! LIST_KVCI_INSERT inserts a new element -! Arguments: -! elem Element in the linked list after -! which to insert the new element -! data The data for the new element -!=============================================================================== - - subroutine list_kvci_insert(elem, data) - - type(ListKeyValueCI), pointer :: elem - type(KeyValueCI), intent(in) :: data - - type(ListKeyValueCI), pointer :: next - - allocate(next) - - next%next => elem%next - elem%next => next - next%data = data - - end subroutine list_kvci_insert - -!=============================================================================== -! LIST_KVII_INSERT inserts a new element -! Arguments: -! elem Element in the linked list after -! which to insert the new element -! data The data for the new element -!=============================================================================== - - subroutine list_kvii_insert(elem, data) - - type(ListKeyValueII), pointer :: elem - type(KeyValueII), intent(in) :: data - - type(ListKeyValueII), pointer :: next - - allocate(next) - - next%next => elem%next - elem%next => next - next%data = data - - end subroutine list_kvii_insert - -!=============================================================================== -! LIST_INT_INSERT_HEAD inserts a new element before the first element -! Arguments: -! list Start of the list -! data The data for the new element -!=============================================================================== - - subroutine list_int_insert_head(list, data) - - type(ListInt), pointer :: list - integer, intent(in) :: data - - type(ListInt), pointer :: elem - - allocate(elem) - elem%data = data - - elem%next => list - list => elem - - end subroutine list_int_insert_head - -!=============================================================================== -! LIST_REAL_INSERT_HEAD inserts a new element before the first element -! Arguments: -! list Start of the list -! data The data for the new element -!=============================================================================== - - subroutine list_real_insert_head(list, data) - - type(ListReal), pointer :: list - real(8), intent(in) :: data - - type(ListReal), pointer :: elem - - allocate(elem) - elem%data = data - - elem%next => list - list => elem - - end subroutine list_real_insert_head - -!=============================================================================== -! LIST_KVCI_INSERT_HEAD inserts a new element before the first element -! Arguments: -! list Start of the list -! data The data for the new element -!=============================================================================== - - subroutine list_kvci_insert_head(list, data) - - type(ListKeyValueCI), pointer :: list - type(KeyValueCI), intent(in) :: data - - type(ListKeyValueCI), pointer :: elem - - allocate(elem) - elem%data = data - - elem%next => list - list => elem - - end subroutine list_kvci_insert_head - -!=============================================================================== -! LIST_KVII_INSERT_HEAD inserts a new element before the first element -! Arguments: -! list Start of the list -! data The data for the new element -!=============================================================================== - - subroutine list_kvii_insert_head(list, data) - - type(ListKeyValueII), pointer :: list - type(KeyValueII), intent(in) :: data - - type(ListKeyValueII), pointer :: elem - - allocate(elem) - elem%data = data - - elem%next => list - list => elem - - end subroutine list_kvii_insert_head - -!=============================================================================== -! LIST_INT_DEL_ELEMENT deletes an element from the list -! Arguments: -! list Header of the list -! elem Element in the linked list to be removed -!=============================================================================== - - subroutine list_int_del_element(list, elem) - - type(ListInt), pointer :: list - type(ListInt), pointer :: elem - - type(ListInt), pointer :: current - type(ListInt), pointer :: prev - - if (associated(list,elem)) then - list => elem%next - deallocate(elem) - else - current => list - prev => list - do while (associated(current)) - if (associated(current,elem)) then - prev%next => current%next - deallocate(current) ! Is also "elem" - exit - end if - prev => current - current => current%next - end do - end if - - end subroutine list_int_del_element - -!=============================================================================== -! LIST_REAL_DEL_ELEMENT deletes an element from the list -! Arguments: -! list Header of the list -! elem Element in the linked list to be removed -!=============================================================================== - - subroutine list_real_del_element(list, elem) - - type(ListReal), pointer :: list - type(ListReal), pointer :: elem - - type(ListReal), pointer :: current - type(ListReal), pointer :: prev - - if (associated(list,elem)) then - list => elem%next - deallocate(elem) - else - current => list - prev => list - do while (associated(current)) - if (associated(current,elem)) then - prev%next => current%next - deallocate(current) ! Is also "elem" - exit - end if - prev => current - current => current%next - end do - end if - - end subroutine list_real_del_element - -!=============================================================================== -! LIST_KVCI_DEL_ELEMENT deletes an element from the list -! Arguments: -! list Header of the list -! elem Element in the linked list to be removed -!=============================================================================== - - subroutine list_kvci_del_element(list, elem) - - type(ListKeyValueCI), pointer :: list - type(ListKeyValueCI), pointer :: elem - - type(ListKeyValueCI), pointer :: current - type(ListKeyValueCI), pointer :: prev - - if (associated(list,elem)) then - list => elem%next - deallocate(elem) - else - current => list - prev => list - do while (associated(current)) - if (associated(current,elem)) then - prev%next => current%next - deallocate(current) ! Is also "elem" - exit - end if - prev => current - current => current%next - end do - end if - - end subroutine list_kvci_del_element - -!=============================================================================== -! LIST_KVII_DEL_ELEMENT deletes an element from the list -! Arguments: -! list Header of the list -! elem Element in the linked list to be removed -!=============================================================================== - - subroutine list_kvii_del_element(list, elem) - - type(ListKeyValueII), pointer :: list - type(ListKeyValueII), pointer :: elem - - type(ListKeyValueII), pointer :: current - type(ListKeyValueII), pointer :: prev - - if (associated(list,elem)) then - list => elem%next - deallocate(elem) - else - current => list - prev => list - do while (associated(current)) - if (associated(current,elem)) then - prev%next => current%next - deallocate(current) ! Is also "elem" - exit - end if - prev => current - current => current%next - end do - end if - - end subroutine list_kvii_del_element - -!=============================================================================== -! DICT_CI_CREATE creates and initializes a dictionary -!=============================================================================== - - subroutine dict_ci_create(dict) - - type(DictionaryCI), pointer :: dict - - integer :: i - - allocate(dict) - allocate(dict%table(HASH_SIZE)) - - do i = 1,HASH_SIZE - dict%table(i)%list => null() - end do - - end subroutine dict_ci_create - -!=============================================================================== -! DICT_II_CREATE creates and initializes a dictionary -!=============================================================================== - - subroutine dict_ii_create(dict) - - type(DictionaryII), pointer :: dict - - integer :: i - - allocate(dict) - allocate(dict%table(HASH_SIZE)) - - do i = 1,HASH_SIZE - dict%table(i)%list => null() - end do - - end subroutine dict_ii_create - -!=============================================================================== -! DICT_CI_DELETE destroys an entire dictionary -!=============================================================================== - - subroutine dict_ci_delete(dict) - - type(DictionaryCI), pointer :: dict - - integer :: i - - do i = 1,size(dict%table) - if (associated(dict%table(i)%list)) then - call list_delete(dict%table(i)%list) - end if - end do - deallocate(dict%table) - deallocate(dict) - - end subroutine dict_ci_delete - -!=============================================================================== -! DICT_II_DELETE destroys an entire dictionary -!=============================================================================== - - subroutine dict_ii_delete(dict) - - type(DictionaryII), pointer :: dict - - integer :: i - - do i = 1,size(dict%table) - if (associated(dict%table(i)%list)) then - call list_delete(dict%table(i)%list) - end if - end do - deallocate(dict%table) - deallocate(dict) - - end subroutine dict_ii_delete - -!=============================================================================== -! DICT_CI_ADD_KEY add a new keys -! Arguments: -! dict Pointer to the dictionary -! key Key for the new element -! value Value for the new element -! Note: -! If the key already exists, the -! key's value is simply replaced -!=============================================================================== - - subroutine dict_ci_add_key(dict, key, value) - - type(DictionaryCI), pointer :: dict - character(*), intent(in) :: key - integer, intent(in) :: value - - type(KeyValueCI) :: data - type(ListKeyValueCI), pointer :: elem - integer :: hash - - elem => dict_get_elem(dict, key) - - if (associated(elem)) then - elem%data%value = value - else - data%key = key - data%value = value - hash = dict_hashkey(trim(key)) - if (associated(dict%table(hash)%list)) then - call list_insert(dict%table(hash)%list, data) - else - call list_create(dict%table(hash)%list, data) - end if - end if - - end subroutine dict_ci_add_key - -!=============================================================================== -! DICT_II_ADD_KEY add a new keys -! Arguments: -! dict Pointer to the dictionary -! key Key for the new element -! value Value for the new element -! Note: -! If the key already exists, the -! key's value is simply replaced -!=============================================================================== - - subroutine dict_ii_add_key(dict, key, value) - - type(DictionaryII), pointer :: dict - integer, intent(in) :: key - integer, intent(in) :: value - - type(KeyValueII) :: data - type(ListKeyValueII), pointer :: elem - integer :: hash - - elem => dict_get_elem(dict, key) - - if (associated(elem)) then - elem%data%value = value - else - data%key = key - data%value = value - hash = dict_hashkey(key) - if (associated(dict%table(hash)%list)) then - call list_insert(dict%table(hash)%list, data) - else - call list_create(dict%table(hash)%list, data) - end if - end if - - end subroutine dict_ii_add_key - -!=============================================================================== -! DICT_CI_DELETE_KEY deletes a key-value pair from the dictionary -! Arguments: -! dict Dictionary in question -! key Key to be removed -!=============================================================================== - - subroutine dict_ci_delete_key(dict, key) - - type(DictionaryCI), pointer :: dict - character(*), intent(in) :: key - - type(ListKeyValueCI), pointer :: elem - integer :: hash - - elem => dict_get_elem(dict, key) - - if (associated(elem)) then - hash = dict_hashkey(trim(key)) - call list_delete_element(dict%table(hash)%list, elem) - end if - - end subroutine dict_ci_delete_key - -!=============================================================================== -! DICT_II_DELETE_KEY deletes a key-value pair from the dictionary -! Arguments: -! dict Dictionary in question -! key Key to be removed -!=============================================================================== - - subroutine dict_ii_delete_key(dict, key) - - type(DictionaryII), pointer :: dict - integer, intent(in) :: key - - type(ListKeyValueII), pointer :: elem - integer :: hash - - elem => dict_get_elem(dict, key) - - if (associated(elem)) then - hash = dict_hashkey(key) - call list_delete_element(dict%table(hash)%list, elem) - end if - - end subroutine dict_ii_delete_key - -!=============================================================================== -! DICT_CI_GET_KEY gets the value belonging to a key -! Arguments: -! dict Pointer to the dictionary -! key Key for which the values are sought -!=============================================================================== - - function dict_ci_get_key(dict, key) result(value) - - type(DictionaryCI), pointer :: dict - character(*), intent(in) :: key - integer :: value - - type(ListKeyValueCI), pointer :: elem - - elem => dict_get_elem(dict, key) - - if (associated(elem)) then - value = elem%data%value - else - value = DICT_NULL - end if - - end function dict_ci_get_key - -!=============================================================================== -! DICT_II_GET_KEY gets the value belonging to a key -! Arguments: -! dict Pointer to the dictionary -! key Key for which the values are sought -!=============================================================================== - - function dict_ii_get_key(dict, key) result(value) - - type(DictionaryII), pointer :: dict - integer, intent(in) :: key - integer :: value - - type(ListKeyValueII), pointer :: elem - - elem => dict_get_elem(dict, key) - - if (associated(elem)) then - value = elem%data%value - else - value = DICT_NULL - end if - - end function dict_ii_get_key - -!=============================================================================== -! DICT_CI_HAS_KEY checks if the dictionary has a particular key -! Arguments: -! dict Pointer to the dictionary -! key Key to be sought -!=============================================================================== - - function dict_ci_has_key(dict, key) result(has) - - type(DictionaryCI), pointer :: dict - character(*), intent(in) :: key - logical :: has - - type(ListKeyValueCI), pointer :: elem - - elem => dict_get_elem(dict, key) - - has = associated(elem) - - end function dict_ci_has_key - -!=============================================================================== -! DICT_II_HAS_KEY checks if the dictionary has a particular key -! Arguments: -! dict Pointer to the dictionary -! key Key to be sought -!=============================================================================== - - function dict_ii_has_key(dict, key) result(has) - - type(DictionaryII), pointer :: dict - integer, intent(in) :: key - logical :: has - - type(ListKeyValueII), pointer :: elem - - elem => dict_get_elem(dict, key) - - has = associated(elem) - - end function dict_ii_has_key - -!=============================================================================== -! DICT_CI_GET_ELEM finds the element with a particular key -! Arguments: -! dict Pointer to the dictionary -! key Key to be sought -!=============================================================================== - - function dict_ci_get_elem(dict, key) result(elem) - - type(DictionaryCI), pointer :: dict - character(*), intent(in) :: key - - type(ListKeyValueCI), pointer :: elem - integer :: hash - - hash = dict_hashkey(trim(key)) - elem => dict%table(hash)%list - do while (associated(elem)) - if (elem%data%key .eq. key) then - exit - else - elem => elem%next - end if - end do - - end function dict_ci_get_elem - -!=============================================================================== -! DICT_II_GET_ELEM finds the element with a particular key -! Arguments: -! dict Pointer to the dictionary -! key Key to be sought -!=============================================================================== - - function dict_ii_get_elem(dict, key) result(elem) - - type(DictionaryII), pointer :: dict - integer, intent(in) :: key - - type(ListKeyValueII), pointer :: elem - integer :: hash - - hash = dict_hashkey(key) - elem => dict%table(hash)%list - do while (associated(elem)) - if (elem%data%key .eq. key) then - exit - else - elem => elem%next - end if - end do - - end function dict_ii_get_elem - -!=============================================================================== -! DICT_CI_HASHKEY determine the hash value from the string -! Arguments: -! key String to be examined -!=============================================================================== - - function dict_ci_hashkey(key) result(val) - - character(*), intent(in) :: key - integer :: val - - integer :: i - - val = 0 - - do i = 1, len(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_ci_hashkey - -!=============================================================================== -! DICT_II_HASHKEY determine the hash value from the string -! Arguments: -! key String to be examined -!=============================================================================== - - function dict_ii_hashkey(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_ii_hashkey - -!=============================================================================== -! DICT_CI_KEYS -!=============================================================================== - - function dict_ci_keys(dict) result(head) - - type(DictionaryCI), pointer :: dict - type(ListKeyValueCI), pointer :: head - type(ListKeyValueCI), pointer :: current => null() - type(ListKeyValueCI), pointer :: elem => null() - - integer :: i - - head => null() - - do i = 1, size(dict%table) - elem => dict%table(i)%list - do while (associated(elem)) - if (.not. associated(head)) then - allocate(head) - current => head - else - allocate(current%next) - current => current%next - end if - current%data = elem%data - elem => elem%next - end do - end do - - end function dict_ci_keys - -!=============================================================================== -! DICT_II_KEYS -!=============================================================================== - - function dict_ii_keys(dict) result(head) - - type(DictionaryII), pointer :: dict - type(ListKeyValueII), pointer :: head - type(ListKeyValueII), pointer :: current => null() - type(ListKeyValueII), pointer :: elem => null() - - integer :: i - - head => null() - - do i = 1, size(dict%table) - elem => dict%table(i)%list - do while (associated(elem)) - if (.not. associated(head)) then - allocate(head) - current => head - else - allocate(current%next) - current => current%next - end if - current%data = elem%data - elem => elem%next - end do - end do - - end function dict_ii_keys - -end module datatypes diff --git a/src/datatypes_header.F90 b/src/datatypes_header.F90 deleted file mode 100644 index 0ed07e7b3..000000000 --- a/src/datatypes_header.F90 +++ /dev/null @@ -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 diff --git a/src/energy_grid.F90 b/src/energy_grid.F90 index 778d325ff..fa868c0c3 100644 --- a/src/energy_grid.F90 +++ b/src/energy_grid.F90 @@ -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) diff --git a/src/geometry.F90 b/src/geometry.F90 index fb15f6f3c..a6c3333a4 100644 --- a/src/geometry.F90 +++ b/src/geometry.F90 @@ -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 diff --git a/src/global.F90 b/src/global.F90 index 813de5673..f85d95b14 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -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 @@ -148,10 +148,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 @@ -417,10 +417,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 diff --git a/src/initialize.F90 b/src/initialize.F90 index 3eb2a156e..c43cf3604 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -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 @@ -68,9 +66,6 @@ contains call header("INITIALIZATION", level=1) end if - ! set up dictionaries - call create_dictionaries() - ! Read XML input files call read_input_xml() @@ -344,31 +339,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. @@ -381,7 +351,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() @@ -392,25 +362,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 @@ -423,7 +393,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 @@ -461,8 +431,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))) // & @@ -476,8 +446,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)) @@ -491,9 +461,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)) @@ -501,12 +471,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." @@ -523,8 +493,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)) @@ -547,8 +517,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)) @@ -560,8 +530,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)) @@ -573,8 +543,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)) @@ -586,8 +556,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)) @@ -598,8 +568,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)) @@ -641,7 +611,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 @@ -663,7 +633,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 diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 8351ef7b9..a951ade98 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -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 diff --git a/src/output.F90 b/src/output.F90 index 7f8105d39..6d7c4dec8 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -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 diff --git a/src/physics.F90 b/src/physics.F90 index 7b9ccecf8..8c7762090 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -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 diff --git a/src/tally.F90 b/src/tally.F90 index 87db605a0..8ecc5a9fe 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -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