module chained_list use prec, only: & pReal, & pInt implicit none private type, private :: tPartitionedString character(len=:), allocatable :: val integer(pInt), dimension(:), allocatable :: pos end type tPartitionedString type, public :: tPartitionedStringList type(tPartitionedString) :: string type(tPartitionedStringList), pointer :: next => null() type(tPartitionedStringList), pointer :: prev => null() contains procedure :: add => add procedure :: show => show procedure :: getRaw => getRaw procedure :: getRaws => getRaws procedure :: getStringsRaw => getStringsRaw procedure :: getFloat => getFloat procedure :: getFloatArray => getFloatArray procedure :: getInt => getInt procedure :: getIntArray => getIntArray procedure :: getString => getString procedure :: getStrings => getStrings procedure :: keyExists => keyExists procedure :: countKeys => countKeys end type tPartitionedStringList type(tPartitionedStringList), public :: emptyList contains !-------------------------------------------------------------------------------------------------- !> @brief add element !> @details adds raw string and start/end position of chunks in this string !-------------------------------------------------------------------------------------------------- subroutine add(this,string,stringPos) implicit none class(tPartitionedStringList) :: this type(tPartitionedStringList), pointer :: & new, & tmp character(len=*), intent(in) :: string integer(pInt), dimension(:), intent(in) :: stringPos allocate(new) new%string%val=string new%string%pos=stringPos if (.not. associated(this%next)) then this%next => new else tmp => this%next this%next => new this%next%next => tmp end if end subroutine add !-------------------------------------------------------------------------------------------------- !> @brief add element !> @details adds raw string and start/end position of chunks in this string !-------------------------------------------------------------------------------------------------- subroutine show(this) implicit none class(tPartitionedStringList) :: this type(tPartitionedStringList), pointer :: tmp tmp => this%next do if (.not. associated(tmp)) exit write(6,*) trim(tmp%string%val) tmp => tmp%next end do end subroutine show !-------------------------------------------------------------------------------------------------- !> @brief gets raw data !> @details returns raw string and start/end position of chunks in this string !-------------------------------------------------------------------------------------------------- subroutine getRaw(this,key,string,stringPos) use IO, only : & IO_error, & IO_stringValue implicit none class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key integer(pInt), dimension(:),allocatable, intent(out) :: stringPos character(len=*), intent(out) :: string type(tPartitionedStringList), pointer :: tmp tmp => this%next do if (.not. associated(tmp)) call IO_error(1_pInt,ext_msg=key) foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then stringPos = tmp%string%pos string = tmp%string%val exit endif foundKey tmp => tmp%next end do end subroutine getRaw !-------------------------------------------------------------------------------------------------- !> @brief gets raw data !> @details returns raw string and start/end position of chunks in this string !-------------------------------------------------------------------------------------------------- subroutine getRaws(this,key,string,stringPos) use IO, only: & IO_error, & IO_stringValue implicit none class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key integer(pInt), dimension(:,:),allocatable, intent(out) :: stringPos character(len=256), dimension(:),allocatable, intent(out) :: string character(len=256) :: stringTmp integer(pInt) :: posSize integer(pInt), dimension(:),allocatable :: stringPosFlat type(tPartitionedStringList), pointer :: tmp posSize = -1_pInt tmp => this%next do if (.not. associated(tmp)) then if(posSize < 0_pInt) call IO_error(1_pInt,ext_msg=key) stringPos = reshape(stringPosFlat,[posSize,size(string)]) exit endif foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then if (posSize < 0_pInt) then posSize = size(tmp%string%pos) stringPosFlat = tmp%string%pos allocate(string(1)) string(1) = tmp%string%val else if (size(tmp%string%pos) /= posSize) call IO_error(1_pInt,ext_msg=key) stringPosFlat = [stringPosFlat,tmp%string%pos] stringTmp = tmp%string%val string = [string,stringTmp] endif endif foundKey tmp => tmp%next end do end subroutine getRaws !-------------------------------------------------------------------------------------------------- !> @brief gets raw data !> @details returns raw string and start/end position of chunks in this string !-------------------------------------------------------------------------------------------------- function getStringsRaw(this) use IO, only: & IO_error, & IO_stringValue implicit none class(tPartitionedStringList), intent(in) :: this character(len=256), dimension(:),allocatable :: getStringsRaw character(len=256) :: stringTmp type(tPartitionedStringList), pointer :: tmp tmp => this%next do if (.not. associated(tmp)) then if(size(getStringsRaw) < 0_pInt) call IO_error(1_pInt,ext_msg='getallraw empty list') exit endif stringTmp = tmp%string%val if (.not. allocated(getStringsRaw)) then allocate(getStringsRaw(1),source=stringTmp) else getStringsRaw = [getStringsRaw,stringTmp] endif tmp => tmp%next end do end function getStringsRaw !-------------------------------------------------------------------------------------------------- !> @brief gets float value for given key !> @details if key is not found exits with error unless default is given !-------------------------------------------------------------------------------------------------- real(pReal) function getFloat(this,key,defaultVal) use IO, only : & IO_error, & IO_stringValue, & IO_FloatValue implicit none class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key real(pReal), intent(in), optional :: defaultVal type(tPartitionedStringList), pointer :: tmp tmp => this%next do endOfList: if (.not. associated(tmp)) then if(present(defaultVal)) then getFloat = defaultVal exit else call IO_error(1_pInt,ext_msg=key) endif endif endOfList foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then if (tmp%string%pos(1) < 2_pInt) call IO_error(1_pInt,ext_msg=key) getFloat = IO_FloatValue(tmp%string%val,tmp%string%pos,2) exit endif foundKey tmp => tmp%next end do end function getFloat !-------------------------------------------------------------------------------------------------- !> @brief gets float value for given key !> @details if key is not found exits with error unless default is given !-------------------------------------------------------------------------------------------------- integer(pInt) function getInt(this,key,defaultVal) use IO, only: & IO_error, & IO_stringValue, & IO_IntValue implicit none class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key integer(pInt), intent(in), optional :: defaultVal type(tPartitionedStringList), pointer :: tmp tmp => this%next do endOfList: if (.not. associated(tmp)) then if(present(defaultVal)) then getInt = defaultVal exit else call IO_error(1_pInt,ext_msg=key) endif endif endOfList foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then if (tmp%string%pos(1) < 2_pInt) call IO_error(1_pInt,ext_msg=key) getInt = IO_IntValue(tmp%string%val,tmp%string%pos,2) exit endif foundKey tmp => tmp%next end do end function getInt !-------------------------------------------------------------------------------------------------- !> @brief gets string value for given key !> @details if key is not found exits with error unless default is given !-------------------------------------------------------------------------------------------------- character(len=64) function getString(this,key,defaultVal) use IO, only: & IO_error, & IO_stringValue implicit none class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key character(len=64), intent(in), optional :: defaultVal type(tPartitionedStringList), pointer :: tmp tmp => this%next do endOfList: if (.not. associated(tmp)) then if(present(defaultVal)) then getString = defaultVal exit else call IO_error(1_pInt,ext_msg=key) endif endif endOfList foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then if (tmp%string%pos(1) < 2_pInt) call IO_error(1_pInt,ext_msg=key) getString = IO_StringValue(tmp%string%val,tmp%string%pos,2) exit endif foundKey tmp => tmp%next end do end function getString !-------------------------------------------------------------------------------------------------- !> @brief gets array of int values for given key !> @details if key is not found exits with error unless default is given !-------------------------------------------------------------------------------------------------- function getIntArray(this,key,defaultVal) use IO, only: & IO_error, & IO_stringValue, & IO_IntValue implicit none integer(pInt), dimension(:), allocatable :: getIntArray class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key integer(pInt),dimension(:), intent(in), optional :: defaultVal type(tPartitionedStringList), pointer :: tmp integer(pInt) :: i allocate(getIntArray(0)) tmp => this%next do endOfList: if (.not. associated(tmp)) then if(present(defaultVal)) then getIntArray = defaultVal exit else call IO_error(1_pInt,ext_msg=key) endif endif endOfList foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then if (tmp%string%pos(1) < 2_pInt) call IO_error(1_pInt,ext_msg=key) do i = 2_pInt, tmp%string%pos(1) getIntArray = [getIntArray,IO_IntValue(tmp%string%val,tmp%string%pos,i)] enddo exit endif foundKey tmp => tmp%next end do end function getIntArray !-------------------------------------------------------------------------------------------------- !> @brief gets array of float values for given key !> @details if key is not found exits with error unless default is given !-------------------------------------------------------------------------------------------------- function getFloatArray(this,key,defaultVal) use IO, only: & IO_error, & IO_stringValue, & IO_FloatValue implicit none real(pReal), dimension(:), allocatable :: getFloatArray class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key real(pReal),dimension(:), intent(in), optional :: defaultVal type(tPartitionedStringList), pointer :: tmp integer(pInt) :: i allocate(getFloatArray(0)) tmp => this%next do endOfList: if (.not. associated(tmp)) then if(present(defaultVal)) then getFloatArray = defaultVal exit else call IO_error(1_pInt,ext_msg=key) endif endif endOfList foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then if (tmp%string%pos(1) < 2_pInt) call IO_error(1_pInt,ext_msg=key) do i = 2_pInt, tmp%string%pos(1) getFloatArray = [getFloatArray,IO_FloatValue(tmp%string%val,tmp%string%pos,i)] enddo exit endif foundKey tmp => tmp%next end do end function getFloatArray ! reports wether a key exists at least once function keyExists(this,key) use IO implicit none logical :: keyExists class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key type(tPartitionedStringList), pointer :: tmp keyExists = .false. tmp => this%next do if (.not. associated(tmp)) exit if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then keyExists = .true. exit endif tmp => tmp%next end do end function integer(pInt) function countKeys(this,key) use IO implicit none class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key type(tPartitionedStringList), pointer :: tmp integer(pInt) :: i countKeys = 0_pInt tmp => this%next do if (.not. associated(tmp)) exit if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then countKeys = countKeys + 1_pInt endif tmp => tmp%next end do end function function getStrings(this,key) use IO implicit none character(len=64),dimension(:),allocatable :: getStrings character(len=64) :: str class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key type(tPartitionedStringList), pointer :: tmp integer(pInt) :: i tmp => this%next do if (.not. associated(tmp)) then if (.not. allocated(getStrings)) allocate(getStrings(0),source=str) exit endif if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then if (tmp%string%pos(1) < 2) print*, "NOT WORKKING" str = IO_StringValue(tmp%string%val,tmp%string%pos,2) GfortranBug86033: if (.not. allocated(getStrings)) then allocate(getStrings(1),source=str) else GfortranBug86033 getStrings = [getStrings,str] endif GfortranBug86033 endif tmp => tmp%next end do end function ! subroutine free_all() ! implicit none ! ! type(node), pointer :: tmp ! ! do ! tmp => first ! ! if (associated(tmp) .eqv. .FALSE.) exit ! ! first => first%next ! deallocate(tmp) ! end do ! end subroutine free_all end module chained_list