From d02c74cdd6a94175ee16e3a6de0449898c90eeba Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Dec 2023 07:05:57 +0100 Subject: [PATCH 1/3] get flattened array from scalar or potentially ragged nested list rather special case, but handy for flexible definition of values per slip system --- src/YAML_types.f90 | 102 +++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 98 insertions(+), 4 deletions(-) diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index e9904e3c5..1433b62d3 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -10,6 +10,7 @@ module YAML_types use IO use prec + use misc implicit none(type,external) private @@ -93,7 +94,8 @@ module YAML_types tDict_get_list, & tDict_get_dict, & tDict_get_asReal, & - tDict_get_as1dReal, & + tDict_get_as1dReal_shape, & + tDict_get_as1dReal_size, & tDict_get_as2dReal, & tDict_get_asInt, & tDict_get_as1dInt, & @@ -106,7 +108,8 @@ module YAML_types generic :: get_list => tDict_get_list generic :: get_dict => tDict_get_dict generic :: get_asReal => tDict_get_asReal - generic :: get_as1dReal => tDict_get_as1dReal + generic :: get_as1dReal => tDict_get_as1dReal_size + generic :: get_as1dReal => tDict_get_as1dReal_shape generic :: get_as2dReal => tDict_get_as2dReal generic :: get_asInt => tDict_get_asInt generic :: get_as1dInt => tDict_get_as1dInt @@ -265,8 +268,47 @@ subroutine YAML_types_selfTest() .or. .not. d%contains('four') & ) error stop 'tDict_contains' + end block dict + dict_get_as1dReal_shape: block + type(tDict), pointer :: d + type(tList), pointer :: l_outer, l_inner + type(tScalar), pointer :: s1,s2,s3 + real(pREAL), dimension(5) :: a + + + allocate(s1) + allocate(s2) + allocate(s3) + s1 = '1.' + s2 = '2' + s3 = '3.0' + + allocate(l_inner) + call l_inner%append(s1) + call l_inner%append(s2) + + allocate(l_outer) + call l_outer%append(l_inner) + call l_outer%append(s3) + + allocate(d) + call d%set('list',l_outer) + call d%set('scalar',s1) + + a = d%get_as1dReal('list',requiredShape=[2,3]) + if (any(dNeq(a,real([1.0,2.0,3.0,3.0,3.0],pReal)))) & + error stop 'dict_get_as1dReal_shape list' + + if (any(dNeq(d%get_as1dReal('non-existing',a,[2,3]),a))) & + error stop 'dict_get_as1dReal_shape default' + + if (any(dNeq(d%get_as1dReal('scalar',requiredShape=[3,5,2]),misc_ones(10)))) & + error stop 'dict_get_as1dReal_shape scalar' + + end block dict_get_as1dReal_shape + end subroutine YAML_types_selfTest @@ -1146,7 +1188,7 @@ end function tDict_get_asReal !-------------------------------------------------------------------------------------------------- !> @brief Get list by key and convert to real array (1D). !-------------------------------------------------------------------------------------------------- -function tDict_get_as1dReal(self,k,defaultVal,requiredSize) result(nodeAs1dReal) +function tDict_get_as1dReal_size(self,k,defaultVal,requiredSize) result(nodeAs1dReal) class(tDict), intent(in) :: self character(len=*), intent(in) :: k @@ -1173,7 +1215,59 @@ function tDict_get_as1dReal(self,k,defaultVal,requiredSize) result(nodeAs1dReal) label2='required',ID2=requiredSize) end if -end function tDict_get_as1dReal +end function tDict_get_as1dReal_size + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get entry by key and convert to real array (1D). +!> @details Values will be broadcasted. A List content can be composed from mixture of scalar +!> or list entries. [2., [1., 3.]] with required shape [3, 2] gives [2., 2., 2., 1., 3.]. +!-------------------------------------------------------------------------------------------------- +function tDict_get_as1dReal_shape(self,k,defaultVal,requiredShape) result(nodeAs1dReal) + + class(tDict), intent(in) :: self + character(len=*), intent(in) :: k + real(pREAL), intent(in), dimension(:), optional :: defaultVal + integer, intent(in), dimension(:) :: requiredShape + real(pREAL), dimension(sum(requiredShape)) :: nodeAs1dReal + + type(tList), pointer :: list_outer, list_inner + class(tNode), pointer :: node_outer, node_inner + integer :: i + + + if (self%contains(k)) then + node_outer => self%get(k) + select type(node_outer) + class is(tScalar) + nodeAs1dReal = node_outer%asReal() + class is(tList) + list_outer => self%get_list(k) + do i = 1, size(requiredShape) + node_inner => list_outer%get(i) + select type(node_inner) + class is(tScalar) + nodeAs1dReal(sum(requiredShape(:i-1))+1:sum(requiredShape(:i))) = node_inner%asReal() + class is(tList) + list_inner => node_inner%asList() + if (size(list_inner%as1dReal()) /= requiredShape(i)) & + call IO_error(709,'entry "'//k//'" is not of length '//IO_intAsStr(requiredShape(i)),& + 'position',i) + nodeAs1dReal(sum(requiredShape(:i-1))+1:sum(requiredShape(:i))) = list_inner%as1dReal() + class default + call IO_error(706,'entry "'//k//'" is neither scalar nor list','position',i) + end select + end do + end select + elseif (present(defaultVal)) then + if (size(defaultVal) /= size(nodeAs1dReal)) & + call IO_error(709,'default values not of required shape') + nodeAs1dReal = defaultVal + else + call IO_error(143,ext_msg=k) + end if + +end function tDict_get_as1dReal_shape !-------------------------------------------------------------------------------------------------- From c6ecd6d977ebfede442febe27097026baf6c7fa9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Dec 2023 12:50:22 +0100 Subject: [PATCH 2/3] avoid internal compiler error for ifort/ifx --- src/YAML_types.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index 1433b62d3..d73778c77 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -271,6 +271,7 @@ subroutine YAML_types_selfTest() end block dict +#ifdef __GFORTRAN__ dict_get_as1dReal_shape: block type(tDict), pointer :: d type(tList), pointer :: l_outer, l_inner @@ -308,6 +309,7 @@ subroutine YAML_types_selfTest() error stop 'dict_get_as1dReal_shape scalar' end block dict_get_as1dReal_shape +#endif end subroutine YAML_types_selfTest From 1b60bc14e84062d24ebd83dc8fe7aef00e4d7f48 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Dec 2023 22:22:19 +0100 Subject: [PATCH 3/3] more flexibility for setting default values --- src/YAML_types.f90 | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index d73778c77..1db64eeeb 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -303,7 +303,11 @@ subroutine YAML_types_selfTest() error stop 'dict_get_as1dReal_shape list' if (any(dNeq(d%get_as1dReal('non-existing',a,[2,3]),a))) & - error stop 'dict_get_as1dReal_shape default' + error stop 'dict_get_as1dReal_shape default individual' + + a = real([42.0, 42.0, 5.0, 5.0, 5.0],pREAL) + if (any(dNeq(d%get_as1dReal('non-existing',[42._pREAL, 5._pREAL],[2,3]),a))) & + error stop 'dict_get_as1dReal_shape default group' if (any(dNeq(d%get_as1dReal('scalar',requiredShape=[3,5,2]),misc_ones(10)))) & error stop 'dict_get_as1dReal_shape scalar' @@ -1262,9 +1266,15 @@ function tDict_get_as1dReal_shape(self,k,defaultVal,requiredShape) result(nodeAs end do end select elseif (present(defaultVal)) then - if (size(defaultVal) /= size(nodeAs1dReal)) & + if (size(defaultVal) == size(nodeAs1dReal)) then + nodeAs1dReal = defaultVal + elseif (size(defaultVal) == size(requiredShape)) then + do i = 1, size(requiredShape) + nodeAs1dReal(sum(requiredShape(:i-1))+1:sum(requiredShape(:i))) = defaultVal(i) + end do + else call IO_error(709,'default values not of required shape') - nodeAs1dReal = defaultVal + end if else call IO_error(143,ext_msg=k) end if