Merge branch 'YAML-polishing' into 'development'

polishing

See merge request damask/DAMASK!506
This commit is contained in:
Sharan Roongta 2022-01-21 23:34:43 +00:00
commit fc7c165afb
1 changed files with 129 additions and 129 deletions

View File

@ -119,7 +119,7 @@ module YAML_types
type, extends(tNode), public :: tList
class(tItem), pointer :: first => null()
class(tItem), pointer :: first => NULL()
contains
procedure :: asFormattedString => tList_asFormattedString
@ -146,8 +146,8 @@ module YAML_types
type :: tItem
character(len=:), allocatable :: key
class(tNode), pointer :: node => null()
class(tItem), pointer :: next => null()
class(tNode), pointer :: node => NULL()
class(tItem), pointer :: next => NULL()
contains
final :: tItem_finalize
@ -223,22 +223,22 @@ subroutine selfTest
select type(s1)
class is(tScalar)
s1 = '2'
endselect
end select
select type(s2)
class is(tScalar)
s2 = '3'
endselect
end select
select type(s3)
class is(tScalar)
s3 = '4'
endselect
end select
select type(s4)
class is(tScalar)
s4 = '5'
endselect
end select
allocate(tList::l1)
@ -251,14 +251,14 @@ subroutine selfTest
if (any(dNeq(l1%as1dFloat(),[2.0_pReal,3.0_pReal]))) error stop 'tList_as1dFloat'
if (n%get_asInt(1) /= 2) error stop 'byIndex_asInt'
if (dNeq(n%get_asFloat(2),3.0_pReal)) error stop 'byIndex_asFloat'
endselect
end select
allocate(tList::l3)
select type(l3)
class is(tList)
call l3%append(s3)
call l3%append(s4)
endselect
end select
allocate(tList::l2)
select type(l2)
@ -334,9 +334,12 @@ function tNode_asScalar(self) result(scalar)
class(tNode), intent(in), target :: self
class(tScalar), pointer :: scalar
select type(self)
class is(tScalar)
scalar => self
class default
nullify(scalar)
end select
end function tNode_asScalar
@ -350,9 +353,12 @@ function tNode_asList(self) result(list)
class(tNode), intent(in), target :: self
class(tList), pointer :: list
select type(self)
class is(tList)
list => self
class default
nullify(list)
end select
end function tNode_asList
@ -366,9 +372,12 @@ function tNode_asDict(self) result(dict)
class(tNode), intent(in), target :: self
class(tDict), pointer :: dict
select type(self)
class is(tDict)
dict => self
class default
nullify(dict)
end select
end function tNode_asDict
@ -387,12 +396,13 @@ function tNode_get_byIndex(self,i) result(node)
class(tItem), pointer :: item
integer :: j
select type(self)
class is(tList)
self_ => self%asList()
class default
call IO_error(706,ext_msg='Expected list')
endselect
end select
item => self_%first
@ -411,15 +421,14 @@ end function tNode_get_byIndex
!--------------------------------------------------------------------------------------------------
function tNode_get_byIndex_asFloat(self,i) result(nodeAsFloat)
class(tNode), intent(in), target :: self
class(tNode), intent(in) :: self
integer, intent(in) :: i
real(pReal) :: nodeAsFloat
class(tNode), pointer :: node
type(tScalar), pointer :: scalar
node => self%get(i)
select type(node)
select type(node => self%get(i))
class is(tScalar)
scalar => node%asScalar()
nodeAsFloat = scalar%asFloat()
@ -435,15 +444,15 @@ end function tNode_get_byIndex_asFloat
!--------------------------------------------------------------------------------------------------
function tNode_get_byIndex_asInt(self,i) result(nodeAsInt)
class(tNode), intent(in), target :: self
class(tNode), intent(in) :: self
integer, intent(in) :: i
integer :: nodeAsInt
class(tNode), pointer :: node
type(tScalar), pointer :: scalar
node => self%get(i)
select type(node)
select type(node => self%get(i))
class is(tScalar)
scalar => node%asScalar()
nodeAsInt = scalar%asInt()
@ -459,21 +468,20 @@ end function tNode_get_byIndex_asInt
!--------------------------------------------------------------------------------------------------
function tNode_get_byIndex_asBool(self,i) result(nodeAsBool)
class(tNode), intent(in), target :: self
class(tNode), intent(in) :: self
integer, intent(in) :: i
logical :: nodeAsBool
class(tNode), pointer :: node
type(tScalar), pointer :: scalar
node => self%get(i)
select type(node)
select type(node => self%get(i))
class is(tScalar)
scalar => node%asScalar()
nodeAsBool = scalar%asBool()
class default
call IO_error(706,ext_msg='Expected scalar Boolean')
endselect
end select
end function tNode_get_byIndex_asBool
@ -483,21 +491,20 @@ end function tNode_get_byIndex_asBool
!--------------------------------------------------------------------------------------------------
function tNode_get_byIndex_asString(self,i) result(nodeAsString)
class(tNode), intent(in), target :: self
class(tNode), intent(in) :: self
integer, intent(in) :: i
character(len=:), allocatable :: nodeAsString
class(tNode), pointer :: node
type(tScalar), pointer :: scalar
node => self%get(i)
select type(node)
select type(node => self%get(i))
class is(tScalar)
scalar => node%asScalar()
nodeAsString = scalar%asString()
class default
call IO_error(706,ext_msg='Expected scalar string')
endselect
end select
end function tNode_get_byIndex_asString
@ -507,21 +514,20 @@ end function tNode_get_byIndex_asString
!--------------------------------------------------------------------------------------------------
function tNode_get_byIndex_as1dFloat(self,i) result(nodeAs1dFloat)
class(tNode), intent(in), target :: self
class(tNode), intent(in) :: self
integer, intent(in) :: i
real(pReal), dimension(:), allocatable :: nodeAs1dFloat
class(tNode), pointer :: node
class(tList), pointer :: list
node => self%get(i)
select type(node)
select type(node => self%get(i))
class is(tList)
list => node%asList()
nodeAs1dFloat = list%as1dFloat()
class default
call IO_error(706,ext_msg='Expected list of floats')
endselect
end select
end function tNode_get_byIndex_as1dFloat
@ -531,21 +537,20 @@ end function tNode_get_byIndex_as1dFloat
!--------------------------------------------------------------------------------------------------
function tNode_get_byIndex_as1dInt(self,i) result(nodeAs1dInt)
class(tNode), intent(in), target :: self
class(tNode), intent(in) :: self
integer, intent(in) :: i
integer, dimension(:), allocatable :: nodeAs1dInt
class(tNode), pointer :: node
class(tList), pointer :: list
node => self%get(i)
select type(node)
select type(node => self%get(i))
class is(tList)
list => node%asList()
nodeAs1dInt = list%as1dInt()
class default
call IO_error(706,ext_msg='Expected list of integers')
endselect
end select
end function tNode_get_byIndex_as1dInt
@ -555,21 +560,20 @@ end function tNode_get_byIndex_as1dInt
!--------------------------------------------------------------------------------------------------
function tNode_get_byIndex_as1dBool(self,i) result(nodeAs1dBool)
class(tNode), intent(in), target :: self
class(tNode), intent(in) :: self
integer, intent(in) :: i
logical, dimension(:), allocatable :: nodeAs1dBool
class(tNode), pointer :: node
class(tList), pointer :: list
node => self%get(i)
select type(node)
select type(node => self%get(i))
class is(tList)
list => node%asList()
nodeAs1dBool = list%as1dBool()
class default
call IO_error(706,ext_msg='Expected list of Booleans')
endselect
end select
end function tNode_get_byIndex_as1dBool
@ -579,21 +583,20 @@ end function tNode_get_byIndex_as1dBool
!--------------------------------------------------------------------------------------------------
function tNode_get_byIndex_as1dString(self,i) result(nodeAs1dString)
class(tNode), intent(in), target :: self
class(tNode), intent(in) :: self
integer, intent(in) :: i
character(len=:), allocatable, dimension(:) :: nodeAs1dString
class(tNode), pointer :: node
type(tList), pointer :: list
node => self%get(i)
select type(node)
select type(node => self%get(i))
class is(tList)
list => node%asList()
nodeAs1dString = list%as1dString()
class default
call IO_error(706,ext_msg='Expected list of strings')
endselect
end select
end function tNode_get_byIndex_as1dString
@ -611,16 +614,17 @@ function tNode_get_byIndex_asKey(self,i) result(key)
type(tDict), pointer :: dict
type(tItem), pointer :: item
select type(self)
class is(tDict)
dict => self%asDict()
item => dict%first
do j = 1, min(i,dict%length)-1
item => item%next
enddo
end do
class default
call IO_error(706,ext_msg='Expected dict')
endselect
end select
key = item%key
@ -638,6 +642,7 @@ function tNode_getKeys(self) result(keys)
character(len=pStringLen), dimension(:), allocatable :: temp
integer :: j, l
allocate(temp(self%length))
l = 0
do j = 1, self%length
@ -686,7 +691,7 @@ function tNode_contains(self,k) result(exists)
enddo
class default
call IO_error(706,ext_msg='Expected list or dict')
endselect
end select
end function tNode_contains
@ -714,7 +719,7 @@ function tNode_get_byKey(self,k,defaultVal) result(node)
self_ => self%asDict()
class default
call IO_error(706,ext_msg='Expected dict for key '//k)
endselect
end select
j = 1
item => self_%first
@ -741,23 +746,22 @@ end function tNode_get_byKey
!--------------------------------------------------------------------------------------------------
function tNode_get_byKey_asFloat(self,k,defaultVal) result(nodeAsFloat)
class(tNode), intent(in), target :: self
class(tNode), intent(in) :: self
character(len=*), intent(in) :: k
real(pReal), intent(in),optional :: defaultVal
real(pReal), intent(in), optional :: defaultVal
real(pReal) :: nodeAsFloat
class(tNode), pointer :: node
type(tScalar), pointer :: scalar
if (self%contains(k)) then
node => self%get(k)
select type(node)
select type(node => self%get(k))
class is(tScalar)
scalar => node%asScalar()
nodeAsFloat = scalar%asFloat()
class default
call IO_error(706,ext_msg='Expected scalar float for key '//k)
endselect
end select
elseif (present(defaultVal)) then
nodeAsFloat = defaultVal
else
@ -772,23 +776,22 @@ end function tNode_get_byKey_asFloat
!--------------------------------------------------------------------------------------------------
function tNode_get_byKey_asInt(self,k,defaultVal) result(nodeAsInt)
class(tNode), intent(in), target :: self
class(tNode), intent(in) :: self
character(len=*), intent(in) :: k
integer, intent(in),optional :: defaultVal
integer, intent(in), optional :: defaultVal
integer :: nodeAsInt
class(tNode), pointer :: node
type(tScalar), pointer :: scalar
if (self%contains(k)) then
node => self%get(k)
select type(node)
select type(node => self%get(k))
class is(tScalar)
scalar => node%asScalar()
nodeAsInt = scalar%asInt()
class default
call IO_error(706,ext_msg='Expected scalar integer for key '//k)
endselect
end select
elseif (present(defaultVal)) then
nodeAsInt = defaultVal
else
@ -803,23 +806,22 @@ end function tNode_get_byKey_asInt
!--------------------------------------------------------------------------------------------------
function tNode_get_byKey_asBool(self,k,defaultVal) result(nodeAsBool)
class(tNode), intent(in), target :: self
class(tNode), intent(in) :: self
character(len=*), intent(in) :: k
logical, intent(in),optional :: defaultVal
logical, intent(in), optional :: defaultVal
logical :: nodeAsBool
class(tNode), pointer :: node
type(tScalar), pointer :: scalar
if (self%contains(k)) then
node => self%get(k)
select type(node)
select type(node => self%get(k))
class is(tScalar)
scalar => node%asScalar()
nodeAsBool = scalar%asBool()
class default
call IO_error(706,ext_msg='Expected scalar Boolean for key '//k)
endselect
end select
elseif (present(defaultVal)) then
nodeAsBool = defaultVal
else
@ -834,23 +836,22 @@ end function tNode_get_byKey_asBool
!--------------------------------------------------------------------------------------------------
function tNode_get_byKey_asString(self,k,defaultVal) result(nodeAsString)
class(tNode), intent(in), target :: self
class(tNode), intent(in) :: self
character(len=*), intent(in) :: k
character(len=*), intent(in),optional :: defaultVal
character(len=*), intent(in), optional :: defaultVal
character(len=:), allocatable :: nodeAsString
class(tNode), pointer :: node
type(tScalar), pointer :: scalar
if (self%contains(k)) then
node => self%get(k)
select type(node)
select type(node => self%get(k))
class is(tScalar)
scalar => node%asScalar()
nodeAsString = scalar%asString()
class default
call IO_error(706,ext_msg='Expected scalar string for key '//k)
endselect
end select
elseif (present(defaultVal)) then
nodeAsString = defaultVal
else
@ -865,25 +866,24 @@ end function tNode_get_byKey_asString
!--------------------------------------------------------------------------------------------------
function tNode_get_byKey_as1dFloat(self,k,defaultVal,requiredSize) result(nodeAs1dFloat)
class(tNode), intent(in), target :: self
class(tNode), intent(in) :: self
character(len=*), intent(in) :: k
real(pReal), intent(in), dimension(:), optional :: defaultVal
integer, intent(in), optional :: requiredSize
real(pReal), dimension(:), allocatable :: nodeAs1dFloat
class(tNode), pointer :: node
type(tList), pointer :: list
if (self%contains(k)) then
node => self%get(k)
select type(node)
select type(node => self%get(k))
class is(tList)
list => node%asList()
nodeAs1dFloat = list%as1dFloat()
class default
call IO_error(706,ext_msg='Expected 1D float array for key '//k)
endselect
end select
elseif (present(defaultVal)) then
nodeAs1dFloat = defaultVal
else
@ -902,25 +902,24 @@ end function tNode_get_byKey_as1dFloat
!--------------------------------------------------------------------------------------------------
function tNode_get_byKey_as2dFloat(self,k,defaultVal,requiredShape) result(nodeAs2dFloat)
class(tNode), intent(in), target :: self
class(tNode), intent(in) :: self
character(len=*), intent(in) :: k
real(pReal), intent(in), dimension(:,:), optional :: defaultVal
integer, intent(in), dimension(2), optional :: requiredShape
real(pReal), dimension(:,:), allocatable :: nodeAs2dFloat
class(tNode), pointer :: node
type(tList), pointer :: rows
if(self%contains(k)) then
node => self%get(k)
select type(node)
select type(node => self%get(k))
class is(tList)
rows => node%asList()
nodeAs2dFloat = rows%as2dFloat()
class default
call IO_error(706,ext_msg='Expected 2D float array for key '//k)
endselect
end select
elseif(present(defaultVal)) then
nodeAs2dFloat = defaultVal
else
@ -939,24 +938,22 @@ end function tNode_get_byKey_as2dFloat
!--------------------------------------------------------------------------------------------------
function tNode_get_byKey_as1dInt(self,k,defaultVal,requiredSize) result(nodeAs1dInt)
class(tNode), intent(in), target :: self
class(tNode), intent(in) :: self
character(len=*), intent(in) :: k
integer, dimension(:), intent(in), optional :: defaultVal
integer, intent(in), optional :: requiredSize
integer, dimension(:), allocatable :: nodeAs1dInt
class(tNode), pointer :: node
type(tList), pointer :: list
if (self%contains(k)) then
node => self%get(k)
select type(node)
select type(node => self%get(k))
class is(tList)
list => node%asList()
nodeAs1dInt = list%as1dInt()
class default
call IO_error(706,ext_msg='Expected 1D integer array for key '//k)
endselect
end select
elseif (present(defaultVal)) then
nodeAs1dInt = defaultVal
else
@ -975,23 +972,22 @@ end function tNode_get_byKey_as1dInt
!--------------------------------------------------------------------------------------------------
function tNode_get_byKey_as1dBool(self,k,defaultVal) result(nodeAs1dBool)
class(tNode), intent(in), target :: self
class(tNode), intent(in) :: self
character(len=*), intent(in) :: k
logical, dimension(:), intent(in), optional :: defaultVal
logical, dimension(:), allocatable :: nodeAs1dBool
class(tNode), pointer :: node
type(tList), pointer :: list
if (self%contains(k)) then
node => self%get(k)
select type(node)
select type(node => self%get(k))
class is(tList)
list => node%asList()
nodeAs1dBool = list%as1dBool()
class default
call IO_error(706,ext_msg='Expected 1D Boolean array for key '//k)
endselect
end select
elseif (present(defaultVal)) then
nodeAs1dBool = defaultVal
else
@ -1006,23 +1002,22 @@ end function tNode_get_byKey_as1dBool
!--------------------------------------------------------------------------------------------------
function tNode_get_byKey_as1dString(self,k,defaultVal) result(nodeAs1dString)
class(tNode), intent(in), target :: self
class(tNode), intent(in) :: self
character(len=*), intent(in) :: k
character(len=*), intent(in), dimension(:), optional :: defaultVal
character(len=:), allocatable, dimension(:) :: nodeAs1dString
class(tNode), pointer :: node
type(tList), pointer :: list
if (self%contains(k)) then
node => self%get(k)
select type(node)
select type(node => self%get(k))
class is(tList)
list => node%asList()
nodeAs1dString = list%as1dString()
class default
call IO_error(706,ext_msg='Expected 1D string array for key '//k)
endselect
end select
elseif (present(defaultVal)) then
nodeAs1dString = defaultVal
else
@ -1047,7 +1042,7 @@ function output_as1dString(self) result(output) !ToDo: SR: Re
allocate(output(output_list%length))
do o = 1, output_list%length
output(o) = output_list%get_asString(o)
enddo
end do
end function output_as1dString
@ -1070,7 +1065,7 @@ function tNode_get_byKey_asIndex(self,key) result(keyIndex)
do while (associated(item%next) .and. item%key /= key)
item => item%next
keyIndex = keyIndex+1
enddo
end do
if (item%key /= key) call IO_error(140,ext_msg=key)
@ -1115,7 +1110,7 @@ recursive function tList_asFormattedString(self,indent) result(str)
if (i /= 1) str = str//repeat(' ',indent_)
str = str//'- '//item%node%asFormattedString(indent_+2)
item => item%next
enddo
end do
end function tList_asFormattedString
@ -1147,9 +1142,9 @@ recursive function tDict_asFormattedString(self,indent) result(str)
str = str//trim(item%key)//': '//item%node%asFormattedString(indent_+len_trim(item%key)+2)
class default
str = str//trim(item%key)//':'//IO_EOL//repeat(' ',indent_+2)//item%node%asFormattedString(indent_+2)
endselect
end select
item => item%next
enddo
end do
end function tDict_asFormattedString
@ -1218,13 +1213,14 @@ function tList_as1dFloat(self)
type(tItem), pointer :: item
type(tScalar), pointer :: scalar
allocate(tList_as1dFloat(self%length))
item => self%first
do i = 1, self%length
scalar => item%node%asScalar()
tList_as1dFloat(i) = scalar%asFloat()
item => item%next
enddo
end do
end function tList_as1dFloat
@ -1241,6 +1237,7 @@ function tList_as2dFloat(self)
class(tNode), pointer :: row
type(tList), pointer :: row_data
row => self%get(1)
row_data => row%asList()
allocate(tList_as2dFloat(self%length,row_data%length))
@ -1248,9 +1245,9 @@ function tList_as2dFloat(self)
do i=1,self%length
row => self%get(i)
row_data => row%asList()
if(row_data%length /= size(tList_as2dFloat,2)) call IO_error(709,ext_msg='Varying number of columns')
if (row_data%length /= size(tList_as2dFloat,2)) call IO_error(709,ext_msg='Varying number of columns')
tList_as2dFloat(i,:) = self%get_as1dFloat(i)
enddo
end do
end function tList_as2dFloat
@ -1267,13 +1264,14 @@ function tList_as1dInt(self)
type(tItem), pointer :: item
type(tScalar), pointer :: scalar
allocate(tList_as1dInt(self%length))
item => self%first
do i = 1, self%length
scalar => item%node%asScalar()
tList_as1dInt(i) = scalar%asInt()
item => item%next
enddo
end do
end function tList_as1dInt
@ -1290,13 +1288,14 @@ function tList_as1dBool(self)
type(tItem), pointer :: item
type(tScalar), pointer :: scalar
allocate(tList_as1dBool(self%length))
item => self%first
do i = 1, self%length
scalar => item%node%asScalar()
tList_as1dBool(i) = scalar%asBool()
item => item%next
enddo
end do
end function tList_as1dBool
@ -1313,13 +1312,14 @@ function tList_as1dString(self)
type(tItem), pointer :: item
type(tScalar), pointer :: scalar
len_max = 0
item => self%first
do i = 1, self%length
scalar => item%node%asScalar()
len_max = max(len_max, len_trim(scalar%asString()))
item => item%next
enddo
end do
allocate(character(len=len_max) :: tList_as1dString(self%length))
item => self%first