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(tPartitionedStringList), pointer :: &
new, &
tmp
character(len=*), intent(in) :: string
integer(pInt), dimension(:), intent(in) :: stringPos
type tPartitionedString allocate(new)
character(len=:), allocatable :: val new%string%val=string
integer(pInt), dimension(:), allocatable :: pos new%string%pos=stringPos
end type
type, public :: tPartitionedStringList if (.not. associated(this%next)) then
type(tPartitionedString) :: string this%next => new
type(tPartitionedStringList), pointer :: next => null() else
contains tmp => this%next
procedure :: add => add this%next => new
procedure :: getFloat => getFloat this%next%next => tmp
procedure :: getFloatArray => getFloatArray end if
procedure :: getStrings => getStrings
procedure :: keyExists => keyExists end subroutine add
end type tPartitionedStringList
contains !--------------------------------------------------------------------------------------------------
subroutine add(self,string,stringPos) !> @brief gets raw data
implicit none !> @details returns raw string and start/end position of chunks in this string
class(tPartitionedStringList) :: self !--------------------------------------------------------------------------------------------------
type(tPartitionedStringList), pointer :: new,tmp subroutine getRaw(this,key,string,stringPos)
character(len=*), intent(in) :: string use IO, only : &
integer(pInt), dimension(:), intent(in) :: stringPos IO_error, &
IO_stringValue
allocate(new) 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
new%string%val=string tmp => this%next
new%string%pos=stringPos do
if (.not. associated(tmp)) call IO_error(1_pInt,ext_msg=key)
if (.not. associated(self%next)) then foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then
self%next => new stringPos = tmp%string%pos
else string = tmp%string%val
tmp => self%next exit
self%next => new endif foundKey
self%next%next => tmp tmp => tmp%next
end if end do
end subroutine getRaw
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 getRaws(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=256), dimension(:),allocatable, intent(out) :: string
character(len=256) :: stringTmp
integer(pInt) :: posSize
integer(pInt), dimension(:),allocatable :: stringPosFlat
type(tPartitionedStringList), pointer :: tmp
class(tPartitionedStringList), intent(in) :: self posSize = -1_pInt
character(len=*), intent(in) :: key tmp => this%next
real(pReal), intent(in), optional :: default do
type(tPartitionedStringList), pointer :: tmp 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
tmp => self%next
do !--------------------------------------------------------------------------------------------------
if (.not. associated(tmp)) then !> @brief gets float value for given key
if(present(default)) then !> @details if key is not found exits with error unless default is given
getFloat = default !--------------------------------------------------------------------------------------------------
exit real(pReal) function getFloat(this,key,defaultVal)
else use IO, only : &
call IO_error(1_pInt,ext_msg=key) IO_error, &
endif IO_stringValue, &
endif IO_FloatValue
if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then
if (tmp%string%pos(1) > 2) call IO_error(1_pInt,ext_msg=key) implicit none
getFloat = IO_FloatValue(tmp%string%val,tmp%string%pos,2) class(tPartitionedStringList), intent(in) :: this
exit character(len=*), intent(in) :: key
endif real(pReal), intent(in), optional :: defaultVal
tmp => tmp%next type(tPartitionedStringList), pointer :: tmp
end do
end function 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/')