some more functions to parse material.config from memory

This commit is contained in:
Martin Diehl 2018-06-01 14:14:53 +02:00
parent cfefcaebb8
commit c8cec5a121
2 changed files with 293 additions and 104 deletions

View File

@ -1,93 +1,308 @@
module chained_list module chained_list
use prec 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()
contains
procedure :: add => add
procedure :: getRaw => getRaw
procedure :: getRaws => getRaws
procedure :: getFloat => getFloat
procedure :: getFloatArray => getFloatArray
procedure :: getInt => getInt
procedure :: getIntArray => getIntArray
procedure :: getStrings => getStrings
procedure :: keyExists => keyExists
end type tPartitionedStringList
contains
!--------------------------------------------------------------------------------------------------
!> @brief add element
!> @details adds raw string and start/end position of chunks in this string
!--------------------------------------------------------------------------------------------------
subroutine add(this,string,stringPos)
implicit none implicit none
class(tPartitionedStringList) :: this
type tPartitionedString type(tPartitionedStringList), pointer :: &
character(len=:), allocatable :: val new, &
integer(pInt), dimension(:), allocatable :: pos tmp
end type character(len=*), intent(in) :: string
integer(pInt), dimension(:), intent(in) :: stringPos
type, public :: tPartitionedStringList
type(tPartitionedString) :: string
type(tPartitionedStringList), pointer :: next => null()
contains
procedure :: add => add
procedure :: getFloat => getFloat
procedure :: getFloatArray => getFloatArray
procedure :: getStrings => getStrings
procedure :: keyExists => keyExists
end type tPartitionedStringList
contains allocate(new)
subroutine add(self,string,stringPos) new%string%val=string
implicit none new%string%pos=stringPos
class(tPartitionedStringList) :: self
type(tPartitionedStringList), pointer :: new,tmp
character(len=*), intent(in) :: string
integer(pInt), dimension(:), intent(in) :: stringPos
allocate(new) if (.not. associated(this%next)) then
this%next => new
else
tmp => this%next
this%next => new
this%next%next => tmp
end if
new%string%val=string end subroutine add
new%string%pos=stringPos
if (.not. associated(self%next)) then
self%next => new
else
tmp => self%next
self%next => new
self%next%next => tmp
end if
end subroutine add
! gets float value, if key is not found exits with error unless default is given !--------------------------------------------------------------------------------------------------
function getFloat(self,key,default) !> @brief gets raw data
use IO !> @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 implicit none
real(pReal) :: getFloat 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
class(tPartitionedStringList), intent(in) :: self tmp => this%next
character(len=*), intent(in) :: key do
real(pReal), intent(in), optional :: default if (.not. associated(tmp)) call IO_error(1_pInt,ext_msg=key)
type(tPartitionedStringList), pointer :: tmp 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
tmp => self%next
do !--------------------------------------------------------------------------------------------------
if (.not. associated(tmp)) then !> @brief gets raw data
if(present(default)) then !> @details returns raw string and start/end position of chunks in this string
getFloat = default !--------------------------------------------------------------------------------------------------
exit subroutine getRaws(this,key,string,stringPos)
else use IO, only: &
call IO_error(1_pInt,ext_msg=key) IO_error, &
endif IO_stringValue
endif
if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then implicit none
if (tmp%string%pos(1) > 2) call IO_error(1_pInt,ext_msg=key) class(tPartitionedStringList), intent(in) :: this
getFloat = IO_FloatValue(tmp%string%val,tmp%string%pos,2) character(len=*), intent(in) :: key
exit integer(pInt), dimension(:,:),allocatable, intent(out) :: stringPos
endif character(len=256), dimension(:),allocatable, intent(out) :: string
tmp => tmp%next character(len=256) :: stringTmp
end do integer(pInt) :: posSize
end function 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 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 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 ! reports wether a key exists at least once
function keyExists(self,key) function keyExists(this,key)
use IO use IO
implicit none implicit none
logical :: keyExists logical :: keyExists
class(tPartitionedStringList), intent(in) :: self class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key character(len=*), intent(in) :: key
type(tPartitionedStringList), pointer :: tmp type(tPartitionedStringList), pointer :: tmp
keyExists = .false. keyExists = .false.
tmp => self%next tmp => this%next
do do
if (.not. associated(tmp)) exit if (.not. associated(tmp)) exit
if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then
@ -98,46 +313,20 @@ module chained_list
end do end do
end function end function
function getFloatArray(self,key)
use IO
implicit none function getStrings(this,key)
real(pReal),dimension(:),allocatable :: getFloatArray
class(tPartitionedStringList), intent(in) :: self
character(len=*), intent(in) :: key
type(tPartitionedStringList), pointer :: tmp
integer(pInt) :: i
allocate(getFloatArray(0))
tmp => self%next
do
if (.not. associated(tmp)) exit
if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then
do i = 2_pInt, tmp%string%pos(1)
getFloatArray = [getFloatArray,IO_FloatValue(tmp%string%val,tmp%string%pos,i)]
enddo
exit
endif
tmp => tmp%next
end do
end function
function getStrings(self,key)
use IO use IO
implicit none implicit none
character(len=64),dimension(:),allocatable :: getStrings character(len=64),dimension(:),allocatable :: getStrings
character(len=64) :: str character(len=64) :: str
class(tPartitionedStringList), intent(in) :: self class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key character(len=*), intent(in) :: key
type(tPartitionedStringList), pointer :: tmp type(tPartitionedStringList), pointer :: tmp
integer(pInt) :: i integer(pInt) :: i
tmp => self%next tmp => this%next
do do
if (.not. associated(tmp)) exit if (.not. associated(tmp)) exit
if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then

View File

@ -150,14 +150,14 @@ use IO
p%n = phaseConfig(phase)%getFloat('n') p%n = phaseConfig(phase)%getFloat('n')
p%h0 = phaseConfig(phase)%getFloat('h0') p%h0 = phaseConfig(phase)%getFloat('h0')
p%fTaylor = phaseConfig(phase)%getFloat('taylorfactor') p%fTaylor = phaseConfig(phase)%getFloat('taylorfactor')
p%h0_slopeLnRate = phaseConfig(phase)%getFloat('h0_slopelnrate', default=0.0_pReal) ! ToDo: alias allowed? p%h0_slopeLnRate = phaseConfig(phase)%getFloat('h0_slopelnrate', defaultVal=0.0_pReal) ! ToDo: alias allowed?
p%tausat_SinhFitA = phaseConfig(phase)%getFloat('tausat_sinhfita',default=0.0_pReal) p%tausat_SinhFitA = phaseConfig(phase)%getFloat('tausat_sinhfita',defaultVal=0.0_pReal)
p%tausat_SinhFitB = phaseConfig(phase)%getFloat('tausat_sinhfitb',default=0.0_pReal) p%tausat_SinhFitB = phaseConfig(phase)%getFloat('tausat_sinhfitb',defaultVal=0.0_pReal)
p%tausat_SinhFitC = phaseConfig(phase)%getFloat('tausat_sinhfitc',default=0.0_pReal) p%tausat_SinhFitC = phaseConfig(phase)%getFloat('tausat_sinhfitc',defaultVal=0.0_pReal)
p%tausat_SinhFitD = phaseConfig(phase)%getFloat('tausat_sinhfitd',default=0.0_pReal) p%tausat_SinhFitD = phaseConfig(phase)%getFloat('tausat_sinhfitd',defaultVal=0.0_pReal)
p%a = phaseConfig(phase)%getFloat('a') ! ToDo: alias p%a = phaseConfig(phase)%getFloat('a') ! ToDo: alias
p%aTolFlowStress = phaseConfig(phase)%getFloat('atol_flowstress',default=1.0_pReal) p%aTolFlowStress = phaseConfig(phase)%getFloat('atol_flowstress',defaultVal=1.0_pReal)
p%aTolShear = phaseConfig(phase)%getFloat('atol_shear',default=1.0e-6_pReal) p%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal)
p%dilatation = phaseConfig(phase)%keyExists('/dilatation/') p%dilatation = phaseConfig(phase)%keyExists('/dilatation/')