diff --git a/cmake/Compiler-IntelLLVM.cmake b/cmake/Compiler-IntelLLVM.cmake index 5056c2b37..c6e6208b6 100644 --- a/cmake/Compiler-IntelLLVM.cmake +++ b/cmake/Compiler-IntelLLVM.cmake @@ -14,8 +14,8 @@ if (OPTIMIZATION STREQUAL "OFF" OR OPTIMIZATION STREQUAL "DEBUG") elseif (OPTIMIZATION STREQUAL "DEFENSIVE") set (OPTIMIZATION_FLAGS "-O2") elseif (OPTIMIZATION STREQUAL "AGGRESSIVE") - set (OPTIMIZATION_FLAGS "-ipo -O3 -fp-model fast=2 -xHost") - # -fast = -ipo, -O3, -no-prec-div, -static, -fp-model fast=2, and -xHost" + #set (OPTIMIZATION_FLAGS "-ipo -O3 -fp-model fast=2 -xHost") # ifx 2022.0 has problems with YAML types and IPO + set (OPTIMIZATION_FLAGS "-O3 -fp-model fast=2 -xHost") endif () # -assume std_mod_proc_name (included in -standard-semantics) causes problems if other modules diff --git a/src/Marc/DAMASK_Marc.f90 b/src/Marc/DAMASK_Marc.f90 index 7a4a24ee1..91a30ba6f 100644 --- a/src/Marc/DAMASK_Marc.f90 +++ b/src/Marc/DAMASK_Marc.f90 @@ -283,7 +283,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & outdatedByNewInc = .false., & !< needs description materialpoint_init_done = .false., & !< remember whether init has been done already debug_basic = .true. - class(tNode), pointer :: & + type(tList), pointer :: & debug_Marc ! pointer to Marc debug options if(debug_basic) then @@ -307,7 +307,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & if (.not. materialpoint_init_done) then materialpoint_init_done = .true. call materialpoint_initAll - debug_Marc => config_debug%get('Marc',defaultVal=emptyList) + debug_Marc => config_debug%get_list('Marc',defaultVal=emptyList) debug_basic = debug_Marc%contains('basic') endif diff --git a/src/Marc/discretization_Marc.f90 b/src/Marc/discretization_Marc.f90 index a0667d049..b3c412579 100644 --- a/src/Marc/discretization_Marc.f90 +++ b/src/Marc/discretization_Marc.f90 @@ -69,7 +69,7 @@ subroutine discretization_Marc_init real(pReal), dimension(:,:,:,:), allocatable :: & unscaledNormals - class(tNode), pointer :: & + type(tDict), pointer :: & num_commercialFEM @@ -78,7 +78,7 @@ subroutine discretization_Marc_init debug_e = config_debug%get_asInt('element',defaultVal=1) debug_i = config_debug%get_asInt('integrationpoint',defaultVal=1) - num_commercialFEM => config_numerics%get('commercialFEM',defaultVal = emptyDict) + num_commercialFEM => config_numerics%get_dict('commercialFEM',defaultVal = emptyDict) mesh_unitlength = num_commercialFEM%get_asFloat('unitlength',defaultVal=1.0_pReal) ! set physical extent of a length unit in mesh if (mesh_unitlength <= 0.0_pReal) call IO_error(301,'unitlength') diff --git a/src/Marc/materialpoint_Marc.f90 b/src/Marc/materialpoint_Marc.f90 index 72c718a87..03d6025b6 100644 --- a/src/Marc/materialpoint_Marc.f90 +++ b/src/Marc/materialpoint_Marc.f90 @@ -101,9 +101,10 @@ end subroutine materialpoint_initAll !-------------------------------------------------------------------------------------------------- subroutine materialpoint_init - class(tNode), pointer :: & + type(tList), pointer :: & debug_materialpoint + print'(/,1x,a)', '<<<+- materialpoint init -+>>>'; flush(IO_STDOUT) allocate(materialpoint_cs( 6,discretization_nIPs,discretization_Nelems), source= 0.0_pReal) @@ -113,7 +114,7 @@ subroutine materialpoint_init !------------------------------------------------------------------------------ ! read debug options - debug_materialpoint => config_debug%get('materialpoint',defaultVal=emptyList) + debug_materialpoint => config_debug%get_list('materialpoint',defaultVal=emptyList) debugmaterialpoint%basic = debug_materialpoint%contains('basic') debugmaterialpoint%extensive = debug_materialpoint%contains('extensive') debugmaterialpoint%selective = debug_materialpoint%contains('selective') diff --git a/src/YAML_parse.f90 b/src/YAML_parse.f90 index e7d64770d..a65d80fb3 100644 --- a/src/YAML_parse.f90 +++ b/src/YAML_parse.f90 @@ -17,7 +17,8 @@ module YAML_parse public :: & YAML_parse_init, & - YAML_parse_str + YAML_parse_str_asList, & + YAML_parse_str_asDict #ifdef FYAML interface @@ -53,16 +54,37 @@ end subroutine YAML_parse_init !-------------------------------------------------------------------------------------------------- -!> @brief Parse a YAML string into a a structure of nodes. +!> @brief Parse a YAML string with list as root into a a structure of nodes. !-------------------------------------------------------------------------------------------------- -function YAML_parse_str(str) result(node) +function YAML_parse_str_asList(str) result(list) character(len=*), intent(in) :: str - class (tNode), pointer :: node + type(tList), pointer :: list + + class(tNode), pointer :: node + node => parse_flow(to_flow(str)) + list => node%asList() -end function YAML_parse_str +end function YAML_parse_str_asList + + +!-------------------------------------------------------------------------------------------------- +!> @brief Parse a YAML string with dict as root into a a structure of nodes. +!-------------------------------------------------------------------------------------------------- +function YAML_parse_str_asDict(str) result(dict) + + character(len=*), intent(in) :: str + type(tDict), pointer :: dict + + class(tNode), pointer :: node + + + node => parse_flow(to_flow(str)) + dict => node%asDict() + +end function YAML_parse_str_asDict !-------------------------------------------------------------------------------------------------- @@ -72,9 +94,9 @@ end function YAML_parse_str recursive function parse_flow(YAML_flow) result(node) character(len=*), intent(in) :: YAML_flow !< YAML file in flow style - class (tNode), pointer :: node + class(tNode), pointer :: node - class (tNode), pointer :: & + class(tNode), pointer :: & myVal character(len=:), allocatable :: & flow_string, & diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index e9bdff88d..b7e98edbd 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -15,141 +15,112 @@ module YAML_types private type, abstract, public :: tNode - integer :: length = 0 + integer :: & + length = 0 contains - procedure(asFormattedString), deferred :: asFormattedString + procedure(asFormattedString), deferred :: & + asFormattedString procedure :: & - asScalar => tNode_asScalar - procedure :: & - asList => tNode_asList - procedure :: & - asDict => tNode_asDict - procedure :: & - tNode_get_byIndex => tNode_get_byIndex - procedure :: & - tNode_get_byIndex_asFloat => tNode_get_byIndex_asFloat - procedure :: & - tNode_get_byIndex_as1dFloat => tNode_get_byIndex_as1dFloat - procedure :: & - tNode_get_byIndex_asInt => tNode_get_byIndex_asInt - procedure :: & - tNode_get_byIndex_as1dInt => tNode_get_byIndex_as1dInt - procedure :: & - tNode_get_byIndex_asBool => tNode_get_byIndex_asBool - procedure :: & - tNode_get_byIndex_as1dBool => tNode_get_byIndex_as1dBool - procedure :: & - tNode_get_byIndex_asString => tNode_get_byIndex_asString - procedure :: & - tNode_get_byIndex_as1dString => tNode_get_byIndex_as1dString - procedure :: & - tNode_get_byKey => tNode_get_byKey - procedure :: & - tNode_get_byKey_asFloat => tNode_get_byKey_asFloat - procedure :: & - tNode_get_byKey_as1dFloat => tNode_get_byKey_as1dFloat - procedure :: & - tNode_get_byKey_asInt => tNode_get_byKey_asInt - procedure :: & - tNode_get_byKey_as1dInt => tNode_get_byKey_as1dInt - procedure :: & - tNode_get_byKey_asBool => tNode_get_byKey_asBool - procedure :: & - tNode_get_byKey_as1dBool => tNode_get_byKey_as1dBool - procedure :: & - tNode_get_byKey_asString => tNode_get_byKey_asString - procedure :: & - tNode_get_byKey_as1dString => tNode_get_byKey_as1dString - procedure :: & - getKey => tNode_get_byIndex_asKey - procedure :: & - Keys => tNode_getKeys - procedure :: & - getIndex => tNode_get_byKey_asIndex - procedure :: & - contains => tNode_contains - procedure :: & - get_as2dFloat => tNode_get_byKey_as2dFloat - - generic :: & - get => tNode_get_byIndex, & - tNode_get_byKey - generic :: & - get_asFloat => tNode_get_byIndex_asFloat, & - tNode_get_byKey_asFloat - generic :: & - get_as1dFloat => tNode_get_byIndex_as1dFloat, & - tNode_get_byKey_as1dFloat - generic :: & - get_asInt => tNode_get_byIndex_asInt, & - tNode_get_byKey_asInt - generic :: & - get_as1dInt => tNode_get_byIndex_as1dInt, & - tNode_get_byKey_as1dInt - generic :: & - get_asBool => tNode_get_byIndex_asBool, & - tNode_get_byKey_asBool - generic :: & - get_as1dBool => tNode_get_byIndex_as1dBool, & - tNode_get_byKey_as1dBool - generic :: & - get_asString => tNode_get_byIndex_asString, & - tNode_get_byKey_asString - generic :: & - get_as1dString => tNode_get_byIndex_as1dString, & - tNode_get_byKey_as1dString + asScalar => tNode_asScalar, & + asList => tNode_asList, & + asDict => tNode_asDict end type tNode - type, extends(tNode), public :: tScalar - - character(len=:), allocatable, private :: value - + character(len=:), allocatable, private :: & + value contains - procedure :: asFormattedString => tScalar_asFormattedString - procedure :: & - asFloat => tScalar_asFloat - procedure :: & - asInt => tScalar_asInt - procedure :: & - asBool => tScalar_asBool procedure :: & + asFormattedString => tScalar_asFormattedString, & + asFloat => tScalar_asFloat, & + asInt => tScalar_asInt, & + asBool => tScalar_asBool, & asString => tScalar_asString end type tScalar type, extends(tNode), public :: tList - - class(tItem), pointer :: first => NULL(), & - last => NULL() - + class(tItem), pointer :: & + first => NULL(), & + last => NULL() contains - procedure :: asFormattedString => tList_asFormattedString - procedure :: append => tList_append procedure :: & - as1dFloat => tList_as1dFloat - procedure :: & - as2dFloat => tList_as2dFloat - procedure :: & - as1dInt => tList_as1dInt - procedure :: & - as1dBool => tList_as1dBool - procedure :: & - as1dString => tList_as1dString + asFormattedString => tList_asFormattedString, & + append => tList_append, & + as1dFloat => tList_as1dFloat, & + as2dFloat => tList_as2dFloat, & + as1dInt => tList_as1dInt, & + as1dBool => tList_as1dBool, & + as1dString => tList_as1dString, & + contains => tList_contains, & + tList_get, & + tList_get_scalar, & + tList_get_list, & + tList_get_dict, & + tList_get_asFloat, & + tList_get_as1dFloat, & + tList_get_asInt, & + tList_get_as1dInt, & + tList_get_asBool, & + tList_get_as1dBool, & + tList_get_asString, & + tList_get_as1dString + generic :: get => tList_get + generic :: get_scalar => tList_get_scalar + generic :: get_list => tList_get_list + generic :: get_dict => tList_get_dict + generic :: get_asFloat => tList_get_asFloat + generic :: get_as1dFloat => tList_get_as1dFloat + generic :: get_asInt => tList_get_asInt + generic :: get_as1dInt => tList_get_as1dInt + generic :: get_asBool => tList_get_asBool + generic :: get_as1dBool => tList_get_as1dBool + generic :: get_asString => tList_get_asString + generic :: get_as1dString => tList_get_as1dString final :: tList_finalize end type tList type, extends(tList), public :: tDict contains - procedure :: asFormattedString => tDict_asFormattedString - procedure :: set => tDict_set - end type tDict + procedure :: & + asFormattedString => tDict_asFormattedString, & + set => tDict_set, & + index => tDict_index, & + key => tDict_key, & + keys => tDict_keys, & + contains => tDict_contains, & + tDict_get, & + tDict_get_scalar, & + tDict_get_list, & + tDict_get_dict, & + tDict_get_asFloat, & + tDict_get_as1dFloat, & + tDict_get_as2dFloat, & + tDict_get_asInt, & + tDict_get_as1dInt, & + tDict_get_asBool, & + tDict_get_as1dBool, & + tDict_get_asString, & + tDict_get_as1dString + generic :: get => tDict_get + generic :: get_scalar => tDict_get_scalar + generic :: get_list => tDict_get_list + generic :: get_dict => tDict_get_dict + generic :: get_asFloat => tDict_get_asFloat + generic :: get_as1dFloat => tDict_get_as1dFloat + generic :: get_as2dFloat => tDict_get_as2dFloat + generic :: get_asInt => tDict_get_asInt + generic :: get_as1dInt => tDict_get_as1dInt + generic :: get_asBool => tDict_get_asBool + generic :: get_as1dBool => tDict_get_as1dBool + generic :: get_asString => tDict_get_asString + generic :: get_as1dString => tDict_get_as1dString + end type tDict type, public :: tItem character(len=:), allocatable :: key class(tNode), pointer :: node => NULL() class(tItem), pointer :: next => NULL() - contains final :: tItem_finalize end type tItem @@ -161,11 +132,10 @@ module YAML_types abstract interface - recursive function asFormattedString(self,indent) + recursive function asFormattedString(self) import tNode character(len=:), allocatable :: asFormattedString class(tNode), intent(in), target :: self - integer, intent(in), optional :: indent end function asFormattedString end interface @@ -180,7 +150,9 @@ module YAML_types public :: & YAML_types_init, & +#ifdef __GFORTRAN__ output_as1dString, & !ToDo: Hack for GNU. Remove later +#endif assignment(=) contains @@ -192,7 +164,7 @@ subroutine YAML_types_init print'(/,1x,a)', '<<<+- YAML_types init -+>>>' - call selfTest + call selfTest() end subroutine YAML_types_init @@ -202,120 +174,85 @@ end subroutine YAML_types_init !-------------------------------------------------------------------------------------------------- subroutine selfTest - class(tNode), pointer :: s1,s2,s3,s4 - allocate(tScalar::s1) - allocate(tScalar::s2) - allocate(tScalar::s3) - allocate(tScalar::s4) - select type(s1) - class is(tScalar) - s1 = '1' - if (s1%asInt() /= 1) error stop 'tScalar_asInt' - if (dNeq(s1%asFloat(),1.0_pReal)) error stop 'tScalar_asFloat' - s1 = 'true' - if (.not. s1%asBool()) error stop 'tScalar_asBool' - if (s1%asString() /= 'true') error stop 'tScalar_asString' - end select + scalar: block + type(tScalar) :: s - block - class(tNode), pointer :: l1, l2, l3, n - real(pReal), allocatable, dimension(:,:) :: x + s = '1' + if (s%asInt() /= 1) error stop 'tScalar_asInt' + if (dNeq(s%asFloat(),1.0_pReal)) error stop 'tScalar_asFloat' + s = 'true' + if (.not. s%asBool()) error stop 'tScalar_asBool' + if (s%asString() /= 'true') error stop 'tScalar_asString' + if (s%asFormattedString() /= 'true') error stop 'tScalar_asFormattedString' - select type(s1) - class is(tScalar) - s1 = '2' - end select + end block scalar - select type(s2) - class is(tScalar) - s2 = '3' - end select + list: block + type(tList), pointer :: l + type(tScalar), pointer :: s1,s2 - select type(s3) - class is(tScalar) - s3 = '4' - end select + allocate(s1) + allocate(s2) + s1 = '1' + s2 = '2' + allocate(l) + call l%append(s1) + call l%append(s2) + if (any(l%as1dInt() /= [1,2])) error stop 'tList_as1dInt' + if (any(dNeq(l%as1dFloat(),real([1.0,2.0],pReal)))) error stop 'tList_as1dFloat' + s1 = 'true' + s2 = 'false' + if (any(l%as1dBool() .neqv. [.true.,.false.])) error stop 'tList_as1dBool' + if (any(l%as1dString() /= ['true ','false'])) error stop 'tList_as1dString' + if (l%asFormattedString() /= '[true, false]') error stop 'tScalar_asFormattedString' - select type(s4) - class is(tScalar) - s4 = '5' - end select + end block list + dict: block + type(tDict), pointer :: d + type(tList), pointer :: l + type(tScalar), pointer :: s1,s2,s3,s4 - allocate(tList::l1) - select type(l1) - class is(tList) - call l1%append(s1) - call l1%append(s2) - n => l1 - if (any(l1%as1dInt() /= [2,3])) error stop 'tList_as1dInt' - 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' - end select + allocate(s1) + allocate(s2) + s1 = '1' + s2 = '2' + allocate(l) + call l%append(s1) + call l%append(s2) - allocate(tList::l3) - select type(l3) - class is(tList) - call l3%append(s3) - call l3%append(s4) - end select + allocate(s3) + allocate(s4) + s3 = '3' + s4 = '4' + allocate(d) + call d%set('one-two',l) + call d%set('three',s3) + call d%set('four',s4) + if (d%asFormattedString() /= '{one-two: [1, 2], three: 3, four: 4}') & + error stop 'tDict_asFormattedString' + if (d%get_asInt('three') /= 3) error stop 'tDict_get_asInt' + if (any(d%get_as1dInt('one-two') /= [1,2])) error stop 'tDict_get_as1dInt' - allocate(tList::l2) - select type(l2) - class is(tList) - call l2%append(l1) - if(any(l2%get_as1dInt(1) /= [2,3])) error stop 'byIndex_as1dInt' - if(any(dNeq(l2%get_as1dFloat(1),[2.0_pReal,3.0_pReal]))) error stop 'byIndex_as1dFloat' - call l2%append(l3) - x = l2%as2dFloat() - if(dNeq(x(2,1),4.0_pReal)) error stop 'byKey_as2dFloat' - if(any(dNeq(pack(l2%as2dFloat(),.true.),& - [2.0_pReal,4.0_pReal,3.0_pReal,5.0_pReal]))) error stop 'byKey_as2dFloat' - n => l2 - end select - deallocate(n) - end block - - block - type(tList), target :: l1 - type(tScalar),pointer :: s3,s4 - class(tNode), pointer :: n - - allocate(tScalar::s1) - allocate(tScalar::s2) - s3 => s1%asScalar() - s4 => s2%asScalar() - s3 = 'true' - s4 = 'False' - - call l1%append(s1) - call l1%append(s2) - n => l1 - - if (any(l1%as1dBool() .neqv. [.true., .false.])) error stop 'tList_as1dBool' - if (any(l1%as1dString() /= ['true ','False'])) error stop 'tList_as1dString' - if (n%get_asBool(2)) error stop 'byIndex_asBool' - if (n%get_asString(1) /= 'true') error stop 'byIndex_asString' - end block + end block dict end subroutine selfTest !--------------------------------------------------------------------------------------------------- -!> @brief init from string +!> @brief Init from string. !--------------------------------------------------------------------------------------------------- type(tScalar) pure function tScalar_init__(value) character(len=*), intent(in) :: value - tScalar_init__%value =value + tScalar_init__%value = value end function tScalar_init__ !--------------------------------------------------------------------------------------------------- -!> @brief set value from string +!> @brief Set value from string. !--------------------------------------------------------------------------------------------------- elemental pure subroutine tScalar_assign__(self,value) @@ -328,7 +265,21 @@ end subroutine tScalar_assign__ !-------------------------------------------------------------------------------------------------- -!> @brief Type guard, guarantee scalar +!> @brief Format as string (YAML flow style). +!-------------------------------------------------------------------------------------------------- +recursive function tScalar_asFormattedString(self) result(str) + + class (tScalar), intent(in), target :: self + character(len=:), allocatable :: str + + + str = trim(self%value) + +end function tScalar_asFormattedString + + +!-------------------------------------------------------------------------------------------------- +!> @brief Type guard, guarantee scalar. !-------------------------------------------------------------------------------------------------- function tNode_asScalar(self) result(scalar) @@ -341,13 +292,14 @@ function tNode_asScalar(self) result(scalar) scalar => self class default nullify(scalar) + call IO_error(706,'"'//trim(self%asFormattedString())//'" is not a scalar') end select end function tNode_asScalar !-------------------------------------------------------------------------------------------------- -!> @brief Type guard, guarantee list +!> @brief Type guard, guarantee list. !-------------------------------------------------------------------------------------------------- function tNode_asList(self) result(list) @@ -360,13 +312,14 @@ function tNode_asList(self) result(list) list => self class default nullify(list) + call IO_error(706,'"'//trim(self%asFormattedString())//'" is not a list') end select end function tNode_asList !-------------------------------------------------------------------------------------------------- -!> @brief Type guard, guarantee dict +!> @brief Type guard, guarantee dict. !-------------------------------------------------------------------------------------------------- function tNode_asDict(self) result(dict) @@ -379,967 +332,92 @@ function tNode_asDict(self) result(dict) dict => self class default nullify(dict) + call IO_error(706,'"'//trim(self%asFormattedString())//'" is not a dict') end select end function tNode_asDict !-------------------------------------------------------------------------------------------------- -!> @brief Access by index -!-------------------------------------------------------------------------------------------------- -function tNode_get_byIndex(self,i) result(node) - - class(tNode), intent(in), target :: self - integer, intent(in) :: i - class(tNode), pointer :: node - - class(tList), pointer :: self_ - 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') - end select - - item => self_%first - - if (i < 1 .or. i > self_%length) call IO_error(150,ext_msg='tNode_get_byIndex') - - do j = 2,i - item => item%next - end do - node => item%node - -end function tNode_get_byIndex - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by index and convert to float -!-------------------------------------------------------------------------------------------------- -function tNode_get_byIndex_asFloat(self,i) result(nodeAsFloat) - - class(tNode), intent(in) :: self - integer, intent(in) :: i - real(pReal) :: nodeAsFloat - - type(tScalar), pointer :: scalar - - - select type(node => self%get(i)) - class is(tScalar) - scalar => node%asScalar() - nodeAsFloat = scalar%asFloat() - class default - call IO_error(706,ext_msg='Expected scalar float') - end select - -end function tNode_get_byIndex_asFloat - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by index and convert to int -!-------------------------------------------------------------------------------------------------- -function tNode_get_byIndex_asInt(self,i) result(nodeAsInt) - - class(tNode), intent(in) :: self - integer, intent(in) :: i - integer :: nodeAsInt - - class(tNode), pointer :: node - type(tScalar), pointer :: scalar - - - select type(node => self%get(i)) - class is(tScalar) - scalar => node%asScalar() - nodeAsInt = scalar%asInt() - class default - call IO_error(706,ext_msg='Expected scalar integer') - end select - -end function tNode_get_byIndex_asInt - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by index and convert to bool -!-------------------------------------------------------------------------------------------------- -function tNode_get_byIndex_asBool(self,i) result(nodeAsBool) - - class(tNode), intent(in) :: self - integer, intent(in) :: i - logical :: nodeAsBool - - type(tScalar), pointer :: scalar - - - 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') - end select - -end function tNode_get_byIndex_asBool - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by index and convert to string -!-------------------------------------------------------------------------------------------------- -function tNode_get_byIndex_asString(self,i) result(nodeAsString) - - class(tNode), intent(in) :: self - integer, intent(in) :: i - character(len=:), allocatable :: nodeAsString - - type(tScalar), pointer :: scalar - - - 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') - end select - -end function tNode_get_byIndex_asString - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by index and convert to float array (1D) -!-------------------------------------------------------------------------------------------------- -function tNode_get_byIndex_as1dFloat(self,i) result(nodeAs1dFloat) - - class(tNode), intent(in) :: self - integer, intent(in) :: i - real(pReal), dimension(:), allocatable :: nodeAs1dFloat - - class(tList), pointer :: list - - - 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') - end select - -end function tNode_get_byIndex_as1dFloat - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by index and convert to int array (1D) -!-------------------------------------------------------------------------------------------------- -function tNode_get_byIndex_as1dInt(self,i) result(nodeAs1dInt) - - class(tNode), intent(in) :: self - integer, intent(in) :: i - integer, dimension(:), allocatable :: nodeAs1dInt - - class(tList), pointer :: list - - - 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') - end select - -end function tNode_get_byIndex_as1dInt - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by index and convert to bool array (1D) -!-------------------------------------------------------------------------------------------------- -function tNode_get_byIndex_as1dBool(self,i) result(nodeAs1dBool) - - class(tNode), intent(in) :: self - integer, intent(in) :: i - logical, dimension(:), allocatable :: nodeAs1dBool - - class(tList), pointer :: list - - - 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') - end select - -end function tNode_get_byIndex_as1dBool - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by index and convert to string array (1D) -!-------------------------------------------------------------------------------------------------- -function tNode_get_byIndex_as1dString(self,i) result(nodeAs1dString) - - class(tNode), intent(in) :: self - integer, intent(in) :: i - character(len=:), allocatable, dimension(:) :: nodeAs1dString - - type(tList), pointer :: list - - - 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') - end select - -end function tNode_get_byIndex_as1dString - - -!-------------------------------------------------------------------------------------------------- -!> @brief Returns the key in a dictionary as a string -!-------------------------------------------------------------------------------------------------- -function tNode_get_byIndex_asKey(self,i) result(key) - - class(tNode), intent(in), target :: self - integer, intent(in) :: i - - character(len=:), allocatable :: key - integer :: j - 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 - end do - class default - call IO_error(706,ext_msg='Expected dict') - end select - - key = item%key - -end function tNode_get_byIndex_asKey - - -!-------------------------------------------------------------------------------------------------- -!> @brief Get all keys from a dictionary -!-------------------------------------------------------------------------------------------------- -function tNode_getKeys(self) result(keys) - - class(tNode), intent(in) :: self - character(len=:), dimension(:), allocatable :: keys - - character(len=pStringLen), dimension(:), allocatable :: temp - integer :: j, l - - - allocate(temp(self%length)) - l = 0 - do j = 1, self%length - temp(j) = self%getKey(j) - l = max(len_trim(temp(j)),l) - end do - - allocate(character(l)::keys(self%length)) - do j = 1, self%length - keys(j) = trim(temp(j)) - end do - -end function tNode_getKeys - - -!------------------------------------------------------------------------------------------------- -!> @brief Checks if a given key/item is present in the dict/list -!------------------------------------------------------------------------------------------------- -function tNode_contains(self,k) result(exists) - - class(tNode), intent(in), target :: self - character(len=*), intent(in) :: k - - logical :: exists - integer :: j - type(tList), pointer :: list - type(tDict), pointer :: dict - - exists = .false. - select type(self) - class is(tDict) - dict => self%asDict() - do j=1, dict%length - if (dict%getKey(j) == k) then - exists = .true. - return - end if - end do - class is(tList) - list => self%asList() - do j=1, list%length - if (list%get_asString(j) == k) then - exists = .true. - return - end if - end do - class default - call IO_error(706,ext_msg='Expected list or dict') - end select - -end function tNode_contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by key -!-------------------------------------------------------------------------------------------------- -function tNode_get_byKey(self,k,defaultVal) result(node) - - class(tNode), intent(in), target :: self - character(len=*), intent(in) :: k - class(tNode), intent(in),optional,target :: defaultVal - class(tNode), pointer :: node - - type(tDict), pointer :: self_ - type(tItem), pointer :: item - integer :: j - logical :: found - - found = present(defaultVal) - if (found) node => defaultVal - - select type(self) - class is(tDict) - self_ => self%asDict() - class default - call IO_error(706,ext_msg='Expected dict for key '//k) - end select - - j = 1 - item => self_%first - do while(j <= self_%length) - if (item%key == k) then - found = .true. - exit - end if - item => item%next - j = j + 1 - end do - - if (.not. found) then - call IO_error(143,ext_msg=k) - else - if (associated(item)) node => item%node - end if - -end function tNode_get_byKey - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by key and convert to float -!-------------------------------------------------------------------------------------------------- -function tNode_get_byKey_asFloat(self,k,defaultVal) result(nodeAsFloat) - - class(tNode), intent(in) :: self - character(len=*), intent(in) :: k - real(pReal), intent(in), optional :: defaultVal - real(pReal) :: nodeAsFloat - - type(tScalar), pointer :: scalar - - - if (self%contains(k)) then - 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) - end select - elseif (present(defaultVal)) then - nodeAsFloat = defaultVal - else - call IO_error(143,ext_msg=k) - end if - -end function tNode_get_byKey_asFloat - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by key and convert to int -!-------------------------------------------------------------------------------------------------- -function tNode_get_byKey_asInt(self,k,defaultVal) result(nodeAsInt) - - class(tNode), intent(in) :: self - character(len=*), intent(in) :: k - integer, intent(in), optional :: defaultVal - integer :: nodeAsInt - - type(tScalar), pointer :: scalar - - - if (self%contains(k)) then - 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) - end select - elseif (present(defaultVal)) then - nodeAsInt = defaultVal - else - call IO_error(143,ext_msg=k) - end if - -end function tNode_get_byKey_asInt - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by key and convert to bool -!-------------------------------------------------------------------------------------------------- -function tNode_get_byKey_asBool(self,k,defaultVal) result(nodeAsBool) - - class(tNode), intent(in) :: self - character(len=*), intent(in) :: k - logical, intent(in), optional :: defaultVal - logical :: nodeAsBool - - type(tScalar), pointer :: scalar - - - if (self%contains(k)) then - 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) - end select - elseif (present(defaultVal)) then - nodeAsBool = defaultVal - else - call IO_error(143,ext_msg=k) - end if - -end function tNode_get_byKey_asBool - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by key and convert to string -!-------------------------------------------------------------------------------------------------- -function tNode_get_byKey_asString(self,k,defaultVal) result(nodeAsString) - - class(tNode), intent(in) :: self - character(len=*), intent(in) :: k - character(len=*), intent(in), optional :: defaultVal - character(len=:), allocatable :: nodeAsString - - type(tScalar), pointer :: scalar - - - if (self%contains(k)) then - 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) - end select - elseif (present(defaultVal)) then - nodeAsString = defaultVal - else - call IO_error(143,ext_msg=k) - end if - -end function tNode_get_byKey_asString - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by key and convert to float array (1D) -!-------------------------------------------------------------------------------------------------- -function tNode_get_byKey_as1dFloat(self,k,defaultVal,requiredSize) result(nodeAs1dFloat) - - 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 - - type(tList), pointer :: list - - - if (self%contains(k)) then - 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) - end select - elseif (present(defaultVal)) then - nodeAs1dFloat = defaultVal - else - call IO_error(143,ext_msg=k) - end if - - if (present(requiredSize)) then - if (requiredSize /= size(nodeAs1dFloat)) call IO_error(146,ext_msg=k) - end if - -end function tNode_get_byKey_as1dFloat - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by key and convert to float array (2D) -!-------------------------------------------------------------------------------------------------- -function tNode_get_byKey_as2dFloat(self,k,defaultVal,requiredShape) result(nodeAs2dFloat) - - 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 - - type(tList), pointer :: rows - - - if(self%contains(k)) then - 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) - end select - elseif(present(defaultVal)) then - nodeAs2dFloat = defaultVal - else - call IO_error(143,ext_msg=k) - end if - - if (present(requiredShape)) then - if (any(requiredShape /= shape(nodeAs2dFloat))) call IO_error(146,ext_msg=k) - end if - -end function tNode_get_byKey_as2dFloat - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by key and convert to int array (1D) -!-------------------------------------------------------------------------------------------------- -function tNode_get_byKey_as1dInt(self,k,defaultVal,requiredSize) result(nodeAs1dInt) - - 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 - - type(tList), pointer :: list - - if (self%contains(k)) then - 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) - end select - elseif (present(defaultVal)) then - nodeAs1dInt = defaultVal - else - call IO_error(143,ext_msg=k) - end if - - if (present(requiredSize)) then - if (requiredSize /= size(nodeAs1dInt)) call IO_error(146,ext_msg=k) - end if - -end function tNode_get_byKey_as1dInt - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by key and convert to bool array (1D) -!-------------------------------------------------------------------------------------------------- -function tNode_get_byKey_as1dBool(self,k,defaultVal) result(nodeAs1dBool) - - class(tNode), intent(in) :: self - character(len=*), intent(in) :: k - logical, dimension(:), intent(in), optional :: defaultVal - logical, dimension(:), allocatable :: nodeAs1dBool - - type(tList), pointer :: list - - - if (self%contains(k)) then - 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) - end select - elseif (present(defaultVal)) then - nodeAs1dBool = defaultVal - else - call IO_error(143,ext_msg=k) - end if - -end function tNode_get_byKey_as1dBool - - -!-------------------------------------------------------------------------------------------------- -!> @brief Access by key and convert to string array (1D) -!-------------------------------------------------------------------------------------------------- -function tNode_get_byKey_as1dString(self,k,defaultVal) result(nodeAs1dString) - - class(tNode), intent(in) :: self - character(len=*), intent(in) :: k - character(len=*), intent(in), dimension(:), optional :: defaultVal - character(len=:), allocatable, dimension(:) :: nodeAs1dString - - type(tList), pointer :: list - - - if (self%contains(k)) then - 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) - end select - elseif (present(defaultVal)) then - nodeAs1dString = defaultVal - else - call IO_error(143,ext_msg=k) - end if - -end function tNode_get_byKey_as1dString - - -!-------------------------------------------------------------------------------------------------- -!> @brief Returns string output array (1D) (hack for GNU) -!-------------------------------------------------------------------------------------------------- -function output_as1dString(self) result(output) !ToDo: SR: Remove whenever GNU works - - class(tNode), pointer,intent(in) :: self - character(len=pStringLen), allocatable, dimension(:) :: output - - class(tNode), pointer :: output_list - integer :: o - - output_list => self%get('output',defaultVal=emptyList) - allocate(output(output_list%length)) - do o = 1, output_list%length - output(o) = output_list%get_asString(o) - end do - -end function output_as1dString - - -!-------------------------------------------------------------------------------------------------- -!> @brief Returns the index of a key in a dictionary -!-------------------------------------------------------------------------------------------------- -function tNode_get_byKey_asIndex(self,key) result(keyIndex) - - class(tNode), intent(in), target :: self - character(len=*), intent(in) :: key - - integer :: keyIndex - type(tDict), pointer :: dict - type(tItem), pointer :: item - - dict => self%asDict() - item => dict%first - keyIndex = 1 - do while (associated(item%next) .and. item%key /= key) - item => item%next - keyIndex = keyIndex+1 - end do - - if (item%key /= key) call IO_error(140,ext_msg=key) - -end function tNode_get_byKey_asIndex - - -!-------------------------------------------------------------------------------------------------- -!> @brief Scalar as string (YAML block style) -!-------------------------------------------------------------------------------------------------- -recursive function tScalar_asFormattedString(self,indent) - - character(len=:), allocatable :: tScalar_asFormattedString - class (tScalar), intent(in), target :: self - integer, intent(in), optional :: indent - - tScalar_asFormattedString = trim(self%value)//IO_EOL - -end function tScalar_asFormattedString - - -!-------------------------------------------------------------------------------------------------- -!> @brief List as string (YAML block style) -!-------------------------------------------------------------------------------------------------- -recursive function tList_asFormattedString(self,indent) result(str) - - class (tList),intent(in),target :: self - integer, intent(in),optional :: indent - - type (tItem), pointer :: item - character(len=:), allocatable :: str - integer :: i, indent_ - - str = '' - if (present(indent)) then - indent_ = indent - else - indent_ = 0 - end if - - item => self%first - do i = 1, self%length - if (i /= 1) str = str//repeat(' ',indent_) - str = str//'- '//item%node%asFormattedString(indent_+2) - item => item%next - end do - -end function tList_asFormattedString - - -!-------------------------------------------------------------------------------------------------- -!> @brief Dictionary as string (YAML block style) -!-------------------------------------------------------------------------------------------------- -recursive function tDict_asFormattedString(self,indent) result(str) - - class (tDict),intent(in),target :: self - integer, intent(in),optional :: indent - - type (tItem),pointer :: item - character(len=:), allocatable :: str - integer :: i, indent_ - - str = '' - if (present(indent)) then - indent_ = indent - else - indent_ = 0 - end if - - item => self%first - do i = 1, self%length - if (i /= 1) str = str//repeat(' ',indent_) - select type(node_1 =>item%node) - class is(tScalar) - 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) - end select - item => item%next - end do - -end function tDict_asFormattedString - - -!-------------------------------------------------------------------------------------------------- -!> @brief Convert to float +!> @brief Convert to float. !-------------------------------------------------------------------------------------------------- function tScalar_asFloat(self) class(tScalar), intent(in), target :: self real(pReal) :: tScalar_asFloat + tScalar_asFloat = IO_stringAsFloat(self%value) end function tScalar_asFloat !-------------------------------------------------------------------------------------------------- -!> @brief Convert to int +!> @brief Convert to int. !-------------------------------------------------------------------------------------------------- function tScalar_asInt(self) class(tScalar), intent(in), target :: self integer :: tScalar_asInt + tScalar_asInt = IO_stringAsInt(self%value) end function tScalar_asInt !-------------------------------------------------------------------------------------------------- -!> @brief Convert to bool +!> @brief Convert to bool. !-------------------------------------------------------------------------------------------------- function tScalar_asBool(self) class(tScalar), intent(in), target :: self logical :: tScalar_asBool + tScalar_asBool = IO_stringAsBool(self%value) end function tScalar_asBool !-------------------------------------------------------------------------------------------------- -!> @brief Convert to string +!> @brief Convert to string. !-------------------------------------------------------------------------------------------------- function tScalar_asString(self) class(tScalar), intent(in), target :: self character(len=:), allocatable :: tScalar_asString + tScalar_asString = self%value end function tScalar_asString !-------------------------------------------------------------------------------------------------- -!> @brief Convert to float array (1D) +!> @brief Format as string (YAML flow style). !-------------------------------------------------------------------------------------------------- -function tList_as1dFloat(self) +recursive function tList_asFormattedString(self) result(str) - class(tList), intent(in), target :: self - real(pReal), dimension(:), allocatable :: tList_as1dFloat + class(tList),intent(in),target :: self + type(tItem), pointer :: item + character(len=:), allocatable :: str integer :: i - type(tItem), pointer :: item - type(tScalar), pointer :: scalar - - allocate(tList_as1dFloat(self%length)) + str = '[' item => self%first - do i = 1, self%length - scalar => item%node%asScalar() - if (.not. associated(scalar)) call IO_error(711,ext_msg='float scalar') - tList_as1dFloat(i) = scalar%asFloat() + do i = 1, self%length -1 + str = str//item%node%asFormattedString()//', ' item => item%next end do + str = str//item%node%asFormattedString()//']' -end function tList_as1dFloat +end function tList_asFormattedString !-------------------------------------------------------------------------------------------------- -!> @brief Convert to float array (2D) -!-------------------------------------------------------------------------------------------------- -function tList_as2dFloat(self) - - class(tList), intent(in), target :: self - real(pReal), dimension(:,:), allocatable :: tList_as2dFloat - - integer :: i - 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)) - - do i=1,self%length - row => self%get(i) - row_data => row%asList() - if (.not. associated(row_data)) call IO_error(711,ext_msg='list of floats') - 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) - end do - -end function tList_as2dFloat - - -!-------------------------------------------------------------------------------------------------- -!> @brief Convert to int array (1D) -!-------------------------------------------------------------------------------------------------- -function tList_as1dInt(self) - - class(tList), intent(in), target :: self - integer, dimension(:), allocatable :: tList_as1dInt - - integer :: i - 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() - if (.not. associated(scalar)) call IO_error(711,ext_msg='int scalar') - tList_as1dInt(i) = scalar%asInt() - item => item%next - end do - -end function tList_as1dInt - - -!-------------------------------------------------------------------------------------------------- -!> @brief Convert to bool array (1D) -!-------------------------------------------------------------------------------------------------- -function tList_as1dBool(self) - - class(tList), intent(in), target :: self - logical, dimension(:), allocatable :: tList_as1dBool - - integer :: i - 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() - if (.not. associated(scalar)) call IO_error(711,ext_msg='bool scalar') - tList_as1dBool(i) = scalar%asBool() - item => item%next - end do - -end function tList_as1dBool - - -!-------------------------------------------------------------------------------------------------- -!> @brief Convert to string array (1D) -!-------------------------------------------------------------------------------------------------- -function tList_as1dString(self) - - class(tList), intent(in), target :: self - character(len=:), allocatable, dimension(:) :: tList_as1dString - - integer :: i,len_max - type(tItem), pointer :: item - type(tScalar), pointer :: scalar - - - len_max = 0 - item => self%first - do i = 1, self%length - scalar => item%node%asScalar() - if (.not. associated(scalar)) call IO_error(711,ext_msg='string scalar') - len_max = max(len_max, len_trim(scalar%asString())) - item => item%next - end do - - allocate(character(len=len_max) :: tList_as1dString(self%length)) - item => self%first - do i = 1, self%length - scalar => item%node%asScalar() - tList_as1dString(i) = scalar%asString() - item => item%next - end do - -end function tList_as1dString - - -!-------------------------------------------------------------------------------------------------- -!> @brief Append element +!> @brief Append element. !-------------------------------------------------------------------------------------------------- subroutine tList_append(self,node) @@ -1348,6 +426,7 @@ subroutine tList_append(self,node) type(tItem), pointer :: item + if (.not. associated(self%first)) then allocate(item) self%first => item @@ -1365,7 +444,427 @@ end subroutine tList_append !-------------------------------------------------------------------------------------------------- -!> @brief Set the value of a key (either replace or add new) +!> @brief Convert to float array (1D). +!-------------------------------------------------------------------------------------------------- +function tList_as1dFloat(self) + + class(tList), intent(in), target :: self + real(pReal), dimension(:), allocatable :: tList_as1dFloat + + integer :: i + 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 + end do + +end function tList_as1dFloat + + +!-------------------------------------------------------------------------------------------------- +!> @brief Convert to float array (2D). +!-------------------------------------------------------------------------------------------------- +function tList_as2dFloat(self) + + class(tList), intent(in), target :: self + real(pReal), dimension(:,:), allocatable :: tList_as2dFloat + + integer :: i + type(tList), pointer :: row_data + + + row_data => self%get_list(1) + allocate(tList_as2dFloat(self%length,row_data%length)) + + do i=1,self%length + row_data => self%get_list(i) + 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) + end do + +end function tList_as2dFloat + + +!-------------------------------------------------------------------------------------------------- +!> @brief Convert to int array (1D). +!-------------------------------------------------------------------------------------------------- +function tList_as1dInt(self) + + class(tList), intent(in), target :: self + integer, dimension(:), allocatable :: tList_as1dInt + + integer :: i + 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 + end do + +end function tList_as1dInt + + +!-------------------------------------------------------------------------------------------------- +!> @brief Convert to bool array (1D). +!-------------------------------------------------------------------------------------------------- +function tList_as1dBool(self) + + class(tList), intent(in), target :: self + logical, dimension(:), allocatable :: tList_as1dBool + + integer :: i + 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 + end do + +end function tList_as1dBool + + +!-------------------------------------------------------------------------------------------------- +!> @brief Convert to string array (1D). +!-------------------------------------------------------------------------------------------------- +function tList_as1dString(self) + + class(tList), intent(in), target :: self +#ifndef __GFORTRAN__ + character(len=:), allocatable, dimension(:) :: tList_as1dString +#else + character(len=pStringLen), allocatable, dimension(:) :: tList_as1dString +#endif + + integer :: j,len_max + type(tItem), pointer :: item + type(tScalar), pointer :: scalar + + +#ifndef __GFORTRAN__ + len_max = 0 + item => self%first + do j = 1, self%length + scalar => item%node%asScalar() + len_max = max(len_max, len_trim(scalar%asString())) + item => item%next + end do + + allocate(character(len=len_max) :: tList_as1dString(self%length)) +#else + allocate(tList_as1dString(self%length)) +#endif + item => self%first + do j = 1, self%length + scalar => item%node%asScalar() + tList_as1dString(j) = scalar%asString() + item => item%next + end do + +end function tList_as1dString + + +!------------------------------------------------------------------------------------------------- +!> @brief Check for existence of (string) value. +!------------------------------------------------------------------------------------------------- +function tList_contains(self,k) result(exists) + + class(tList), intent(in), target :: self + character(len=*), intent(in) :: k + logical :: exists + + integer :: j + type(tItem), pointer :: item + type(tScalar), pointer :: scalar + + + exists = .false. + item => self%first + do j = 1, self%length + scalar => item%node%asScalar() + if (scalar%value == k) then + exists = .true. + exit + endif + item => item%next + end do + +end function tList_contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get by index. +!-------------------------------------------------------------------------------------------------- +function tList_get(self,i) result(node) + + class(tList), intent(in), target :: self + integer, intent(in) :: i + class(tNode), pointer :: node + + class(tItem), pointer :: item + integer :: j + + + if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tList_get') + item => self%first + do j = 2,i + item => item%next + end do + node => item%node + +end function tList_get + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get scalar by index. +!-------------------------------------------------------------------------------------------------- +function tList_get_scalar(self,i) result(nodeAsScalar) + + class(tList), intent(in) :: self + integer, intent(in) :: i + type(tScalar), pointer :: nodeAsScalar + + class(tNode), pointer :: node + + + node => self%get(i) + nodeAsScalar => node%asScalar() + +end function tList_get_scalar + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get list by index. +!-------------------------------------------------------------------------------------------------- +function tList_get_list(self,i) result(nodeAsList) + + class(tList), intent(in) :: self + integer, intent(in) :: i + type(tList), pointer :: nodeAsList + + class(tNode), pointer :: node + + + node => self%get(i) + nodeAsList => node%asList() + +end function tList_get_list + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get dict by index. +!-------------------------------------------------------------------------------------------------- +function tList_get_dict(self,i) result(nodeAsDict) + + class(tList), intent(in) :: self + integer, intent(in) :: i + type(tDict), pointer :: nodeAsDict + + class(tNode), pointer :: node + + + node => self%get(i) + nodeAsDict => node%asDict() + +end function tList_get_dict + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get scalar by index and convert to float. +!-------------------------------------------------------------------------------------------------- +function tList_get_asFloat(self,i) result(nodeAsFloat) + + class(tList), intent(in) :: self + integer, intent(in) :: i + real(pReal) :: nodeAsFloat + + class(tScalar), pointer :: scalar + + + scalar => self%get_scalar(i) + nodeAsFloat = scalar%asFloat() + +end function tList_get_asFloat + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get list by index and convert to float array (1D). +!-------------------------------------------------------------------------------------------------- +function tList_get_as1dFloat(self,i) result(nodeAs1dFloat) + + class(tList), intent(in) :: self + integer, intent(in) :: i + real(pReal), dimension(:), allocatable :: nodeAs1dFloat + + class(tList), pointer :: list + + + list => self%get_list(i) + nodeAs1dFloat = list%as1dFloat() + +end function tList_get_as1dFloat + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get scalar by index and convert to int. +!-------------------------------------------------------------------------------------------------- +function tList_get_asInt(self,i) result(nodeAsInt) + + class(tList), intent(in) :: self + integer, intent(in) :: i + integer :: nodeAsInt + + class(tScalar), pointer :: scalar + + + scalar => self%get_scalar(i) + nodeAsInt = scalar%asInt() + +end function tList_get_asInt + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get list by index and convert to int array (1D). +!-------------------------------------------------------------------------------------------------- +function tList_get_as1dInt(self,i) result(nodeAs1dInt) + + class(tList), intent(in) :: self + integer, intent(in) :: i + integer, dimension(:), allocatable :: nodeAs1dInt + + class(tList), pointer :: list + + + list => self%get_list(i) + nodeAs1dInt = list%as1dInt() + +end function tList_get_as1dInt + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get scalar by index and convert to bool +!-------------------------------------------------------------------------------------------------- +function tList_get_asBool(self,i) result(nodeAsBool) + + class(tList), intent(in) :: self + integer, intent(in) :: i + logical :: nodeAsBool + + class(tScalar), pointer :: scalar + + + scalar => self%get_scalar(i) + nodeAsBool = scalar%asBool() + +end function tList_get_asBool + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get list by index and convert to bool array (1D). +!-------------------------------------------------------------------------------------------------- +function tList_get_as1dBool(self,i) result(nodeAs1dBool) + + class(tList), intent(in) :: self + integer, intent(in) :: i + logical, dimension(:), allocatable :: nodeAs1dBool + + class(tList), pointer :: list + + + list => self%get_list(i) + nodeAs1dBool = list%as1dBool() + +end function tList_get_as1dBool + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get scalar by index and convert to string. +!-------------------------------------------------------------------------------------------------- +function tList_get_asString(self,i) result(nodeAsString) + + class(tList), intent(in) :: self + integer, intent(in) :: i + character(len=:), allocatable :: nodeAsString + + class(tScalar), pointer :: scalar + + + scalar => self%get_scalar(i) + nodeAsString = scalar%asString() + +end function tList_get_asString + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get list by index and convert to string array (1D). +!-------------------------------------------------------------------------------------------------- +function tList_get_as1dString(self,i) result(nodeAs1dString) + + class(tList), intent(in) :: self + integer, intent(in) :: i + character(len=:), allocatable, dimension(:) :: nodeAs1dString + + type(tList), pointer :: list + + + list => self%get_list(i) + nodeAs1dString = list%as1dString() + +end function tList_get_as1dString + + +!-------------------------------------------------------------------------------------------------- +!> @brief Free associated memory. +!-------------------------------------------------------------------------------------------------- +recursive subroutine tList_finalize(self) + + type (tList),intent(inout) :: self + + deallocate(self%first) + +end subroutine tList_finalize + + +!-------------------------------------------------------------------------------------------------- +!> @brief Format as string (YAML flow style). +!-------------------------------------------------------------------------------------------------- +recursive function tDict_asFormattedString(self) result(str) + + class(tDict),intent(in),target :: self + + type(tItem),pointer :: item + character(len=:), allocatable :: str + integer :: i + + + str = '{' + item => self%first + do i = 1, self%length -1 + str = str//trim(item%key)//': '//item%node%asFormattedString()//', ' + item => item%next + end do + str = str//trim(item%key)//': '//item%node%asFormattedString()//'}' + +end function tDict_asFormattedString + + +!-------------------------------------------------------------------------------------------------- +!> @brief Set value (either replace or add new). !-------------------------------------------------------------------------------------------------- subroutine tDict_set(self,key,node) @@ -1375,6 +874,7 @@ subroutine tDict_set(self,key,node) type(tItem), pointer :: item + if (.not. associated(self%first)) then allocate(self%first) item => self%first @@ -1399,20 +899,462 @@ end subroutine tDict_set !-------------------------------------------------------------------------------------------------- -!> @brief empties lists and dicts and free associated memory -!> @details called when variable goes out of scope. +!> @brief Return the index of a key. !-------------------------------------------------------------------------------------------------- -recursive subroutine tList_finalize(self) +function tDict_index(self,key) result(keyIndex) - type (tList),intent(inout) :: self + class(tDict), intent(in), target :: self + character(len=*), intent(in) :: key - deallocate(self%first) + integer :: keyIndex + type(tItem), pointer :: item -end subroutine tList_finalize + + item => self%first + keyIndex = 1 + do while (associated(item%next) .and. item%key /= key) + item => item%next + keyIndex = keyIndex+1 + end do + + if (item%key /= key) call IO_error(140,ext_msg=key) + +end function tDict_index !-------------------------------------------------------------------------------------------------- -!> @brief empties nodes and frees associated memory +!> @brief Get key of given index. +!-------------------------------------------------------------------------------------------------- +function tDict_key(self,i) result(key) + + class(tDict), intent(in), target :: self + integer, intent(in) :: i + + character(len=:), allocatable :: key + integer :: j + type(tItem), pointer :: item + + + if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tDict_key') + item => self%first + do j = 1, i-1 + item => item%next + end do + + key = item%key + +end function tDict_key + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get all keys. +!-------------------------------------------------------------------------------------------------- +function tDict_keys(self) result(keys) + + class(tDict), intent(in) :: self + character(len=:), dimension(:), allocatable :: keys + + character(len=pStringLen), dimension(:), allocatable :: temp + integer :: j, l + + + allocate(temp(self%length)) + l = 0 + do j = 1, self%length + temp(j) = self%key(j) + l = max(len_trim(temp(j)),l) + end do + + allocate(character(l)::keys(self%length)) + do j = 1, self%length + keys(j) = trim(temp(j)) + end do + +end function tDict_keys + + +!------------------------------------------------------------------------------------------------- +!> @brief Check whether a given key is present. +!------------------------------------------------------------------------------------------------- +function tDict_contains(self,k) result(exists) + + class(tDict), intent(in), target :: self + character(len=*), intent(in) :: k + logical :: exists + + integer :: j + + + exists = .false. + do j=1, self%length + if (self%key(j) == k) then + exists = .true. + return + end if + end do + +end function tDict_contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get by key. +!-------------------------------------------------------------------------------------------------- +function tDict_get(self,k,defaultVal) result(node) + + class(tDict), intent(in), target :: self + character(len=*), intent(in) :: k + class(tNode), intent(in),optional,target :: defaultVal + class(tNode), pointer :: node + + type(tItem), pointer :: item + integer :: j + logical :: found + + + found = present(defaultVal) + if (found) node => defaultVal + + j = 1 + item => self%first + do while(j <= self%length) + if (item%key == k) then + found = .true. + exit + end if + item => item%next + j = j + 1 + end do + + if (.not. found) then + call IO_error(143,ext_msg=k) + else + if (associated(item)) node => item%node + end if + +end function tDict_get + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get scalar by key. +!-------------------------------------------------------------------------------------------------- +function tDict_get_scalar(self,k,defaultVal) result(nodeAsScalar) + + class(tDict), intent(in) :: self + character(len=*), intent(in) :: k + type(tScalar), intent(in), optional, target :: defaultVal + type(tScalar), pointer :: nodeAsScalar + + class(tNode), pointer :: node + + + node => self%get(k,defaultVal) + nodeAsScalar => node%asScalar() + +end function tDict_get_scalar + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get list by key. +!-------------------------------------------------------------------------------------------------- +function tDict_get_list(self,k,defaultVal) result(nodeAsList) + + class(tDict), intent(in) :: self + character(len=*), intent(in) :: k + type(tList), intent(in), optional, target :: defaultVal + type(tList), pointer :: nodeAsList + + class(tNode), pointer :: node + + + node => self%get(k,defaultVal) + nodeAsList => node%asList() + +end function tDict_get_list + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get dict by key. +!-------------------------------------------------------------------------------------------------- +function tDict_get_dict(self,k,defaultVal) result(nodeAsDict) + + class(tDict), intent(in) :: self + character(len=*), intent(in) :: k + type(tDict), intent(in), optional, target :: defaultVal + type(tDict), pointer :: nodeAsDict + + class(tNode), pointer :: node + + + node => self%get(k,defaultVal) + nodeAsDict => node%asDict() + +end function tDict_get_dict + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get scalar by key and convert to float. +!-------------------------------------------------------------------------------------------------- +function tDict_get_asFloat(self,k,defaultVal) result(nodeAsFloat) + + class(tDict), intent(in) :: self + character(len=*), intent(in) :: k + real(pReal), intent(in), optional :: defaultVal + real(pReal) :: nodeAsFloat + + type(tScalar), pointer :: scalar + + + if (self%contains(k)) then + scalar => self%get_scalar(k) + nodeAsFloat = scalar%asFloat() + elseif (present(defaultVal)) then + nodeAsFloat = defaultVal + else + call IO_error(143,ext_msg=k) + end if + +end function tDict_get_asFloat + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get list by key and convert to float array (1D). +!-------------------------------------------------------------------------------------------------- +function tDict_get_as1dFloat(self,k,defaultVal,requiredSize) result(nodeAs1dFloat) + + class(tDict), 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 + + type(tList), pointer :: list + + + if (self%contains(k)) then + list => self%get_list(k) + nodeAs1dFloat = list%as1dFloat() + elseif (present(defaultVal)) then + nodeAs1dFloat = defaultVal + else + call IO_error(143,ext_msg=k) + end if + + if (present(requiredSize)) then + if (requiredSize /= size(nodeAs1dFloat)) call IO_error(146,ext_msg=k) + end if + +end function tDict_get_as1dFloat + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get list of lists by key and convert to float array (2D). +!-------------------------------------------------------------------------------------------------- +function tDict_get_as2dFloat(self,k,defaultVal,requiredShape) result(nodeAs2dFloat) + + class(tDict), 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 + + type(tList), pointer :: list + + + if (self%contains(k)) then + list => self%get_list(k) + nodeAs2dFloat = list%as2dFloat() + elseif (present(defaultVal)) then + nodeAs2dFloat = defaultVal + else + call IO_error(143,ext_msg=k) + end if + + if (present(requiredShape)) then + if (any(requiredShape /= shape(nodeAs2dFloat))) call IO_error(146,ext_msg=k) + end if + +end function tDict_get_as2dFloat + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get scalar by key and convert to int. +!-------------------------------------------------------------------------------------------------- +function tDict_get_asInt(self,k,defaultVal) result(nodeAsInt) + + class(tDict), intent(in) :: self + character(len=*), intent(in) :: k + integer, intent(in), optional :: defaultVal + integer :: nodeAsInt + + type(tScalar), pointer :: scalar + + + if (self%contains(k)) then + scalar => self%get_scalar(k) + nodeAsInt = scalar%asInt() + elseif (present(defaultVal)) then + nodeAsInt = defaultVal + else + call IO_error(143,ext_msg=k) + end if + +end function tDict_get_asInt + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get list by key and convert to int array (1D). +!-------------------------------------------------------------------------------------------------- +function tDict_get_as1dInt(self,k,defaultVal,requiredSize) result(nodeAs1dInt) + + class(tDict), intent(in) :: self + character(len=*), intent(in) :: k + integer, dimension(:), intent(in), optional :: defaultVal + integer, intent(in), optional :: requiredSize + integer, dimension(:), allocatable :: nodeAs1dInt + + type(tList), pointer :: list + + + if (self%contains(k)) then + list => self%get_list(k) + nodeAs1dInt = list%as1dInt() + elseif (present(defaultVal)) then + nodeAs1dInt = defaultVal + else + call IO_error(143,ext_msg=k) + end if + + if (present(requiredSize)) then + if (requiredSize /= size(nodeAs1dInt)) call IO_error(146,ext_msg=k) + end if + +end function tDict_get_as1dInt + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get scalar by key and convert to bool. +!-------------------------------------------------------------------------------------------------- +function tDict_get_asBool(self,k,defaultVal) result(nodeAsBool) + + class(tDict), intent(in) :: self + character(len=*), intent(in) :: k + logical, intent(in), optional :: defaultVal + logical :: nodeAsBool + + type(tScalar), pointer :: scalar + + + if (self%contains(k)) then + scalar => self%get_scalar(k) + nodeAsBool = scalar%asBool() + elseif (present(defaultVal)) then + nodeAsBool = defaultVal + else + call IO_error(143,ext_msg=k) + end if + +end function tDict_get_asBool + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get list by key and convert to bool array (1D). +!-------------------------------------------------------------------------------------------------- +function tDict_get_as1dBool(self,k,defaultVal) result(nodeAs1dBool) + + class(tDict), intent(in) :: self + character(len=*), intent(in) :: k + logical, dimension(:), intent(in), optional :: defaultVal + logical, dimension(:), allocatable :: nodeAs1dBool + + type(tList), pointer :: list + + + if (self%contains(k)) then + list => self%get_list(k) + nodeAs1dBool = list%as1dBool() + elseif (present(defaultVal)) then + nodeAs1dBool = defaultVal + else + call IO_error(143,ext_msg=k) + end if + +end function tDict_get_as1dBool + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get scalar by key and convert to string. +!-------------------------------------------------------------------------------------------------- +function tDict_get_asString(self,k,defaultVal) result(nodeAsString) + + class(tDict), intent(in) :: self + character(len=*), intent(in) :: k + character(len=*), intent(in), optional :: defaultVal + character(len=:), allocatable :: nodeAsString + + type(tScalar), pointer :: scalar + + + if (self%contains(k)) then + scalar => self%get_scalar(k) + nodeAsString = scalar%asString() + elseif (present(defaultVal)) then + nodeAsString = defaultVal + else + call IO_error(143,ext_msg=k) + end if + +end function tDict_get_asString + + +!-------------------------------------------------------------------------------------------------- +!> @brief Get list by key and convert to string array (1D). +!-------------------------------------------------------------------------------------------------- +function tDict_get_as1dString(self,k,defaultVal) result(nodeAs1dString) + + class(tDict), intent(in) :: self + character(len=*), intent(in) :: k + character(len=*), intent(in), dimension(:), optional :: defaultVal + character(len=:), allocatable, dimension(:) :: nodeAs1dString + + type(tList), pointer :: list + + + if (self%contains(k)) then + list => self%get_list(k) + nodeAs1dString = list%as1dString() + elseif (present(defaultVal)) then + nodeAs1dString = defaultVal + else + call IO_error(143,ext_msg=k) + end if + +end function tDict_get_as1dString + + +#ifdef __GFORTRAN__ +!-------------------------------------------------------------------------------------------------- +!> @brief Returns string output array (1D) (hack for GNU). +!-------------------------------------------------------------------------------------------------- +function output_as1dString(self) result(output) + + class(tDict), pointer,intent(in) :: self + character(len=pStringLen), allocatable, dimension(:) :: output + + type(tList), pointer :: output_list + integer :: o + + output_list => self%get_list('output',defaultVal=emptyList) + allocate(output(output_list%length)) + do o = 1, output_list%length + output(o) = output_list%get_asString(o) + end do + +end function output_as1dString +#endif + + +!-------------------------------------------------------------------------------------------------- +!> @brief Free associated memory. !-------------------------------------------------------------------------------------------------- recursive subroutine tItem_finalize(self) diff --git a/src/config.f90 b/src/config.f90 index 5c31e3b25..7ab9c76f8 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -12,7 +12,7 @@ module config implicit none(type,external) private - class(tNode), pointer, public :: & + type(tDict), pointer, public :: & config_material, & config_numerics, & config_debug @@ -58,7 +58,7 @@ subroutine parse_material() end if call parallelization_bcast_str(fileContent) - config_material => YAML_parse_str(fileContent) + config_material => YAML_parse_str_asDict(fileContent) end subroutine parse_material @@ -88,7 +88,7 @@ subroutine parse_numerics() end if call parallelization_bcast_str(fileContent) - config_numerics => YAML_parse_str(fileContent) + config_numerics => YAML_parse_str_asDict(fileContent) end if @@ -120,7 +120,7 @@ subroutine parse_debug() end if call parallelization_bcast_str(fileContent) - config_debug => YAML_parse_str(fileContent) + config_debug => YAML_parse_str_asDict(fileContent) end if diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index 4395c1581..1b785ca3d 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -106,15 +106,21 @@ program DAMASK_grid external :: & quit - class (tNode), pointer :: & - num_grid, & + class(tNode), pointer :: & + tmp + type(tDict), pointer :: & config_load, & - load_steps, & + num_grid, & load_step, & solver, & step_bc, & step_mech, & step_discretization + type(tList), pointer :: & +#ifdef __INTEL_LLVM_COMPILER + tensor, & +#endif + load_steps character(len=:), allocatable :: & fileContent, fname @@ -130,7 +136,7 @@ program DAMASK_grid !------------------------------------------------------------------------------------------------- ! reading field paramters from numerics file and do sanity checks - num_grid => config_numerics%get('grid', defaultVal=emptyDict) + num_grid => config_numerics%get_dict('grid', defaultVal=emptyDict) stagItMax = num_grid%get_asInt('maxStaggeredIter',defaultVal=10) maxCutBack = num_grid%get_asInt('maxCutBack',defaultVal=3) @@ -147,8 +153,8 @@ program DAMASK_grid endif call parallelization_bcast_str(fileContent) - config_load => YAML_parse_str(fileContent) - solver => config_load%get('solver') + config_load => YAML_parse_str_asDict(fileContent) + solver => config_load%get_dict('solver') !-------------------------------------------------------------------------------------------------- ! assign mechanics solver depending on selected type @@ -202,34 +208,42 @@ program DAMASK_grid !-------------------------------------------------------------------------------------------------- - load_steps => config_load%get('loadstep') + load_steps => config_load%get_list('loadstep') allocate(loadCases(load_steps%length)) ! array of load cases do l = 1, load_steps%length - load_step => load_steps%get(l) - step_bc => load_step%get('boundary_conditions') - step_mech => step_bc%get('mechanical') + load_step => load_steps%get_dict(l) + step_bc => load_step%get_dict('boundary_conditions') + step_mech => step_bc%get_dict('mechanical') loadCases(l)%stress%myType='' readMech: do m = 1, step_mech%length - select case (step_mech%getKey(m)) + select case (step_mech%key(m)) case ('L','dot_F','F') ! assign values for the deformation BC matrix - loadCases(l)%deformation%myType = step_mech%getKey(m) - call getMaskedTensor(loadCases(l)%deformation%values,loadCases(l)%deformation%mask,step_mech%get(m)) + loadCases(l)%deformation%myType = step_mech%key(m) +#ifdef __INTEL_LLVM_COMPILER + tensor => step_mech%get_list(m) + call getMaskedTensor(loadCases(l)%deformation%values,loadCases(l)%deformation%mask,tensor) +#else + call getMaskedTensor(loadCases(l)%deformation%values,loadCases(l)%deformation%mask,step_mech%get_list(m)) +#endif case ('dot_P','P') - loadCases(l)%stress%myType = step_mech%getKey(m) - call getMaskedTensor(loadCases(l)%stress%values,loadCases(l)%stress%mask,step_mech%get(m)) + loadCases(l)%stress%myType = step_mech%key(m) +#ifdef __INTEL_LLVM_COMPILER + tensor => step_mech%get_list(m) + call getMaskedTensor(loadCases(l)%stress%values,loadCases(l)%stress%mask,tensor) +#else + call getMaskedTensor(loadCases(l)%stress%values,loadCases(l)%stress%mask,step_mech%get_list(m)) +#endif end select call loadCases(l)%rot%fromAxisAngle(step_mech%get_as1dFloat('R',defaultVal = real([0.0,0.0,1.0,0.0],pReal)),degrees=.true.) enddo readMech if (.not. allocated(loadCases(l)%deformation%myType)) call IO_error(error_ID=837,ext_msg = 'L/dot_F/F missing') - step_discretization => load_step%get('discretization') - if (.not. step_discretization%contains('t')) call IO_error(error_ID=837,ext_msg = 't missing') - if (.not. step_discretization%contains('N')) call IO_error(error_ID=837,ext_msg = 'N missing') - loadCases(l)%t = step_discretization%get_asFloat('t') - loadCases(l)%N = step_discretization%get_asInt ('N') - loadCases(l)%r = step_discretization%get_asFloat('r', defaultVal= 1.0_pReal) + step_discretization => load_step%get_dict('discretization') + loadCases(l)%t = step_discretization%get_asFloat('t') + loadCases(l)%N = step_discretization%get_asInt ('N') + loadCases(l)%r = step_discretization%get_asFloat('r',defaultVal= 1.0_pReal) loadCases(l)%f_restart = load_step%get_asInt('f_restart', defaultVal=huge(0)) if (load_step%get_asString('f_out',defaultVal='n/a') == 'none') then @@ -499,15 +513,15 @@ subroutine getMaskedTensor(values,mask,tensor) real(pReal), intent(out), dimension(3,3) :: values logical, intent(out), dimension(3,3) :: mask - class (tNode), pointer :: tensor + type(tList), pointer :: tensor - class (tNode), pointer :: row + type(tList), pointer :: row integer :: i,j values = 0.0_pReal do i = 1,3 - row => tensor%get(i) + row => tensor%get_list(i) do j = 1,3 mask(i,j) = row%get_asString(j) == 'x' if (.not. mask(i,j)) values(i,j) = row%get_asFloat(j) diff --git a/src/grid/grid_damage_spectral.f90 b/src/grid/grid_damage_spectral.f90 index 643f6a274..816cdd4b1 100644 --- a/src/grid/grid_damage_spectral.f90 +++ b/src/grid/grid_damage_spectral.f90 @@ -76,7 +76,7 @@ subroutine grid_damage_spectral_init() Vec :: uBound, lBound integer(MPI_INTEGER_KIND) :: err_MPI PetscErrorCode :: err_PETSc - class(tNode), pointer :: & + type(tDict), pointer :: & num_grid, & num_generic character(len=pStringLen) :: & @@ -89,12 +89,12 @@ subroutine grid_damage_spectral_init() !------------------------------------------------------------------------------------------------- ! read numerical parameters and do sanity checks - num_grid => config_numerics%get('grid',defaultVal=emptyDict) + num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict) num%itmax = num_grid%get_asInt ('itmax',defaultVal=250) num%eps_damage_atol = num_grid%get_asFloat ('eps_damage_atol',defaultVal=1.0e-2_pReal) num%eps_damage_rtol = num_grid%get_asFloat ('eps_damage_rtol',defaultVal=1.0e-6_pReal) - num_generic => config_numerics%get('generic',defaultVal=emptyDict) + num_generic => config_numerics%get_dict('generic',defaultVal=emptyDict) num%residualStiffness = num_generic%get_asFloat('residualStiffness', defaultVal=1.0e-6_pReal) if (num%residualStiffness < 0.0_pReal) call IO_error(301,ext_msg='residualStiffness') diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index 4bb705807..d9ce6273e 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -117,22 +117,24 @@ subroutine grid_mechanical_FEM_init u_current,u_lastInc PetscInt, dimension(0:worldsize-1) :: localK integer(HID_T) :: fileHandle, groupHandle - class(tNode), pointer :: & - num_grid, & + type(tDict), pointer :: & + num_grid + type(tList), pointer :: & debug_grid character(len=pStringLen) :: & extmsg = '' + print'(/,1x,a)', '<<<+- grid_mechanical_FEM init -+>>>'; flush(IO_STDOUT) !------------------------------------------------------------------------------------------------- ! debugging options - debug_grid => config_debug%get('grid',defaultVal=emptyList) + debug_grid => config_debug%get_list('grid',defaultVal=emptyList) debugRotation = debug_grid%contains('rotation') !------------------------------------------------------------------------------------------------- ! read numerical parameters and do sanity checks - num_grid => config_numerics%get('grid',defaultVal=emptyDict) + num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict) num%eps_div_atol = num_grid%get_asFloat('eps_div_atol', defaultVal=1.0e-4_pReal) num%eps_div_rtol = num_grid%get_asFloat('eps_div_rtol', defaultVal=5.0e-4_pReal) diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index dec677df8..bead280a7 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -118,12 +118,14 @@ subroutine grid_mechanical_spectral_basic_init #else integer :: fileUnit #endif - class (tNode), pointer :: & - num_grid, & + type(tDict), pointer :: & + num_grid + type(tList), pointer :: & debug_grid character(len=pStringLen) :: & extmsg = '' + print'(/,1x,a)', '<<<+- grid_mechanical_spectral_basic init -+>>>'; flush(IO_STDOUT) print'(/,1x,a)', 'P. Eisenlohr et al., International Journal of Plasticity 46:37–53, 2013' @@ -134,12 +136,12 @@ subroutine grid_mechanical_spectral_basic_init !------------------------------------------------------------------------------------------------- ! debugging options - debug_grid => config_debug%get('grid',defaultVal=emptyList) + debug_grid => config_debug%get_list('grid',defaultVal=emptyList) debugRotation = debug_grid%contains('rotation') !------------------------------------------------------------------------------------------------- ! read numerical parameters and do sanity checks - num_grid => config_numerics%get('grid',defaultVal=emptyDict) + num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict) num%update_gamma = num_grid%get_asBool ('update_gamma', defaultVal=.false.) num%eps_div_atol = num_grid%get_asFloat('eps_div_atol', defaultVal=1.0e-4_pReal) diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index d0d229c46..2b4ea364a 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -131,8 +131,9 @@ subroutine grid_mechanical_spectral_polarisation_init #else integer :: fileUnit #endif - class (tNode), pointer :: & - num_grid, & + type(tDict), pointer :: & + num_grid + type(tList), pointer :: & debug_grid character(len=pStringLen) :: & extmsg = '' @@ -144,12 +145,12 @@ subroutine grid_mechanical_spectral_polarisation_init !------------------------------------------------------------------------------------------------- ! debugging options - debug_grid => config_debug%get('grid',defaultVal=emptyList) + debug_grid => config_debug%get_list('grid',defaultVal=emptyList) debugRotation = debug_grid%contains('rotation') !------------------------------------------------------------------------------------------------- ! read numerical parameters and do sanity checks - num_grid => config_numerics%get('grid',defaultVal=emptyDict) + num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict) num%update_gamma = num_grid%get_asBool ('update_gamma', defaultVal=.false.) num%eps_div_atol = num_grid%get_asFloat('eps_div_atol', defaultVal=1.0e-4_pReal) diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 index 6192420df..29ae07769 100644 --- a/src/grid/grid_thermal_spectral.f90 +++ b/src/grid/grid_thermal_spectral.f90 @@ -78,7 +78,7 @@ subroutine grid_thermal_spectral_init() integer(MPI_INTEGER_KIND) :: err_MPI PetscErrorCode :: err_PETSc integer(HID_T) :: fileHandle, groupHandle - class(tNode), pointer :: & + type(tDict), pointer :: & num_grid print'(/,1x,a)', '<<<+- grid_thermal_spectral init -+>>>' @@ -88,7 +88,7 @@ subroutine grid_thermal_spectral_init() !------------------------------------------------------------------------------------------------- ! read numerical parameters and do sanity checks - num_grid => config_numerics%get('grid',defaultVal=emptyDict) + num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict) num%itmax = num_grid%get_asInt ('itmax', defaultVal=250) num%eps_thermal_atol = num_grid%get_asFloat ('eps_thermal_atol',defaultVal=1.0e-2_pReal) num%eps_thermal_rtol = num_grid%get_asFloat ('eps_thermal_rtol',defaultVal=1.0e-6_pReal) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 5359ac1cc..6cb7edd30 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -166,9 +166,11 @@ subroutine spectral_utilities_init() tensorSize = 9_C_INTPTR_T character(len=*), parameter :: & PETSCDEBUG = ' -snes_view -snes_monitor ' - class(tNode) , pointer :: & - num_grid, & - debug_grid ! pointer to grid debug options + type(tDict) , pointer :: & + num_grid + type(tList) , pointer :: & + debug_grid + print'(/,1x,a)', '<<<+- spectral_utilities init -+>>>' @@ -186,9 +188,9 @@ subroutine spectral_utilities_init() !-------------------------------------------------------------------------------------------------- ! set debugging parameters - num_grid => config_numerics%get('grid',defaultVal=emptyDict) + num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict) - debug_grid => config_debug%get('grid',defaultVal=emptyList) + debug_grid => config_debug%get_List('grid',defaultVal=emptyList) debugGeneral = debug_grid%contains('basic') debugRotation = debug_grid%contains('rotation') debugPETSc = debug_grid%contains('PETSc') diff --git a/src/homogenization.f90 b/src/homogenization.f90 index b1e462794..6f6270403 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -196,7 +196,7 @@ contains !-------------------------------------------------------------------------------------------------- subroutine homogenization_init() - class (tNode) , pointer :: & + type(tDict) , pointer :: & num_homog, & num_homogGeneric @@ -207,8 +207,8 @@ subroutine homogenization_init() allocate(damageState_h (size(material_name_homogenization))) call parseHomogenization() - num_homog => config_numerics%get('homogenization',defaultVal=emptyDict) - num_homogGeneric => num_homog%get('generic',defaultVal=emptyDict) + num_homog => config_numerics%get_dict('homogenization',defaultVal=emptyDict) + num_homogGeneric => num_homog%get_dict('generic',defaultVal=emptyDict) num%nMPstate = num_homogGeneric%get_asInt('nMPstate',defaultVal=10) if (num%nMPstate < 1) call IO_error(301,ext_msg='nMPstate') @@ -447,7 +447,7 @@ end subroutine homogenization_restartRead !-------------------------------------------------------------------------------------------------- subroutine parseHomogenization - class(tNode), pointer :: & + type(tDict), pointer :: & material_homogenization, & homog, & homogThermal, & @@ -455,17 +455,17 @@ subroutine parseHomogenization integer :: h - material_homogenization => config_material%get('homogenization') + material_homogenization => config_material%get_dict('homogenization') allocate(thermal_type(size(material_name_homogenization)),source=THERMAL_UNDEFINED_ID) allocate(thermal_active(size(material_name_homogenization)),source=.false.) allocate(damage_active(size(material_name_homogenization)),source=.false.) do h=1, size(material_name_homogenization) - homog => material_homogenization%get(h) + homog => material_homogenization%get_dict(h) if (homog%contains('thermal')) then - homogThermal => homog%get('thermal') + homogThermal => homog%get_dict('thermal') select case (homogThermal%get_asString('type')) case('pass') thermal_type(h) = THERMAL_PASS_ID @@ -479,7 +479,7 @@ subroutine parseHomogenization end if if (homog%contains('damage')) then - homogDamage => homog%get('damage') + homogDamage => homog%get_dict('damage') select case (homogDamage%get_asString('type')) case('pass') damage_active(h) = .true. diff --git a/src/homogenization_damage.f90 b/src/homogenization_damage.f90 index d370c1c5e..dd438b3c4 100644 --- a/src/homogenization_damage.f90 +++ b/src/homogenization_damage.f90 @@ -32,7 +32,7 @@ contains !-------------------------------------------------------------------------------------------------- module subroutine damage_init() - class(tNode), pointer :: & + type(tDict), pointer :: & configHomogenizations, & configHomogenization, & configHomogenizationDamage @@ -42,17 +42,17 @@ module subroutine damage_init() print'(/,1x,a)', '<<<+- homogenization:damage init -+>>>' - configHomogenizations => config_material%get('homogenization') + configHomogenizations => config_material%get_dict('homogenization') allocate(param(configHomogenizations%length)) allocate(current(configHomogenizations%length)) do ho = 1, configHomogenizations%length Nmembers = count(material_homogenizationID == ho) allocate(current(ho)%phi(Nmembers), source=1.0_pReal) - configHomogenization => configHomogenizations%get(ho) + configHomogenization => configHomogenizations%get_dict(ho) associate(prm => param(ho)) if (configHomogenization%contains('damage')) then - configHomogenizationDamage => configHomogenization%get('damage') + configHomogenizationDamage => configHomogenization%get_dict('damage') #if defined (__GFORTRAN__) prm%output = output_as1dString(configHomogenizationDamage) #else diff --git a/src/homogenization_mechanical.f90 b/src/homogenization_mechanical.f90 index b358e680d..5c93da7be 100644 --- a/src/homogenization_mechanical.f90 +++ b/src/homogenization_mechanical.f90 @@ -222,7 +222,7 @@ end subroutine mechanical_results !-------------------------------------------------------------------------------------------------- subroutine parseMechanical() - class(tNode), pointer :: & + type(tDict), pointer :: & material_homogenization, & homog, & mechanical @@ -230,14 +230,14 @@ subroutine parseMechanical() integer :: ho - material_homogenization => config_material%get('homogenization') + material_homogenization => config_material%get_dict('homogenization') allocate(mechanical_type(size(material_name_homogenization)), source=MECHANICAL_UNDEFINED_ID) allocate(output_mechanical(size(material_name_homogenization))) do ho=1, size(material_name_homogenization) - homog => material_homogenization%get(ho) - mechanical => homog%get('mechanical') + homog => material_homogenization%get_dict(ho) + mechanical => homog%get_dict('mechanical') #if defined(__GFORTRAN__) output_mechanical(ho)%label = output_as1dString(mechanical) #else diff --git a/src/homogenization_mechanical_RGC.f90 b/src/homogenization_mechanical_RGC.f90 index 8e8ae1df9..53b1ba350 100644 --- a/src/homogenization_mechanical_RGC.f90 +++ b/src/homogenization_mechanical_RGC.f90 @@ -78,7 +78,7 @@ module subroutine RGC_init() Nmembers, & sizeState, nIntFaceTot - class (tNode), pointer :: & + class(tDict), pointer :: & num_homogenization, & num_mechanical, & num_RGC, & ! pointer to RGC numerics data @@ -98,15 +98,15 @@ module subroutine RGC_init() print'( 1x,a)', 'https://doi.org/10.1088/0965-0393/18/1/015006'//IO_EOL - material_homogenization => config_material%get('homogenization') + material_homogenization => config_material%get_dict('homogenization') allocate(param(material_homogenization%length)) allocate(state(material_homogenization%length)) allocate(state0(material_homogenization%length)) allocate(dependentState(material_homogenization%length)) - num_homogenization => config_numerics%get('homogenization',defaultVal=emptyDict) - num_mechanical => num_homogenization%get('mechanical',defaultVal=emptyDict) - num_RGC => num_mechanical%get('RGC',defaultVal=emptyDict) + num_homogenization => config_numerics%get_dict('homogenization',defaultVal=emptyDict) + num_mechanical => num_homogenization%get_dict('mechanical',defaultVal=emptyDict) + num_RGC => num_mechanical%get_dict('RGC',defaultVal=emptyDict) num%atol = num_RGC%get_asFloat('atol', defaultVal=1.0e+4_pReal) num%rtol = num_RGC%get_asFloat('rtol', defaultVal=1.0e-3_pReal) @@ -139,8 +139,8 @@ module subroutine RGC_init() do ho = 1, size(mechanical_type) if (mechanical_type(ho) /= MECHANICAL_RGC_ID) cycle - homog => material_homogenization%get(ho) - homogMech => homog%get('mechanical') + homog => material_homogenization%get_dict(ho) + homogMech => homog%get_dict('mechanical') associate(prm => param(ho), & stt => state(ho), & st0 => state0(ho), & diff --git a/src/homogenization_thermal.f90 b/src/homogenization_thermal.f90 index ceed47365..5f494fedf 100644 --- a/src/homogenization_thermal.f90 +++ b/src/homogenization_thermal.f90 @@ -35,7 +35,7 @@ contains !-------------------------------------------------------------------------------------------------- module subroutine thermal_init() - class(tNode), pointer :: & + type(tDict), pointer :: & configHomogenizations, & configHomogenization, & configHomogenizationThermal @@ -45,18 +45,18 @@ module subroutine thermal_init() print'(/,1x,a)', '<<<+- homogenization:thermal init -+>>>' - configHomogenizations => config_material%get('homogenization') + configHomogenizations => config_material%get_dict('homogenization') allocate(param(configHomogenizations%length)) allocate(current(configHomogenizations%length)) do ho = 1, configHomogenizations%length allocate(current(ho)%T(count(material_homogenizationID==ho)), source=T_ROOM) allocate(current(ho)%dot_T(count(material_homogenizationID==ho)), source=0.0_pReal) - configHomogenization => configHomogenizations%get(ho) + configHomogenization => configHomogenizations%get_dict(ho) associate(prm => param(ho)) if (configHomogenization%contains('thermal')) then - configHomogenizationThermal => configHomogenization%get('thermal') + configHomogenizationThermal => configHomogenization%get_dict('thermal') #if defined (__GFORTRAN__) prm%output = output_as1dString(configHomogenizationThermal) #else diff --git a/src/material.f90 b/src/material.f90 index 1ec844382..ceb67a177 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -83,13 +83,13 @@ end subroutine material_init !-------------------------------------------------------------------------------------------------- subroutine parse() - class(tNode), pointer :: materials, & !> list of materials - material, & !> material definition - constituents, & !> list of constituents - constituent, & !> constituent definition - phases, & - homogenizations, & - homogenization + type(tList), pointer :: materials, & !> all materials + constituents !> all constituents of a material + type(tDict), pointer :: phases, & !> all phases + homogenizations, & !> all homogenizations + material, & !> material definition + constituent, & !> constituent definition + homogenization class(tItem), pointer :: item integer, dimension(:), allocatable :: & @@ -107,25 +107,20 @@ subroutine parse() ma - materials => config_material%get('material') - phases => config_material%get('phase') - homogenizations => config_material%get('homogenization') + materials => config_material%get_list('material') + phases => config_material%get_dict('phase') + homogenizations => config_material%get_dict('homogenization') if (maxval(discretization_materialAt) > materials%length) & call IO_error(155,ext_msg='More materials requested than found in material.yaml') -#if defined (__GFORTRAN__) - material_name_phase = getKeys(phases) - material_name_homogenization = getKeys(homogenizations) -#else - material_name_phase = phases%Keys() - material_name_homogenization = homogenizations%Keys() -#endif + material_name_phase = phases%keys() + material_name_homogenization = homogenizations%keys() allocate(homogenization_Nconstituents(homogenizations%length)) do ho=1, homogenizations%length - homogenization => homogenizations%get(ho) + homogenization => homogenizations%get_dict(ho) homogenization_Nconstituents(ho) = homogenization%get_asInt('N_constituents') end do homogenization_maxNconstituents = maxval(homogenization_Nconstituents) @@ -140,40 +135,33 @@ subroutine parse() allocate( v_of(materials%length,homogenization_maxNconstituents),source=0.0_pReal) ! parse YAML structure - select type(materials) + item => materials%first + do ma = 1, materials%length + material => item%node%asDict() + ho_of(ma) = homogenizations%index(material%get_asString('homogenization')) + constituents => material%get_list('constituents') - class is(tList) + homogenization => homogenizations%get_dict(ho_of(ma)) + if (constituents%length /= homogenization%get_asInt('N_constituents')) call IO_error(148) - item => materials%first - do ma = 1, materials%length - material => item%node - ho_of(ma) = homogenizations%getIndex(material%get_asString('homogenization')) - constituents => material%get('constituents') + allocate(material_O_0(ma)%data(constituents%length)) + allocate(material_V_e_0(ma)%data(1:3,1:3,constituents%length)) - homogenization => homogenizations%get(ho_of(ma)) - if (constituents%length /= homogenization%get_asInt('N_constituents')) call IO_error(148) + do co = 1, constituents%length + constituent => constituents%get_dict(co) + v_of(ma,co) = constituent%get_asFloat('v') + ph_of(ma,co) = phases%index(constituent%get_asString('phase')) - allocate(material_O_0(ma)%data(constituents%length)) - allocate(material_V_e_0(ma)%data(1:3,1:3,constituents%length)) + call material_O_0(ma)%data(co)%fromQuaternion(constituent%get_as1dFloat('O',requiredSize=4)) + material_V_e_0(ma)%data(1:3,1:3,co) = constituent%get_as2dFloat('V_e',defaultVal=math_I3,requiredShape=[3,3]) + if (any(dNeq(material_V_e_0(ma)%data(1:3,1:3,co),transpose(material_V_e_0(ma)%data(1:3,1:3,co))))) & + call IO_error(147) - do co = 1, constituents%length - constituent => constituents%get(co) - v_of(ma,co) = constituent%get_asFloat('v') - ph_of(ma,co) = phases%getIndex(constituent%get_asString('phase')) - - call material_O_0(ma)%data(co)%fromQuaternion(constituent%get_as1dFloat('O',requiredSize=4)) - material_V_e_0(ma)%data(1:3,1:3,co) = constituent%get_as2dFloat('V_e',defaultVal=math_I3,requiredShape=[3,3]) - if (any(dNeq(material_V_e_0(ma)%data(1:3,1:3,co),transpose(material_V_e_0(ma)%data(1:3,1:3,co))))) & - call IO_error(147) - - end do - if (dNeq(sum(v_of(ma,:)),1.0_pReal,1.e-9_pReal)) call IO_error(153,ext_msg='constituent') - - item => item%next - end do - - end select + end do + if (dNeq(sum(v_of(ma,:)),1.0_pReal,1.e-9_pReal)) call IO_error(153,ext_msg='constituent') + item => item%next + end do allocate(counterPhase(phases%length),source=0) allocate(counterHomogenization(homogenizations%length),source=0) @@ -223,7 +211,7 @@ end subroutine parse !-------------------------------------------------------------------------------------------------- function getKeys(dict) - class(tNode), intent(in) :: dict + type(tDict), intent(in) :: dict character(len=:), dimension(:), allocatable :: getKeys character(len=pStringLen), dimension(:), allocatable :: temp @@ -232,7 +220,7 @@ function getKeys(dict) allocate(temp(dict%length)) l = 0 do i=1, dict%length - temp(i) = dict%getKey(i) + temp(i) = dict%key(i) l = max(len_trim(temp(i)),l) end do diff --git a/src/math.f90 b/src/math.f90 index a875741b3..889e4ccd2 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -87,13 +87,13 @@ subroutine math_init() real(pReal), dimension(4) :: randTest integer :: randSize integer, dimension(:), allocatable :: seed - class(tNode), pointer :: & + type(tDict), pointer :: & num_generic print'(/,1x,a)', '<<<+- math init -+>>>'; flush(IO_STDOUT) - num_generic => config_numerics%get('generic',defaultVal=emptyDict) + num_generic => config_numerics%get_dict('generic',defaultVal=emptyDict) call random_seed(size=randSize) allocate(seed(randSize)) diff --git a/src/mesh/DAMASK_mesh.f90 b/src/mesh/DAMASK_mesh.f90 index 5489ac36e..08e2940b3 100644 --- a/src/mesh/DAMASK_mesh.f90 +++ b/src/mesh/DAMASK_mesh.f90 @@ -65,7 +65,7 @@ program DAMASK_mesh statUnit = 0, & !< file unit for statistics output stagIter, & component - class(tNode), pointer :: & + type(tDict), pointer :: & num_mesh character(len=pStringLen), dimension(:), allocatable :: fileContent character(len=pStringLen) :: & @@ -90,7 +90,7 @@ program DAMASK_mesh !--------------------------------------------------------------------- ! reading field information from numerics file and do sanity checks - num_mesh => config_numerics%get('mesh', defaultVal=emptyDict) + num_mesh => config_numerics%get_dict('mesh', defaultVal=emptyDict) stagItMax = num_mesh%get_asInt('maxStaggeredIter',defaultVal=10) maxCutBack = num_mesh%get_asInt('maxCutBack',defaultVal=3) diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index c880bd4cf..b763dd84a 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -93,7 +93,7 @@ contains subroutine FEM_utilities_init character(len=pStringLen) :: petsc_optionsOrder - class(tNode), pointer :: & + type(tDict), pointer :: & num_mesh, & debug_mesh ! pointer to mesh debug options integer :: & @@ -107,7 +107,7 @@ subroutine FEM_utilities_init print'(/,1x,a)', '<<<+- FEM_utilities init -+>>>' - num_mesh => config_numerics%get('mesh',defaultVal=emptyDict) + num_mesh => config_numerics%get_dict('mesh',defaultVal=emptyDict) p_s = num_mesh%get_asInt('p_s',defaultVal = 2) p_i = num_mesh%get_asInt('p_i',defaultVal = p_s) @@ -117,8 +117,8 @@ subroutine FEM_utilities_init if (p_i < max(1,p_s-1) .or. p_i > p_s) & call IO_error(821,ext_msg='integration order (p_i) out of bounds') - debug_mesh => config_debug%get('mesh',defaultVal=emptyList) - debugPETSc = debug_mesh%contains('PETSc') + debug_mesh => config_debug%get_dict('mesh',defaultVal=emptyDict) + debugPETSc = debug_mesh%contains('PETSc') if(debugPETSc) print'(3(/,1x,a),/)', & 'Initializing PETSc with debug options: ', & diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index d8151b0a4..c645edc95 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -90,7 +90,7 @@ subroutine discretization_mesh_init(restart) integer(MPI_INTEGER_KIND) :: err_MPI PetscInt, dimension(:), allocatable :: & materialAt - class(tNode), pointer :: & + type(tDict), pointer :: & num_mesh integer :: p_i, dim !< integration order (quadrature rule) type(tvec) :: coords_node0 @@ -101,7 +101,7 @@ subroutine discretization_mesh_init(restart) !-------------------------------------------------------------------------------- ! read numerics parameter - num_mesh => config_numerics%get('mesh',defaultVal=emptyDict) + num_mesh => config_numerics%get_dict('mesh',defaultVal=emptyDict) p_i = num_mesh%get_asInt('p_i',defaultVal = 2) !--------------------------------------------------------------------------------- diff --git a/src/mesh/mesh_mech_FEM.f90 b/src/mesh/mesh_mech_FEM.f90 index ef20ed350..255bf3c77 100644 --- a/src/mesh/mesh_mech_FEM.f90 +++ b/src/mesh/mesh_mech_FEM.f90 @@ -126,14 +126,14 @@ subroutine FEM_mechanical_init(fieldBC) character(len=*), parameter :: prefix = 'mechFE_' PetscErrorCode :: err_PETSc real(pReal), dimension(3,3) :: devNull - class(tNode), pointer :: & + type(tDict), pointer :: & num_mesh print'(/,1x,a)', '<<<+- FEM_mech init -+>>>'; flush(IO_STDOUT) !----------------------------------------------------------------------------- ! read numerical parametes and do sanity checks - num_mesh => config_numerics%get('mesh',defaultVal=emptyDict) + num_mesh => config_numerics%get_dict('mesh',defaultVal=emptyDict) num%p_i = int(num_mesh%get_asInt('p_i',defaultVal = 2),pPETSCINT) num%itmax = int(num_mesh%get_asInt('itmax',defaultVal=250),pPETSCINT) num%BBarStabilisation = num_mesh%get_asBool('bbarstabilisation',defaultVal = .false.) diff --git a/src/phase.f90 b/src/phase.f90 index f304707b9..fdafd8f35 100644 --- a/src/phase.f90 +++ b/src/phase.f90 @@ -96,14 +96,14 @@ module phase ! == cleaned:begin ================================================================================= module subroutine mechanical_init(phases) - class(tNode), pointer :: phases + type(tDict), pointer :: phases end subroutine mechanical_init module subroutine damage_init end subroutine damage_init module subroutine thermal_init(phases) - class(tNode), pointer :: phases + type(tDict), pointer :: phases end subroutine thermal_init @@ -376,16 +376,16 @@ subroutine phase_init integer :: & ph, ce, co, ma - class (tNode), pointer :: & - debug_constitutive, & - materials, & + type(tDict), pointer :: & phases, & phase + type(tList), pointer :: & + debug_constitutive print'(/,1x,a)', '<<<+- phase init -+>>>'; flush(IO_STDOUT) - debug_constitutive => config_debug%get('phase', defaultVal=emptyList) + debug_constitutive => config_debug%get_list('phase', defaultVal=emptyList) debugConstitutive%basic = debug_constitutive%contains('basic') debugConstitutive%extensive = debug_constitutive%contains('extensive') debugConstitutive%selective = debug_constitutive%contains('selective') @@ -394,8 +394,7 @@ subroutine phase_init debugConstitutive%grain = config_debug%get_asInt('constituent', defaultVal = 1) - materials => config_material%get('material') - phases => config_material%get('phase') + phases => config_material%get_dict('phase') allocate(phase_lattice(phases%length)) allocate(phase_cOverA(phases%length),source=-1.0_pReal) @@ -403,7 +402,7 @@ subroutine phase_init allocate(phase_O_0(phases%length)) do ph = 1,phases%length - phase => phases%get(ph) + phase => phases%get_dict(ph) phase_lattice(ph) = phase%get_asString('lattice') if (all(phase_lattice(ph) /= ['cF','cI','hP','tI'])) & call IO_error(130,ext_msg='phase_init: '//phase%get_asString('lattice')) @@ -536,13 +535,13 @@ subroutine crystallite_init() ip, & !< counter in integration point loop el, & !< counter in element loop en, ph - class(tNode), pointer :: & + type(tDict), pointer :: & num_crystallite, & phases character(len=pStringLen) :: & extmsg = '' - num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) + num_crystallite => config_numerics%get_dict('crystallite',defaultVal=emptyDict) num%subStepMinCryst = num_crystallite%get_asFloat ('subStepMin', defaultVal=1.0e-3_pReal) num%subStepSizeCryst = num_crystallite%get_asFloat ('subStepSize', defaultVal=0.25_pReal) @@ -570,7 +569,7 @@ subroutine crystallite_init() if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg)) - phases => config_material%get('phase') + phases => config_material%get_dict('phase') !$OMP PARALLEL DO PRIVATE(ce,ph,en) do el = 1, discretization_Nelems diff --git a/src/phase_damage.f90 b/src/phase_damage.f90 index 7211f2db5..0bf13fcae 100644 --- a/src/phase_damage.f90 +++ b/src/phase_damage.f90 @@ -77,19 +77,20 @@ module subroutine damage_init integer :: & ph, & Nmembers - class(tNode), pointer :: & + type(tDict), pointer :: & phases, & phase, & - sources, & source + type(tList), pointer :: & + sources logical:: damage_active print'(/,1x,a)', '<<<+- phase:damage init -+>>>' - phases => config_material%get('phase') + phases => config_material%get_dict('phase') allocate(current(phases%length)) - allocate(damageState (phases%length)) + allocate(damageState(phases%length)) allocate(param(phases%length)) damage_active = .false. @@ -99,12 +100,12 @@ module subroutine damage_init allocate(current(ph)%phi(Nmembers),source=1.0_pReal) - phase => phases%get(ph) - sources => phase%get('damage',defaultVal=emptyList) + phase => phases%get_dict(ph) + sources => phase%get_list('damage',defaultVal=emptyList) if (sources%length > 1) error stop if (sources%length == 1) then damage_active = .true. - source => sources%get(1) + source => sources%get_dict(1) param(ph)%mu = source%get_asFloat('mu') param(ph)%l_c = source%get_asFloat('l_c') end if @@ -440,19 +441,20 @@ function source_active(source_label) result(active_source) character(len=*), intent(in) :: source_label !< name of source mechanism logical, dimension(:), allocatable :: active_source - class(tNode), pointer :: & + type(tDict), pointer :: & phases, & phase, & - sources, & src + type(tList), pointer :: & + sources integer :: ph - phases => config_material%get('phase') + phases => config_material%get_dict('phase') allocate(active_source(phases%length)) do ph = 1, phases%length - phase => phases%get(ph) - sources => phase%get('damage',defaultVal=emptyList) - src => sources%get(1) + phase => phases%get_dict(ph) + sources => phase%get_list('damage',defaultVal=emptyList) + src => sources%get_dict(1) active_source(ph) = src%get_asString('type',defaultVal = 'x') == source_label end do diff --git a/src/phase_damage_anisobrittle.f90 b/src/phase_damage_anisobrittle.f90 index 167d0829b..86b133cb7 100644 --- a/src/phase_damage_anisobrittle.f90 +++ b/src/phase_damage_anisobrittle.f90 @@ -35,11 +35,12 @@ module function anisobrittle_init() result(mySources) logical, dimension(:), allocatable :: mySources - class(tNode), pointer :: & + type(tDict), pointer :: & phases, & phase, & - sources, & src + type(tList), pointer :: & + sources integer :: Nmembers,ph integer, dimension(:), allocatable :: N_cl character(len=pStringLen) :: extmsg = '' @@ -52,17 +53,17 @@ module function anisobrittle_init() result(mySources) print'(/,a,i0)', ' # phases: ',count(mySources); flush(IO_STDOUT) - phases => config_material%get('phase') + phases => config_material%get_dict('phase') allocate(param(phases%length)) do ph = 1, phases%length if (mySources(ph)) then - phase => phases%get(ph) - sources => phase%get('damage') + phase => phases%get_dict(ph) + sources => phase%get_list('damage') associate(prm => param(ph)) - src => sources%get(1) + src => sources%get_dict(1) N_cl = src%get_as1dInt('N_cl',defaultVal=emptyIntArray) prm%sum_N_cl = sum(abs(N_cl)) diff --git a/src/phase_damage_isobrittle.f90 b/src/phase_damage_isobrittle.f90 index 76b382d62..8d0054c0c 100644 --- a/src/phase_damage_isobrittle.f90 +++ b/src/phase_damage_isobrittle.f90 @@ -34,11 +34,12 @@ module function isobrittle_init() result(mySources) logical, dimension(:), allocatable :: mySources - class(tNode), pointer :: & + type(tDict), pointer :: & phases, & phase, & - sources, & src + type(tList), pointer :: & + sources integer :: Nmembers,ph character(len=pStringLen) :: extmsg = '' @@ -50,18 +51,18 @@ module function isobrittle_init() result(mySources) print'(/,a,i0)', ' # phases: ',count(mySources); flush(IO_STDOUT) - phases => config_material%get('phase') + phases => config_material%get_dict('phase') allocate(param(phases%length)) allocate(state(phases%length)) allocate(deltaState(phases%length)) do ph = 1, phases%length if (mySources(ph)) then - phase => phases%get(ph) - sources => phase%get('damage') + phase => phases%get_dict(ph) + sources => phase%get_list('damage') associate(prm => param(ph), dlt => deltaState(ph), stt => state(ph)) - src => sources%get(1) + src => sources%get_dict(1) prm%W_crit = src%get_asFloat('G_crit')/src%get_asFloat('l_c') diff --git a/src/phase_mechanical.f90 b/src/phase_mechanical.f90 index 440e196bc..d1f0e7ab0 100644 --- a/src/phase_mechanical.f90 +++ b/src/phase_mechanical.f90 @@ -43,11 +43,11 @@ submodule(phase) mechanical interface module subroutine eigen_init(phases) - class(tNode), pointer :: phases + type(tDict), pointer :: phases end subroutine eigen_init module subroutine elastic_init(phases) - class(tNode), pointer :: phases + type(tDict), pointer :: phases end subroutine elastic_init module subroutine plastic_init @@ -198,7 +198,7 @@ contains !-------------------------------------------------------------------------------------------------- module subroutine mechanical_init(phases) - class(tNode), pointer :: & + type(tDict), pointer :: & phases integer :: & @@ -208,7 +208,7 @@ module subroutine mechanical_init(phases) ph, & en, & Nmembers - class(tNode), pointer :: & + type(tDict), pointer :: & num_crystallite, & phase, & mech @@ -248,8 +248,8 @@ module subroutine mechanical_init(phases) allocate(phase_mechanical_P(ph)%data(3,3,Nmembers),source=0.0_pReal) allocate(phase_mechanical_S0(ph)%data(3,3,Nmembers),source=0.0_pReal) - phase => phases%get(ph) - mech => phase%get('mechanical') + phase => phases%get_dict(ph) + mech => phase%get_dict('mechanical') #if defined(__GFORTRAN__) output_mechanical(ph)%label = output_as1dString(mech) #else @@ -286,7 +286,7 @@ module subroutine mechanical_init(phases) plasticState(ph)%state0 = plasticState(ph)%state end do - num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) + num_crystallite => config_numerics%get_dict('crystallite',defaultVal=emptyDict) select case(num_crystallite%get_asString('integrator',defaultVal='FPI')) diff --git a/src/phase_mechanical_eigen.f90 b/src/phase_mechanical_eigen.f90 index 4cd02d090..263ef9db5 100644 --- a/src/phase_mechanical_eigen.f90 +++ b/src/phase_mechanical_eigen.f90 @@ -34,15 +34,16 @@ contains module subroutine eigen_init(phases) - class(tNode), pointer :: & + type(tDict), pointer :: & phases integer :: & ph - class(tNode), pointer :: & + type(tDict), pointer :: & phase, & - kinematics, & mechanics + type(tList), pointer :: & + kinematics print'(/,1x,a)', '<<<+- phase:mechanical:eigen init -+>>>' @@ -51,9 +52,9 @@ module subroutine eigen_init(phases) allocate(Nmodels(phases%length),source = 0) do ph = 1,phases%length - phase => phases%get(ph) - mechanics => phase%get('mechanical') - kinematics => mechanics%get('eigen',defaultVal=emptyList) + phase => phases%get_dict(ph) + mechanics => phase%get_dict('mechanical') + kinematics => mechanics%get_list('eigen',defaultVal=emptyList) Nmodels(ph) = kinematics%length end do @@ -80,27 +81,28 @@ function kinematics_active(kinematics_label,kinematics_length) result(active_ki integer, intent(in) :: kinematics_length !< max. number of kinematics in system logical, dimension(:,:), allocatable :: active_kinematics - class(tNode), pointer :: & + type(tDict), pointer :: & phases, & phase, & - kinematics, & - kinematics_type, & - mechanics + mechanics, & + kinematic + type(tList), pointer :: & + kinematics integer :: ph,k - phases => config_material%get('phase') + + phases => config_material%get_dict('phase') allocate(active_kinematics(kinematics_length,phases%length), source = .false. ) do ph = 1, phases%length - phase => phases%get(ph) - mechanics => phase%get('mechanical') - kinematics => mechanics%get('eigen',defaultVal=emptyList) + phase => phases%get_dict(ph) + mechanics => phase%get_dict('mechanical') + kinematics => mechanics%get_list('eigen',defaultVal=emptyList) do k = 1, kinematics%length - kinematics_type => kinematics%get(k) - active_kinematics(k,ph) = kinematics_type%get_asString('type') == kinematics_label + kinematic => kinematics%get_dict(k) + active_kinematics(k,ph) = kinematic%get_asString('type') == kinematics_label end do end do - end function kinematics_active @@ -113,20 +115,21 @@ function kinematics_active2(kinematics_label) result(active_kinematics) character(len=*), intent(in) :: kinematics_label !< name of kinematic mechanism logical, dimension(:), allocatable :: active_kinematics - class(tNode), pointer :: & + type(tDict), pointer :: & phases, & phase, & - kinematics, & kinematics_type + type(tList), pointer :: & + kinematics integer :: ph - phases => config_material%get('phase') + phases => config_material%get_dict('phase') allocate(active_kinematics(phases%length), source = .false.) do ph = 1, phases%length - phase => phases%get(ph) - kinematics => phase%get('damage',defaultVal=emptyList) + phase => phases%get_dict(ph) + kinematics => phase%get_list('damage',defaultVal=emptyList) if (kinematics%length < 1) return - kinematics_type => kinematics%get(1) + kinematics_type => kinematics%get_dict(1) if (.not. kinematics_type%contains('type')) continue active_kinematics(ph) = kinematics_type%get_asString('type',defaultVal='n/a') == kinematics_label end do diff --git a/src/phase_mechanical_eigen_thermalexpansion.f90 b/src/phase_mechanical_eigen_thermalexpansion.f90 index 3c422616b..7713650ea 100644 --- a/src/phase_mechanical_eigen_thermalexpansion.f90 +++ b/src/phase_mechanical_eigen_thermalexpansion.f90 @@ -28,12 +28,13 @@ module function thermalexpansion_init(kinematics_length) result(myKinematics) logical, dimension(:,:), allocatable :: myKinematics integer :: Ninstances, p, k - class(tNode), pointer :: & + type(tList), pointer :: & + kinematics + type(tDict), pointer :: & phases, & phase, & - mech, & - kinematics, & - myConfig + mech + print'(/,1x,a)', '<<<+- phase:mechanical:eigen:thermalexpansion init -+>>>' @@ -42,26 +43,23 @@ module function thermalexpansion_init(kinematics_length) result(myKinematics) print'(/,a,i2)', ' # phases: ',Ninstances; flush(IO_STDOUT) if (Ninstances == 0) return - phases => config_material%get('phase') + phases => config_material%get_dict('phase') allocate(param(Ninstances)) allocate(kinematics_thermal_expansion_instance(phases%length), source=0) do p = 1, phases%length if (any(myKinematics(:,p))) kinematics_thermal_expansion_instance(p) = count(myKinematics(:,1:p)) - phase => phases%get(p) + phase => phases%get_dict(p) if (count(myKinematics(:,p)) == 0) cycle - mech => phase%get('mechanical') - kinematics => mech%get('eigen') + mech => phase%get_dict('mechanical') + kinematics => mech%get_list('eigen') do k = 1, kinematics%length if (myKinematics(k,p)) then associate(prm => param(kinematics_thermal_expansion_instance(p))) - myConfig => kinematics%get(k) - - prm%A_11 = polynomial(myConfig%asDict(),'A_11','T') + prm%A_11 = polynomial(kinematics%get_dict(k),'A_11','T') if (any(phase_lattice(p) == ['hP','tI'])) & - prm%A_33 = polynomial(myConfig%asDict(),'A_33','T') - + prm%A_33 = polynomial(kinematics%get_dict(k),'A_33','T') end associate end if end do diff --git a/src/phase_mechanical_elastic.f90 b/src/phase_mechanical_elastic.f90 index 84ad7a20e..2dae61f34 100644 --- a/src/phase_mechanical_elastic.f90 +++ b/src/phase_mechanical_elastic.f90 @@ -19,12 +19,12 @@ contains !-------------------------------------------------------------------------------------------------- module subroutine elastic_init(phases) - class(tNode), pointer :: & + type(tDict), pointer :: & phases integer :: & ph - class(tNode), pointer :: & + type(tDict), pointer :: & phase, & mech, & elastic @@ -38,9 +38,9 @@ module subroutine elastic_init(phases) allocate(param(phases%length)) do ph = 1, phases%length - phase => phases%get(ph) - mech => phase%get('mechanical') - elastic => mech%get('elastic') + phase => phases%get_dict(ph) + mech => phase%get_dict('mechanical') + elastic => mech%get_dict('elastic') if (elastic%get_asString('type') /= 'Hooke') call IO_error(200,ext_msg=elastic%get_asString('type')) associate(prm => param(ph)) diff --git a/src/phase_mechanical_plastic.f90 b/src/phase_mechanical_plastic.f90 index 6469c6e45..bff25895c 100644 --- a/src/phase_mechanical_plastic.f90 +++ b/src/phase_mechanical_plastic.f90 @@ -421,19 +421,19 @@ function plastic_active(plastic_label) result(active_plastic) character(len=*), intent(in) :: plastic_label !< type of plasticity model logical, dimension(:), allocatable :: active_plastic - class(tNode), pointer :: & + type(tDict), pointer :: & phases, & phase, & mech, & pl integer :: ph - phases => config_material%get('phase') + phases => config_material%get_dict('phase') allocate(active_plastic(phases%length), source = .false. ) do ph = 1, phases%length - phase => phases%get(ph) - mech => phase%get('mechanical') - pl => mech%get('plastic',defaultVal = emptyDict) + phase => phases%get_dict(ph) + mech => phase%get_dict('mechanical') + pl => mech%get_dict('plastic',defaultVal = emptyDict) active_plastic(ph) = pl%get_asString('type',defaultVal='none') == plastic_label end do diff --git a/src/phase_mechanical_plastic_dislotungsten.f90 b/src/phase_mechanical_plastic_dislotungsten.f90 index 9e72a1ebd..c7fc8d2bf 100644 --- a/src/phase_mechanical_plastic_dislotungsten.f90 +++ b/src/phase_mechanical_plastic_dislotungsten.f90 @@ -93,7 +93,7 @@ module function plastic_dislotungsten_init() result(myPlasticity) a !< non-Schmid coefficients character(len=pStringLen) :: & extmsg = '' - class(tNode), pointer :: & + type(tDict), pointer :: & phases, & phase, & mech, & @@ -109,7 +109,7 @@ module function plastic_dislotungsten_init() result(myPlasticity) print'(/,1x,a)', 'D. Cereceda et al., International Journal of Plasticity 78:242–256, 2016' print'( 1x,a)', 'https://doi.org/10.1016/j.ijplas.2015.09.002' - phases => config_material%get('phase') + phases => config_material%get_dict('phase') allocate(param(phases%length)) allocate(indexDotState(phases%length)) allocate(state(phases%length)) @@ -121,9 +121,9 @@ module function plastic_dislotungsten_init() result(myPlasticity) associate(prm => param(ph), stt => state(ph), dst => dependentState(ph), & idx_dot => indexDotState(ph)) - phase => phases%get(ph) - mech => phase%get('mechanical') - pl => mech%get('plastic') + phase => phases%get_dict(ph) + mech => phase%get_dict('mechanical') + pl => mech%get_dict('plastic') #if defined (__GFORTRAN__) prm%output = output_as1dString(pl) diff --git a/src/phase_mechanical_plastic_dislotwin.f90 b/src/phase_mechanical_plastic_dislotwin.f90 index f01a7e95d..80257954d 100644 --- a/src/phase_mechanical_plastic_dislotwin.f90 +++ b/src/phase_mechanical_plastic_dislotwin.f90 @@ -142,7 +142,7 @@ module function plastic_dislotwin_init() result(myPlasticity) rho_dip_0 !< initial dipole dislocation density per slip system character(len=pStringLen) :: & extmsg = '' - class(tNode), pointer :: & + type(tDict), pointer :: & phases, & phase, & mech, & @@ -165,7 +165,7 @@ module function plastic_dislotwin_init() result(myPlasticity) print'( 1x,a)', 'https://doi.org/10.1016/j.actamat.2016.07.032' - phases => config_material%get('phase') + phases => config_material%get_dict('phase') allocate(param(phases%length)) allocate(indexDotState(phases%length)) allocate(state(phases%length)) @@ -177,9 +177,9 @@ module function plastic_dislotwin_init() result(myPlasticity) associate(prm => param(ph), stt => state(ph), dst => dependentState(ph), & idx_dot => indexDotState(ph)) - phase => phases%get(ph) - mech => phase%get('mechanical') - pl => mech%get('plastic') + phase => phases%get_dict(ph) + mech => phase%get_dict('mechanical') + pl => mech%get_dict('plastic') #if defined (__GFORTRAN__) prm%output = output_as1dString(pl) diff --git a/src/phase_mechanical_plastic_isotropic.f90 b/src/phase_mechanical_plastic_isotropic.f90 index c855f5c25..e755c5bba 100644 --- a/src/phase_mechanical_plastic_isotropic.f90 +++ b/src/phase_mechanical_plastic_isotropic.f90 @@ -56,7 +56,7 @@ module function plastic_isotropic_init() result(myPlasticity) xi_0 !< initial critical stress character(len=pStringLen) :: & extmsg = '' - class(tNode), pointer :: & + type(tDict), pointer :: & phases, & phase, & mech, & @@ -72,7 +72,7 @@ module function plastic_isotropic_init() result(myPlasticity) print'(/,1x,a)', 'T. Maiti and P. Eisenlohr, Scripta Materialia 145:37–40, 2018' print'( 1x,a)', 'https://doi.org/10.1016/j.scriptamat.2017.09.047' - phases => config_material%get('phase') + phases => config_material%get_dict('phase') allocate(param(phases%length)) allocate(state(phases%length)) @@ -81,9 +81,9 @@ module function plastic_isotropic_init() result(myPlasticity) associate(prm => param(ph), stt => state(ph)) - phase => phases%get(ph) - mech => phase%get('mechanical') - pl => mech%get('plastic') + phase => phases%get_dict(ph) + mech => phase%get_dict('mechanical') + pl => mech%get_dict('plastic') #if defined (__GFORTRAN__) prm%output = output_as1dString(pl) diff --git a/src/phase_mechanical_plastic_kinehardening.f90 b/src/phase_mechanical_plastic_kinehardening.f90 index bc8c7df4e..47b6a777a 100644 --- a/src/phase_mechanical_plastic_kinehardening.f90 +++ b/src/phase_mechanical_plastic_kinehardening.f90 @@ -79,7 +79,7 @@ module function plastic_kinehardening_init() result(myPlasticity) a !< non-Schmid coefficients character(len=pStringLen) :: & extmsg = '' - class(tNode), pointer :: & + type(tDict), pointer :: & phases, & phase, & mech, & @@ -94,7 +94,7 @@ module function plastic_kinehardening_init() result(myPlasticity) print'(/,1x,a)', 'J.A. Wollmershauser et al., International Journal of Fatigue 36:181–193, 2012' print'( 1x,a)', 'https://doi.org/10.1016/j.ijfatigue.2011.07.008' - phases => config_material%get('phase') + phases => config_material%get_dict('phase') allocate(param(phases%length)) allocate(indexDotState(phases%length)) allocate(state(phases%length)) @@ -107,9 +107,9 @@ module function plastic_kinehardening_init() result(myPlasticity) associate(prm => param(ph), stt => state(ph), dlt => deltaState(ph), & idx_dot => indexDotState(ph)) - phase => phases%get(ph) - mech => phase%get('mechanical') - pl => mech%get('plastic') + phase => phases%get_dict(ph) + mech => phase%get_dict('mechanical') + pl => mech%get_dict('plastic') #if defined (__GFORTRAN__) prm%output = output_as1dString(pl) diff --git a/src/phase_mechanical_plastic_none.f90 b/src/phase_mechanical_plastic_none.f90 index 50b4b4cbc..711260531 100644 --- a/src/phase_mechanical_plastic_none.f90 +++ b/src/phase_mechanical_plastic_none.f90 @@ -17,7 +17,7 @@ module function plastic_none_init() result(myPlasticity) logical, dimension(:), allocatable :: myPlasticity integer :: & ph - class(tNode), pointer :: & + type(tDict), pointer :: & phases @@ -27,7 +27,7 @@ module function plastic_none_init() result(myPlasticity) print'(/,1x,a)', '<<<+- phase:mechanical:plastic:none init -+>>>' print'(/,a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT) - phases => config_material%get('phase') + phases => config_material%get_dict('phase') do ph = 1, phases%length if (.not. myPlasticity(ph)) cycle call phase_allocateState(plasticState(ph),count(material_phaseID == ph),0,0,0) diff --git a/src/phase_mechanical_plastic_nonlocal.f90 b/src/phase_mechanical_plastic_nonlocal.f90 index 4995f15d2..9010ac1c7 100644 --- a/src/phase_mechanical_plastic_nonlocal.f90 +++ b/src/phase_mechanical_plastic_nonlocal.f90 @@ -190,7 +190,7 @@ module function plastic_nonlocal_init() result(myPlasticity) extmsg = '' type(tInitialParameters) :: & ini - class(tNode), pointer :: & + type(tDict), pointer :: & phases, & phase, & mech, & @@ -213,7 +213,7 @@ module function plastic_nonlocal_init() result(myPlasticity) print'( 1x,a)', 'http://publications.rwth-aachen.de/record/229993' - phases => config_material%get('phase') + phases => config_material%get_dict('phase') allocate(geom(phases%length)) @@ -230,9 +230,9 @@ module function plastic_nonlocal_init() result(myPlasticity) associate(prm => param(ph), dot => dotState(ph), stt => state(ph), & st0 => state0(ph), del => deltaState(ph), dst => dependentState(ph)) - phase => phases%get(ph) - mech => phase%get('mechanical') - pl => mech%get('plastic') + phase => phases%get_dict(ph) + mech => phase%get_dict('mechanical') + pl => mech%get_dict('plastic') plasticState(ph)%nonlocal = pl%get_asBool('flux',defaultVal=.True.) #if defined (__GFORTRAN__) @@ -520,7 +520,7 @@ module function plastic_nonlocal_init() result(myPlasticity) if(.not. myPlasticity(ph)) cycle - phase => phases%get(ph) + phase => phases%get_dict(ph) Nmembers = count(material_phaseID == ph) l = 0 do t = 1,4 diff --git a/src/phase_mechanical_plastic_phenopowerlaw.f90 b/src/phase_mechanical_plastic_phenopowerlaw.f90 index 325e4cd64..0fcdbea6a 100644 --- a/src/phase_mechanical_plastic_phenopowerlaw.f90 +++ b/src/phase_mechanical_plastic_phenopowerlaw.f90 @@ -92,7 +92,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity) a !< non-Schmid coefficients character(len=pStringLen) :: & extmsg = '' - class(tNode), pointer :: & + type(tDict), pointer :: & phases, & phase, & mech, & @@ -106,7 +106,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity) print'(/,a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT) - phases => config_material%get('phase') + phases => config_material%get_dict('phase') allocate(param(phases%length)) allocate(indexDotState(phases%length)) allocate(state(phases%length)) @@ -117,9 +117,9 @@ module function plastic_phenopowerlaw_init() result(myPlasticity) associate(prm => param(ph), stt => state(ph), & idx_dot => indexDotState(ph)) - phase => phases%get(ph) - mech => phase%get('mechanical') - pl => mech%get('plastic') + phase => phases%get_dict(ph) + mech => phase%get_dict('mechanical') + pl => mech%get_dict('plastic') !-------------------------------------------------------------------------------------------------- ! slip related parameters diff --git a/src/phase_thermal.f90 b/src/phase_thermal.f90 index ed374e142..fd79d3d46 100644 --- a/src/phase_thermal.f90 +++ b/src/phase_thermal.f90 @@ -76,11 +76,14 @@ contains !---------------------------------------------------------------------------------------------- module subroutine thermal_init(phases) - class(tNode), pointer :: & + type(tDict), pointer :: & phases - class(tNode), pointer :: & - phase, thermal, sources + type(tDict), pointer :: & + phase, & + thermal + type(tList), pointer :: & + sources integer :: & ph, so, & @@ -99,8 +102,8 @@ module subroutine thermal_init(phases) Nmembers = count(material_phaseID == ph) allocate(current(ph)%T(Nmembers),source=T_ROOM) allocate(current(ph)%dot_T(Nmembers),source=0.0_pReal) - phase => phases%get(ph) - thermal => phase%get('thermal',defaultVal=emptyDict) + phase => phases%get_dict(ph) + thermal => phase%get_dict('thermal',defaultVal=emptyDict) ! ToDo: temperature dependency of K and C_p if (thermal%length > 0) then @@ -114,7 +117,7 @@ module subroutine thermal_init(phases) #else param(ph)%output = thermal%get_as1dString('output',defaultVal=emptyStringArray) #endif - sources => thermal%get('source',defaultVal=emptyList) + sources => thermal%get_list('source',defaultVal=emptyList) thermal_Nsources(ph) = sources%length else thermal_Nsources(ph) = 0 @@ -365,21 +368,23 @@ function thermal_active(source_label,src_length) result(active_source) integer, intent(in) :: src_length !< max. number of sources in system logical, dimension(:,:), allocatable :: active_source - class(tNode), pointer :: & + type(tDict), pointer :: & phases, & phase, & - sources, thermal, & + thermal, & src + type(tList), pointer :: & + sources integer :: p,s - phases => config_material%get('phase') + phases => config_material%get_dict('phase') allocate(active_source(src_length,phases%length), source = .false. ) do p = 1, phases%length - phase => phases%get(p) - thermal => phase%get('thermal',defaultVal=emptyDict) - sources => thermal%get('source',defaultVal=emptyList) + phase => phases%get_dict(p) + thermal => phase%get_dict('thermal',defaultVal=emptyDict) + sources => thermal%get_list('source',defaultVal=emptyList) do s = 1, sources%length - src => sources%get(s) + src => sources%get_dict(s) active_source(s,p) = src%get_asString('type') == source_label end do end do diff --git a/src/phase_thermal_dissipation.f90 b/src/phase_thermal_dissipation.f90 index 898b32706..a08d396ec 100644 --- a/src/phase_thermal_dissipation.f90 +++ b/src/phase_thermal_dissipation.f90 @@ -26,11 +26,13 @@ module function dissipation_init(source_length) result(mySources) integer, intent(in) :: source_length logical, dimension(:,:), allocatable :: mySources - class(tNode), pointer :: & + type(tDict), pointer :: & phases, & phase, & - sources, thermal, & + thermal, & src + class(tList), pointer :: & + sources integer :: so,Nmembers,ph @@ -40,18 +42,18 @@ module function dissipation_init(source_length) result(mySources) print'(/,a,i2)', ' # phases: ',count(mySources); flush(IO_STDOUT) - phases => config_material%get('phase') + phases => config_material%get_dict('phase') allocate(param(phases%length)) do ph = 1, phases%length - phase => phases%get(ph) + phase => phases%get_dict(ph) if (count(mySources(:,ph)) == 0) cycle !ToDo: error if > 1 - thermal => phase%get('thermal') - sources => thermal%get('source') + thermal => phase%get_dict('thermal') + sources => thermal%get_list('source') do so = 1, sources%length if (mySources(so,ph)) then associate(prm => param(ph)) - src => sources%get(so) + src => sources%get_dict(so) prm%kappa = src%get_asFloat('kappa') Nmembers = count(material_phaseID == ph) diff --git a/src/phase_thermal_externalheat.f90 b/src/phase_thermal_externalheat.f90 index f7a8296a8..2d7f541ab 100644 --- a/src/phase_thermal_externalheat.f90 +++ b/src/phase_thermal_externalheat.f90 @@ -33,11 +33,13 @@ module function externalheat_init(source_length) result(mySources) integer, intent(in) :: source_length logical, dimension(:,:), allocatable :: mySources - class(tNode), pointer :: & + type(tDict), pointer :: & phases, & phase, & - sources, thermal, & + thermal, & src + type(tList), pointer :: & + sources integer :: so,Nmembers,ph @@ -47,20 +49,20 @@ module function externalheat_init(source_length) result(mySources) print'(/,a,i2)', ' # phases: ',count(mySources); flush(IO_STDOUT) - phases => config_material%get('phase') + phases => config_material%get_dict('phase') allocate(param(phases%length)) allocate(source_thermal_externalheat_offset (phases%length), source=0) do ph = 1, phases%length - phase => phases%get(ph) + phase => phases%get_dict(ph) if (count(mySources(:,ph)) == 0) cycle - thermal => phase%get('thermal') - sources => thermal%get('source') + thermal => phase%get_dict('thermal') + sources => thermal%get_list('source') do so = 1, sources%length if (mySources(so,ph)) then source_thermal_externalheat_offset(ph) = so associate(prm => param(ph)) - src => sources%get(so) + src => sources%get_dict(so) prm%t_n = src%get_as1dFloat('t_n') prm%nIntervals = size(prm%t_n) - 1 diff --git a/src/polynomials.f90 b/src/polynomials.f90 index eeb4152f2..385905b38 100644 --- a/src/polynomials.f90 +++ b/src/polynomials.f90 @@ -126,7 +126,7 @@ subroutine selfTest() real(pReal), dimension(5) :: coef integer :: i real(pReal) :: x_ref, x, y - class(tNode), pointer :: dict + type(tDict), pointer :: dict character(len=pStringLen), dimension(size(coef)) :: coef_s character(len=pStringLen) :: x_ref_s, x_s, YAML_s @@ -156,7 +156,7 @@ subroutine selfTest() 'C,T^3: '//trim(adjustl(coef_s(4)))//IO_EOL//& 'C,T^4: '//trim(adjustl(coef_s(5)))//IO_EOL//& 'T_ref: '//trim(adjustl(x_ref_s))//IO_EOL - Dict => YAML_parse_str(trim(YAML_s)) + dict => YAML_parse_str_asDict(trim(YAML_s)) p2 = polynomial(dict%asDict(),'C','T') if (dNeq(p1%at(x),p2%at(x),1.0e-6_pReal)) error stop 'polynomials: init' y = coef(1)+coef(2)*(x-x_ref)+coef(3)*(x-x_ref)**2+coef(4)*(x-x_ref)**3+coef(5)*(x-x_ref)**4 @@ -165,28 +165,28 @@ subroutine selfTest() YAML_s = 'C: 0.0'//IO_EOL//& 'C,T: '//trim(adjustl(coef_s(2)))//IO_EOL//& 'T_ref: '//trim(adjustl(x_ref_s))//IO_EOL - Dict => YAML_parse_str(trim(YAML_s)) + dict => YAML_parse_str_asDict(trim(YAML_s)) p1 = polynomial(dict%asDict(),'C','T') if (dNeq(p1%at(x_ref+x),-p1%at(x_ref-x),1.0e-10_pReal)) error stop 'polynomials: eval(linear)' YAML_s = 'C: 0.0'//IO_EOL//& 'C,T^2: '//trim(adjustl(coef_s(3)))//IO_EOL//& 'T_ref: '//trim(adjustl(x_ref_s))//IO_EOL - Dict => YAML_parse_str(trim(YAML_s)) + dict => YAML_parse_str_asDict(trim(YAML_s)) p1 = polynomial(dict%asDict(),'C','T') if (dNeq(p1%at(x_ref+x),p1%at(x_ref-x),1e-10_pReal)) error stop 'polynomials: eval(quadratic)' YAML_s = 'Y: '//trim(adjustl(coef_s(1)))//IO_EOL//& 'Y,X^3: '//trim(adjustl(coef_s(2)))//IO_EOL//& 'X_ref: '//trim(adjustl(x_ref_s))//IO_EOL - Dict => YAML_parse_str(trim(YAML_s)) + dict => YAML_parse_str_asDict(trim(YAML_s)) p1 = polynomial(dict%asDict(),'Y','X') if (dNeq(p1%at(x_ref+x)-coef(1),-(p1%at(x_ref-x)-coef(1)),1.0e-8_pReal)) error stop 'polynomials: eval(cubic)' YAML_s = 'Y: '//trim(adjustl(coef_s(1)))//IO_EOL//& 'Y,X^4: '//trim(adjustl(coef_s(2)))//IO_EOL//& 'X_ref: '//trim(adjustl(x_ref_s))//IO_EOL - Dict => YAML_parse_str(trim(YAML_s)) + dict => YAML_parse_str_asDict(trim(YAML_s)) p1 = polynomial(dict%asDict(),'Y','X') if (dNeq(p1%at(x_ref+x),p1%at(x_ref-x),1.0e-6_pReal)) error stop 'polynomials: eval(quartic)'