From df5487e1a9ac18923f7cce5b1be5d1222d6b004b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 25 Oct 2022 16:09:36 +0000 Subject: [PATCH] Re-written YAML types Strict typing for YAML New access pattern requires to specify the expected type, i.e. 'scalar', 'list', or 'dict'. This ensures that the node offers the expected functionality instead of polluting 'tNode' with dummy functions which throw error messages if not overwritten. The restructuring of the code allows to hierarchically construct methods without much code duplication. Some aspects of the error messaging system have been improved. --- cmake/Compiler-IntelLLVM.cmake | 4 +- src/Marc/DAMASK_Marc.f90 | 4 +- src/Marc/discretization_Marc.f90 | 4 +- src/Marc/materialpoint_Marc.f90 | 5 +- src/YAML_parse.f90 | 36 +- src/YAML_types.f90 | 2162 ++++++++--------- src/config.f90 | 8 +- src/grid/DAMASK_grid.f90 | 62 +- src/grid/grid_damage_spectral.f90 | 6 +- src/grid/grid_mech_FEM.f90 | 10 +- src/grid/grid_mech_spectral_basic.f90 | 10 +- src/grid/grid_mech_spectral_polarisation.f90 | 9 +- src/grid/grid_thermal_spectral.f90 | 4 +- src/grid/spectral_utilities.f90 | 12 +- src/homogenization.f90 | 16 +- src/homogenization_damage.f90 | 8 +- src/homogenization_mechanical.f90 | 8 +- src/homogenization_mechanical_RGC.f90 | 14 +- src/homogenization_thermal.f90 | 8 +- src/material.f90 | 84 +- src/math.f90 | 4 +- src/mesh/DAMASK_mesh.f90 | 4 +- src/mesh/FEM_utilities.f90 | 8 +- src/mesh/discretization_mesh.f90 | 4 +- src/mesh/mesh_mech_FEM.f90 | 4 +- src/phase.f90 | 23 +- src/phase_damage.f90 | 28 +- src/phase_damage_anisobrittle.f90 | 13 +- src/phase_damage_isobrittle.f90 | 13 +- src/phase_mechanical.f90 | 14 +- src/phase_mechanical_eigen.f90 | 49 +- ...hase_mechanical_eigen_thermalexpansion.f90 | 24 +- src/phase_mechanical_elastic.f90 | 10 +- src/phase_mechanical_plastic.f90 | 10 +- ...phase_mechanical_plastic_dislotungsten.f90 | 10 +- src/phase_mechanical_plastic_dislotwin.f90 | 10 +- src/phase_mechanical_plastic_isotropic.f90 | 10 +- ...phase_mechanical_plastic_kinehardening.f90 | 10 +- src/phase_mechanical_plastic_none.f90 | 4 +- src/phase_mechanical_plastic_nonlocal.f90 | 12 +- ...phase_mechanical_plastic_phenopowerlaw.f90 | 10 +- src/phase_thermal.f90 | 31 +- src/phase_thermal_dissipation.f90 | 16 +- src/phase_thermal_externalheat.f90 | 16 +- src/polynomials.f90 | 12 +- 45 files changed, 1405 insertions(+), 1418 deletions(-) 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)'