From e6dd118a1d6b7e77d3b8314a3ae140b37f7dfb0a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 13 Sep 2020 12:11:26 +0200 Subject: [PATCH] not needed anymore --- src/list.f90 | 453 --------------------------------------------------- 1 file changed, 453 deletions(-) delete mode 100644 src/list.f90 diff --git a/src/list.f90 b/src/list.f90 deleted file mode 100644 index 901bb4d7c..000000000 --- a/src/list.f90 +++ /dev/null @@ -1,453 +0,0 @@ -!------------------------------------------------------------------------------------------------- -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Linked list -!-------------------------------------------------------------------------------------------------- -module list - use prec - use IO - - implicit none - private - type, private :: tPartitionedString - character(len=:), allocatable :: val - integer, dimension(:), allocatable :: pos - end type tPartitionedString - - type, public :: tPartitionedStringList - type(tPartitionedString) :: string - type(tPartitionedStringList), pointer :: next => null() - contains - procedure :: add => add - procedure :: show => show - procedure :: free => free - - ! currently, a finalize is needed for all shapes of tPartitionedStringList. - ! with Fortran 2015, we can define one recursive elemental function - ! https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/543326 - final :: finalize, & - finalizeArray - - procedure :: keyExists => keyExists - procedure :: countKeys => countKeys - - procedure :: getFloat => getFloat - procedure :: getInt => getInt - procedure :: getString => getString - - procedure :: getFloats => getFloats - procedure :: getInts => getInts - procedure :: getStrings => getStrings - - end type tPartitionedStringList - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief add element -!> @details Adds a string together with the start/end position of chunks in this string. The new -!! element is added at the end of the list. Empty strings are not added. All strings are converted -!! to lower case. The data is not stored in the new element but in the current. -!-------------------------------------------------------------------------------------------------- -subroutine add(this,string) - - class(tPartitionedStringList), target, intent(in) :: this - character(len=*), intent(in) :: string - type(tPartitionedStringList), pointer :: new, temp - - if (IO_isBlank(string)) return - - allocate(new) - temp => this - do while (associated(temp%next)) - temp => temp%next - enddo - temp%string%val = IO_lc (trim(string)) - temp%string%pos = IO_stringPos(trim(string)) - temp%next => new - -end subroutine add - - -!-------------------------------------------------------------------------------------------------- -!> @brief prints all elements -!> @details Strings are printed in order of insertion (FIFO) -!-------------------------------------------------------------------------------------------------- -subroutine show(this) - - class(tPartitionedStringList), target, intent(in) :: this - type(tPartitionedStringList), pointer :: item - - item => this - do while (associated(item%next)) - write(6,'(a)') ' '//trim(item%string%val) - item => item%next - enddo - -end subroutine show - - -!-------------------------------------------------------------------------------------------------- -!> @brief empties list and frees associated memory -!> @details explicit interface to reset list. Triggers final statement (and following chain reaction) -!-------------------------------------------------------------------------------------------------- -subroutine free(this) - - class(tPartitionedStringList), intent(inout) :: this - - if(associated(this%next)) deallocate(this%next) - -end subroutine free - - -!-------------------------------------------------------------------------------------------------- -!> @brief empties list and frees associated memory -!> @details called when variable goes out of scope. Triggers chain reaction for list -!-------------------------------------------------------------------------------------------------- -recursive subroutine finalize(this) - - type(tPartitionedStringList), intent(inout) :: this - - if(associated(this%next)) deallocate(this%next) - -end subroutine finalize - - -!-------------------------------------------------------------------------------------------------- -!> @brief cleans entire array of linke lists -!> @details called when variable goes out of scope and deallocates the list at each array entry -!-------------------------------------------------------------------------------------------------- -subroutine finalizeArray(this) - - integer :: i - type(tPartitionedStringList), intent(inout), dimension(:) :: this - type(tPartitionedStringList), pointer :: temp ! bug in Gfortran? - - do i=1, size(this) - if (associated(this(i)%next)) then - temp => this(i)%next - !deallocate(this(i)) !internal compiler error: in gfc_build_final_call, at fortran/trans.c:975 - deallocate(temp) - endif - enddo - -end subroutine finalizeArray - - -!-------------------------------------------------------------------------------------------------- -!> @brief reports wether a given key (string value at first position) exists in the list -!-------------------------------------------------------------------------------------------------- -logical function keyExists(this,key) - - class(tPartitionedStringList), target, intent(in) :: this - character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: item - - keyExists = .false. - - item => this - do while (associated(item%next) .and. .not. keyExists) - keyExists = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) - item => item%next - enddo - -end function keyExists - - -!-------------------------------------------------------------------------------------------------- -!> @brief count number of key appearances -!> @details traverses list and counts each occurrence of specified key -!-------------------------------------------------------------------------------------------------- -integer function countKeys(this,key) - - class(tPartitionedStringList), target, intent(in) :: this - character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: item - - countKeys = 0 - - item => this - do while (associated(item%next)) - if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) & - countKeys = countKeys + 1 - item => item%next - enddo - -end function countKeys - - -!-------------------------------------------------------------------------------------------------- -!> @brief gets float value of for a given key from a linked list -!> @details gets the last value if the key occurs more than once. If key is not found exits with -!! error unless default is given -!-------------------------------------------------------------------------------------------------- -real(pReal) function getFloat(this,key,defaultVal) - - class(tPartitionedStringList), target, intent(in) :: this - character(len=*), intent(in) :: key - real(pReal), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: item - logical :: found - - getFloat = huge(1.0) ! suppress warning about unitialized value - found = present(defaultVal) - if (found) getFloat = defaultVal - - item => this - do while (associated(item%next)) - if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then - found = .true. - if (item%string%pos(1) < 2) call IO_error(143,ext_msg=key) - getFloat = IO_FloatValue(item%string%val,item%string%pos,2) - endif - item => item%next - enddo - - if (.not. found) call IO_error(140,ext_msg=key) - -end function getFloat - - -!-------------------------------------------------------------------------------------------------- -!> @brief gets integer value of for a given key from a linked list -!> @details gets the last value if the key occurs more than once. If key is not found exits with -!! error unless default is given -!-------------------------------------------------------------------------------------------------- -integer function getInt(this,key,defaultVal) - - class(tPartitionedStringList), target, intent(in) :: this - character(len=*), intent(in) :: key - integer, intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: item - logical :: found - - getInt = huge(1) ! suppress warning about unitialized value - found = present(defaultVal) - if (found) getInt = defaultVal - - item => this - do while (associated(item%next)) - if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then - found = .true. - if (item%string%pos(1) < 2) call IO_error(143,ext_msg=key) - getInt = IO_IntValue(item%string%val,item%string%pos,2) - endif - item => item%next - enddo - - if (.not. found) call IO_error(140,ext_msg=key) - -end function getInt - - -!-------------------------------------------------------------------------------------------------- -!> @brief gets string value of for a given key from a linked list -!> @details gets the last value if the key occurs more than once. If key is not found exits with -!! error unless default is given. If raw is true, the the complete string is returned, otherwise -!! the individual chunks are returned -!-------------------------------------------------------------------------------------------------- -character(len=pStringLen) function getString(this,key,defaultVal,raw) - - class(tPartitionedStringList), target, intent(in) :: this - character(len=*), intent(in) :: key - character(len=*), intent(in), optional :: defaultVal - logical, intent(in), optional :: raw - type(tPartitionedStringList), pointer :: item - logical :: found, & - whole - if (present(raw)) then - whole = raw - else - whole = .false. - endif - - found = present(defaultVal) - if (found) then - if (len_trim(defaultVal) > len(getString)) call IO_error(0,ext_msg='getString') - getString = trim(defaultVal) - endif - - item => this - do while (associated(item%next)) - if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then - found = .true. - if (item%string%pos(1) < 2) call IO_error(143,ext_msg=key) - - if (whole) then - getString = trim(item%string%val(item%string%pos(4):)) ! raw string starting a second chunk - else - getString = IO_StringValue(item%string%val,item%string%pos,2) - endif - endif - item => item%next - enddo - - if (.not. found) call IO_error(140,ext_msg=key) - -end function getString - - -!-------------------------------------------------------------------------------------------------- -!> @brief gets array of float values of for a given key from a linked list -!> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all -!! values from the last occurrence. If key is not found exits with error unless default is given. -!-------------------------------------------------------------------------------------------------- -function getFloats(this,key,defaultVal,requiredSize) - - real(pReal), dimension(:), allocatable :: getFloats - class(tPartitionedStringList), target, intent(in) :: this - character(len=*), intent(in) :: key - real(pReal), dimension(:), intent(in), optional :: defaultVal - integer, intent(in), optional :: requiredSize - type(tPartitionedStringList), pointer :: item - integer :: i - logical :: found, & - cumulative - - cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') - found = .false. - - allocate(getFloats(0)) - - item => this - do while (associated(item%next)) - if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then - found = .true. - if (.not. cumulative) getFloats = [real(pReal)::] - if (item%string%pos(1) < 2) call IO_error(143,ext_msg=key) - do i = 2, item%string%pos(1) - getFloats = [getFloats,IO_FloatValue(item%string%val,item%string%pos,i)] - enddo - endif - item => item%next - enddo - - if (.not. found) then - if (present(defaultVal)) then; getFloats = defaultVal; else; call IO_error(140,ext_msg=key); endif - endif - if (present(requiredSize)) then - if(requiredSize /= size(getFloats)) call IO_error(146,ext_msg=key) - endif - -end function getFloats - - -!-------------------------------------------------------------------------------------------------- -!> @brief gets array of integer values of for a given key from a linked list -!> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all -!! values from the last occurrence. If key is not found exits with error unless default is given. -!-------------------------------------------------------------------------------------------------- -function getInts(this,key,defaultVal,requiredSize) - - integer, dimension(:), allocatable :: getInts - class(tPartitionedStringList), target, intent(in) :: this - character(len=*), intent(in) :: key - integer, dimension(:), intent(in), optional :: defaultVal - integer, intent(in), optional :: requiredSize - type(tPartitionedStringList), pointer :: item - integer :: i - logical :: found, & - cumulative - - cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') - found = .false. - - allocate(getInts(0)) - - item => this - do while (associated(item%next)) - if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then - found = .true. - if (.not. cumulative) getInts = [integer::] - if (item%string%pos(1) < 2) call IO_error(143,ext_msg=key) - do i = 2, item%string%pos(1) - getInts = [getInts,IO_IntValue(item%string%val,item%string%pos,i)] - enddo - endif - item => item%next - enddo - - if (.not. found) then - if (present(defaultVal)) then; getInts = defaultVal; else; call IO_error(140,ext_msg=key); endif - endif - if (present(requiredSize)) then - if(requiredSize /= size(getInts)) call IO_error(146,ext_msg=key) - endif - -end function getInts - - -!-------------------------------------------------------------------------------------------------- -!> @brief gets array of string values of for a given key from a linked list -!> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all -!! values from the last occurrence. If key is not found exits with error unless default is given. -!! If raw is true, the the complete string is returned, otherwise the individual chunks are returned -!-------------------------------------------------------------------------------------------------- -function getStrings(this,key,defaultVal,raw) - - character(len=pStringLen),dimension(:), allocatable :: getStrings - class(tPartitionedStringList),target, intent(in) :: this - character(len=*), intent(in) :: key - character(len=*), dimension(:), intent(in), optional :: defaultVal - logical, intent(in), optional :: raw - type(tPartitionedStringList), pointer :: item - character(len=pStringLen) :: str - integer :: i - logical :: found, & - whole, & - cumulative - - cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') - if (present(raw)) then - whole = raw - else - whole = .false. - endif - found = .false. - - item => this - do while (associated(item%next)) - if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then - found = .true. - if (allocated(getStrings) .and. .not. cumulative) deallocate(getStrings) - if (item%string%pos(1) < 2) call IO_error(143,ext_msg=key) - - notAllocated: if (.not. allocated(getStrings)) then - if (whole) then - str = item%string%val(item%string%pos(4):) - getStrings = [str] - else - str = IO_StringValue(item%string%val,item%string%pos,2) - allocate(getStrings(1),source=str) - do i=3,item%string%pos(1) - str = IO_StringValue(item%string%val,item%string%pos,i) - getStrings = [getStrings,str] - enddo - endif - else notAllocated - if (whole) then - str = item%string%val(item%string%pos(4):) - getStrings = [getStrings,str] - else - do i=2,item%string%pos(1) - str = IO_StringValue(item%string%val,item%string%pos,i) - getStrings = [getStrings,str] - enddo - endif - endif notAllocated - endif - item => item%next - enddo - - if (.not. found) then - if (present(defaultVal)) then - if (len(defaultVal) > len(getStrings)) call IO_error(0,ext_msg='getStrings') - getStrings = defaultVal - else - call IO_error(140,ext_msg=key) - endif - endif - -end function getStrings - - -end module list