From 3c51315c33033fd11ec709e8694252077836cb43 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Fri, 18 Jan 2013 21:21:38 -0500 Subject: [PATCH 1/5] Added rewritten dictionary, list, and set modules. Need refactor. --- src/DEPENDENCIES | 4 + src/OBJECTS | 3 + src/dict_header.F90 | 418 ++++++++++++++++++++++++++++++++++++++ src/list_header.F90 | 474 ++++++++++++++++++++++++++++++++++++++++++++ src/set_header.F90 | 101 ++++++++++ 5 files changed, 1000 insertions(+) create mode 100644 src/dict_header.F90 create mode 100644 src/list_header.F90 create mode 100644 src/set_header.F90 diff --git a/src/DEPENDENCIES b/src/DEPENDENCIES index c9b33be4b3..8a1b679977 100644 --- a/src/DEPENDENCIES +++ b/src/DEPENDENCIES @@ -242,6 +242,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 @@ -312,6 +314,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 diff --git a/src/OBJECTS b/src/OBJECTS index 2405d71a2a..3196594b38 100644 --- a/src/OBJECTS +++ b/src/OBJECTS @@ -17,6 +17,7 @@ constants.o \ cross_section.o \ datatypes.o \ datatypes_header.o \ +dict_header.o \ doppler.o \ eigenvalue.o \ endf.o \ @@ -33,6 +34,7 @@ hdf5_interface.o \ initialize.o \ interpolation.o \ input_xml.o \ +list_header.o \ main.o \ material_header.o \ math.o \ @@ -46,6 +48,7 @@ plot_header.o \ ppmlib.o \ random_lcg.o \ search.o \ +set_header.o \ source.o \ source_header.o \ state_point.o \ diff --git a/src/dict_header.F90 b/src/dict_header.F90 new file mode 100644 index 0000000000..42e65f4963 --- /dev/null +++ b/src/dict_header.F90 @@ -0,0 +1,418 @@ +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, 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, 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_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_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_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 containig the (key,values) +!=============================================================================== + + function dict_keys_ci(this) result(head) + + class(DictCharInt) :: this + type(ElemKeyValueCI), pointer :: head + type(ElemKeyValueCI), pointer :: current => null() + type(ElemKeyValueCI), pointer :: elem => null() + + integer :: i + + head => null() + + do i = 1, size(this % table) + elem => this % 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 % key = elem % key + current % value = elem % value + elem => elem % next + end do + end do + + end function dict_keys_ci + + function dict_keys_ii(this) result(head) + + class(DictIntInt) :: this + type(ElemKeyValueII), pointer :: head + type(ElemKeyValueII), pointer :: current => null() + type(ElemKeyValueII), pointer :: elem => null() + + integer :: i + + head => null() + + do i = 1, size(this % table) + elem => this % 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 % key = elem % key + current % value = elem % value + elem => elem%next + end do + end do + + end function dict_keys_ii + +end module dict_header diff --git a/src/list_header.F90 b/src/list_header.F90 new file mode 100644 index 0000000000..349b9c94fa --- /dev/null +++ b/src/list_header.F90 @@ -0,0 +1,474 @@ +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 + + 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 + +!=============================================================================== +! 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 :: 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 :: 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 + +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 + +!=============================================================================== +! 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 + +!=============================================================================== +! 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 + +!=============================================================================== +! 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 + +!=============================================================================== +! 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 + +!=============================================================================== +! 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 + +!=============================================================================== +! 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 + +end module list_header diff --git a/src/set_header.F90 b/src/set_header.F90 new file mode 100644 index 0000000000..a5799671a7 --- /dev/null +++ b/src/set_header.F90 @@ -0,0 +1,101 @@ +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 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 + +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 + +!=============================================================================== +! 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 + +!=============================================================================== +! 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 + +!=============================================================================== +! 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 + +!=============================================================================== +! 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 + +end module set_header From ea35be8ed0cbae26439657ea809e108e68d42d2a Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Fri, 18 Jan 2013 21:51:49 -0500 Subject: [PATCH 2/5] Added character list and set. --- src/list_header.F90 | 208 +++++++++++++++++++++++++++++++++++++++++++- src/set_header.F90 | 72 +++++++++++++-- 2 files changed, 274 insertions(+), 6 deletions(-) diff --git a/src/list_header.F90 b/src/list_header.F90 index 349b9c94fa..f929fce2c2 100644 --- a/src/list_header.F90 +++ b/src/list_header.F90 @@ -8,7 +8,7 @@ module list_header ! implementation with type-bound procedures (F2003). !=============================================================================== - use constants, only: ERROR_INT, ERROR_REAL + use constants, only: ERROR_INT, ERROR_REAL, MAX_WORD_LEN implicit none @@ -26,6 +26,11 @@ module list_header 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 @@ -75,6 +80,27 @@ module list_header 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 :: 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 !=============================================================================== @@ -130,6 +156,30 @@ contains 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_CONTAINS determines whether the list contains a specified item. Since it ! relies on the index method, it is O(n). @@ -153,6 +203,15 @@ contains 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. @@ -224,6 +283,39 @@ contains 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. @@ -271,6 +363,27 @@ contains 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. @@ -366,6 +479,51 @@ contains 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. @@ -449,6 +607,45 @@ contains 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 !=============================================================================== @@ -471,4 +668,13 @@ contains 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 diff --git a/src/set_header.F90 b/src/set_header.F90 index a5799671a7..d6358f4178 100644 --- a/src/set_header.F90 +++ b/src/set_header.F90 @@ -11,6 +11,7 @@ module set_header ! gigantic sets where performance is critical. !=============================================================================== + use constants, only: MAX_WORD_LEN use list_header implicit none @@ -31,6 +32,17 @@ module set_header 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 !=============================================================================== @@ -39,7 +51,7 @@ contains subroutine set_add_int(this, data) class(SetInt) :: this - integer :: data + integer :: data if (.not. this % elements % contains(data)) then call this % elements % append(data) @@ -47,24 +59,44 @@ contains 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 + 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 @@ -73,29 +105,59 @@ contains 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 + 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 + 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 From 006ba9b47dfca929c61c09dc769d7f4e7d8497c4 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 27 Jan 2013 14:38:25 -0500 Subject: [PATCH 3/5] Added method to clear all elements in a list. --- src/list_header.F90 | 85 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 85 insertions(+) diff --git a/src/list_header.F90 b/src/list_header.F90 index f929fce2c2..2d832dd0f4 100644 --- a/src/list_header.F90 +++ b/src/list_header.F90 @@ -51,6 +51,7 @@ module list_header 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 @@ -72,6 +73,7 @@ module list_header 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 @@ -93,6 +95,7 @@ module list_header 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 @@ -180,6 +183,88 @@ contains 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). From 2c2429a14b28d0d9b36cb320fafd569c2f29f5a2 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 27 Jan 2013 15:04:30 -0500 Subject: [PATCH 4/5] Fixed up dictionary keys method. --- src/dict_header.F90 | 152 ++++++++++++++++++++++++-------------------- 1 file changed, 83 insertions(+), 69 deletions(-) diff --git a/src/dict_header.F90 b/src/dict_header.F90 index 42e65f4963..6c40482a38 100644 --- a/src/dict_header.F90 +++ b/src/dict_header.F90 @@ -67,6 +67,7 @@ module dict_header 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 @@ -78,6 +79,7 @@ module dict_header 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 @@ -196,6 +198,55 @@ contains 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. @@ -268,55 +319,6 @@ contains end function dict_has_key_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_HASH_KEY returns the hash value for a given key !=============================================================================== @@ -354,62 +356,74 @@ contains end function dict_hash_key_ii !=============================================================================== -! DICT_KEYS returns a pointer to a linked list containig the (key,values) +! DICT_KEYS returns a pointer to a linked list of all (key,value) pairs !=============================================================================== - function dict_keys_ci(this) result(head) + function dict_keys_ci(this) result(keys) + class(DictCharInt) :: this + type(ElemKeyValueCI), pointer :: keys - class(DictCharInt) :: this - type(ElemKeyValueCI), pointer :: head + integer :: i type(ElemKeyValueCI), pointer :: current => null() type(ElemKeyValueCI), pointer :: elem => null() - integer :: i - - head => 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)) - if (.not. associated(head)) then - allocate(head) - current => head + ! 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(head) + function dict_keys_ii(this) result(keys) + class(DictIntInt) :: this + type(ElemKeyValueII), pointer :: keys - class(DictIntInt) :: this - type(ElemKeyValueII), pointer :: head + integer :: i type(ElemKeyValueII), pointer :: current => null() type(ElemKeyValueII), pointer :: elem => null() - integer :: i - - head => 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)) - if (.not. associated(head)) then - allocate(head) - current => head + ! 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 - elem => elem%next + + ! Move to next element in bucket i + elem => elem % next end do end do From d27dbe3c01f31f8bc4f8fdd9d8b8bc4195d35cfa Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 27 Jan 2013 15:25:55 -0500 Subject: [PATCH 5/5] 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 8a1b679977..16d5745ee6 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 3196594b38..9e4ce23c2b 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 1ac44db4e5..c42e4cbecf 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 3d2dafc6d4..d2e8fc360b 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 9578fee740..0000000000 --- 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 0ed07e7b3c..0000000000 --- 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 778d325ff5..fa868c0c38 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 fb15f6f3ce..a6c3333a4e 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 813de56730..f85d95b142 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 3eb2a156e8..c43cf3604f 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 8351ef7b9f..a951ade98a 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 7f8105d397..6d7c4dec85 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 7b9ccecf87..8c77620902 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 87db605a03..8ecc5a9feb 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