From b9fec2a4cff7119977d034ae1cb02c084fa12391 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 22 Apr 2020 12:23:09 +0200 Subject: [PATCH 01/15] Public functions required --- src/IO.f90 | 108 +++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 85 insertions(+), 23 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 6e467cb89..11ce664f8 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -31,6 +31,10 @@ module IO IO_stringValue, & IO_floatValue, & IO_intValue, & + IO_stringAsInt, & + IO_stringAsFloat, & + IO_stringAsBool, & + IO_rmComment, & IO_lc, & IO_error, & IO_warning @@ -250,7 +254,7 @@ integer function IO_intValue(string,chunkPos,myChunk) integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string integer, intent(in) :: myChunk !< position number of desired chunk - IO_intValue = verifyIntValue(IO_stringValue(string,chunkPos,myChunk)) + IO_intValue = IO_stringAsInt(IO_stringValue(string,chunkPos,myChunk)) end function IO_intValue @@ -264,7 +268,7 @@ real(pReal) function IO_floatValue(string,chunkPos,myChunk) integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string integer, intent(in) :: myChunk !< position number of desired chunk - IO_floatValue = verifyFloatValue(IO_stringValue(string,chunkPos,myChunk)) + IO_floatValue = IO_stringAsFloat(IO_stringValue(string,chunkPos,myChunk)) end function IO_floatValue @@ -335,7 +339,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = 'invalid character for int:' case (112) msg = 'invalid character for float:' - + case (113) + msg = 'invalid character for logical:' !-------------------------------------------------------------------------------------------------- ! lattice error messages case (130) @@ -607,12 +612,9 @@ end subroutine IO_warning !-------------------------------------------------------------------------------------------------- -! internal helper functions - +!> @brief return verified integer value in given string !-------------------------------------------------------------------------------------------------- -!> @brief returns verified integer value in given string -!-------------------------------------------------------------------------------------------------- -integer function verifyIntValue(string) +integer function IO_stringAsInt(string) character(len=*), intent(in) :: string !< string for conversion to int value @@ -620,20 +622,20 @@ integer function verifyIntValue(string) character(len=*), parameter :: VALIDCHARS = '0123456789+- ' valid: if (verify(string,VALIDCHARS) == 0) then - read(string,*,iostat=readStatus) verifyIntValue + read(string,*,iostat=readStatus) IO_stringAsInt if (readStatus /= 0) call IO_error(111,ext_msg=string) else valid - verifyIntValue = 0 + IO_stringAsInt = 0 call IO_error(111,ext_msg=string) endif valid -end function verifyIntValue +end function IO_stringAsInt !-------------------------------------------------------------------------------------------------- -!> @brief returns verified float value in given string +!> @brief return verified float value in given string !-------------------------------------------------------------------------------------------------- -real(pReal) function verifyFloatValue(string) +real(pReal) function IO_stringAsFloat(string) character(len=*), intent(in) :: string !< string for conversion to float value @@ -641,14 +643,54 @@ real(pReal) function verifyFloatValue(string) character(len=*), parameter :: VALIDCHARS = '0123456789eE.+- ' valid: if (verify(string,VALIDCHARS) == 0) then - read(string,*,iostat=readStatus) verifyFloatValue + read(string,*,iostat=readStatus) IO_stringAsFloat if (readStatus /= 0) call IO_error(112,ext_msg=string) else valid - verifyFloatValue = 0.0_pReal + IO_stringAsFloat = 0.0_pReal call IO_error(112,ext_msg=string) endif valid -end function verifyFloatValue +end function IO_stringAsFloat + + +!-------------------------------------------------------------------------------------------------- +!> @brief return verified logical value in given string +!-------------------------------------------------------------------------------------------------- +logical function IO_stringAsBool(string) + + character(len=*), intent(in) :: string !< string for conversion to int value + + if (trim(adjustl(string)) == 'True') then + IO_stringAsBool = .true. + elseif (trim(adjustl(string)) == 'False') then + IO_stringAsBool = .false. + else + IO_stringAsBool = .false. + call IO_error(113,ext_msg=string) + endif + +end function IO_stringAsBool + + +!-------------------------------------------------------------------------------------------------- +! @brief Remove comments (characters beyond '#') and trailing space +! ToDo: Discuss name (the trim aspect is not clear) +!-------------------------------------------------------------------------------------------------- +function IO_rmComment(line) + + character(len=*), intent(in) :: line + character(len=:), allocatable :: IO_rmComment + integer :: split + + split = index(line,IO_COMMENT) + + if (split == 0) then + IO_rmComment = trim(line) + else + IO_rmComment = trim(line(:split-1)) + endif + +end function IO_rmComment !-------------------------------------------------------------------------------------------------- @@ -659,14 +701,19 @@ subroutine unitTest integer, dimension(:), allocatable :: chunkPos character(len=:), allocatable :: str - if(dNeq(1.0_pReal, verifyFloatValue('1.0'))) call IO_error(0,ext_msg='verifyFloatValue') - if(dNeq(1.0_pReal, verifyFloatValue('1e0'))) call IO_error(0,ext_msg='verifyFloatValue') - if(dNeq(0.1_pReal, verifyFloatValue('1e-1'))) call IO_error(0,ext_msg='verifyFloatValue') + if(dNeq(1.0_pReal, IO_stringAsFloat('1.0'))) call IO_error(0,ext_msg='IO_stringAsFloat') + if(dNeq(1.0_pReal, IO_stringAsFloat('1e0'))) call IO_error(0,ext_msg='IO_stringAsFloat') + if(dNeq(0.1_pReal, IO_stringAsFloat('1e-1'))) call IO_error(0,ext_msg='IO_stringAsFloat') - if(3112019 /= verifyIntValue( '3112019')) call IO_error(0,ext_msg='verifyIntValue') - if(3112019 /= verifyIntValue(' 3112019')) call IO_error(0,ext_msg='verifyIntValue') - if(-3112019 /= verifyIntValue('-3112019')) call IO_error(0,ext_msg='verifyIntValue') - if(3112019 /= verifyIntValue('+3112019 ')) call IO_error(0,ext_msg='verifyIntValue') + if(3112019 /= IO_stringAsInt( '3112019')) call IO_error(0,ext_msg='IO_stringAsInt') + if(3112019 /= IO_stringAsInt(' 3112019')) call IO_error(0,ext_msg='IO_stringAsInt') + if(-3112019 /= IO_stringAsInt('-3112019')) call IO_error(0,ext_msg='IO_stringAsInt') + if(3112019 /= IO_stringAsInt('+3112019 ')) call IO_error(0,ext_msg='IO_stringAsInt') + + if(.not. IO_stringAsBool(' True')) call IO_error(0,ext_msg='IO_stringAsBool') + if(.not. IO_stringAsBool(' True ')) call IO_error(0,ext_msg='IO_stringAsBool') + if( IO_stringAsBool(' False')) call IO_error(0,ext_msg='IO_stringAsBool') + if( IO_stringAsBool('False')) call IO_error(0,ext_msg='IO_stringAsBool') if(any([1,1,1] /= IO_stringPos('a'))) call IO_error(0,ext_msg='IO_stringPos') if(any([2,2,3,5,5] /= IO_stringPos(' aa b'))) call IO_error(0,ext_msg='IO_stringPos') @@ -683,6 +730,21 @@ subroutine unitTest if(.not. IO_isBlank(' #isBlank')) call IO_error(0,ext_msg='IO_isBlank/2') if( IO_isBlank(' i#s')) call IO_error(0,ext_msg='IO_isBlank/3') + str = IO_rmComment('#') + if (str /= '' .or. len(str) /= 0) call IO_error(0,ext_msg='IO_rmComment/1') + str = IO_rmComment(' #') + if (str /= '' .or. len(str) /= 0) call IO_error(0,ext_msg='IO_rmComment/2') + str = IO_rmComment(' # ') + if (str /= '' .or. len(str) /= 0) call IO_error(0,ext_msg='IO_rmComment/3') + str = IO_rmComment(' # a') + if (str /= '' .or. len(str) /= 0) call IO_error(0,ext_msg='IO_rmComment/4') + str = IO_rmComment(' # a') + if (str /= '' .or. len(str) /= 0) call IO_error(0,ext_msg='IO_rmComment/5') + str = IO_rmComment(' a#') + if (str /= ' a' .or. len(str) /= 2) call IO_error(0,ext_msg='IO_rmComment/6') + str = IO_rmComment(' ab #') + if (str /= ' ab'.or. len(str) /= 3) call IO_error(0,ext_msg='IO_rmComment/7') + end subroutine unitTest end module IO From c4bcd3b430268516fa788fa7257fe489628a4be8 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 22 Apr 2020 12:52:47 +0200 Subject: [PATCH 02/15] Functions needed to store and read yaml data --- src/CPFEM.f90 | 2 + src/CPFEM2.f90 | 2 + src/YAML_types.f90 | 977 +++++++++++++++++++++++++++++++++ src/commercialFEM_fileList.f90 | 1 + 4 files changed, 982 insertions(+) create mode 100644 src/YAML_types.f90 diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index c590a86b5..f26d4d064 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -10,6 +10,7 @@ module CPFEM use FEsolving use math use rotations + use types use discretization_marc use material use config @@ -83,6 +84,7 @@ subroutine CPFEM_initAll(el,ip) call config_init call math_init call rotations_init + call types_init call HDF5_utilities_init call results_init call discretization_marc_init(ip, el) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 357bcce9f..2893b4759 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -11,6 +11,7 @@ module CPFEM2 use FEsolving use math use rotations + use types use material use lattice use IO @@ -50,6 +51,7 @@ subroutine CPFEM_initAll call config_init call math_init call rotations_init + call types_init call lattice_init call HDF5_utilities_init call results_init diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 new file mode 100644 index 000000000..165a34033 --- /dev/null +++ b/src/YAML_types.f90 @@ -0,0 +1,977 @@ +!-------------------------------------------------------------------------------------------------- +!> @brief yaml_types +!> @details module describes the various functions to store and get the yaml data. +!! tNode is the fundamental derived data type. It can be of tScalar, & +!! tList or tDict. +!! Every 'value' in a key: value pair is of tNode and is a pointer. +!! If 'value' is of tScalar, it can either be a string, real, integer or logical, & +!! functions exist to convert this scalar type to its respective primitive data type. +!-------------------------------------------------------------------------------------------------- + +module types + + use IO + use prec + + implicit none + + private + + public tNode + public tScalar + public tDict + public tList + public types_init + + type, abstract :: tNode + integer :: length = 0 + contains + procedure(asFormattedString), deferred :: asFormattedString + procedure :: & + asScalar => tNode_asScalar + procedure :: & + asList => tNode_asList + procedure :: & + asDict => tNode_asDict + procedure :: & + tNode_get_byIndex, & + tNode_get_byIndex_asFloat, & + tNode_get_byIndex_asFloats, & + tNode_get_byIndex_asInt, & + tNode_get_byIndex_asInts, & + tNode_get_byIndex_asBool, & + tNode_get_byIndex_asBools, & + tNode_get_byIndex_asString, & + tNode_get_byIndex_asStrings, & + tNode_get_byKey, & + tNode_get_byKey_asFloat, & + tNode_get_byKey_asFloats, & + tNode_get_byKey_asInt, & + tNode_get_byKey_asInts, & + tNode_get_byKey_asBool, & + tNode_get_byKey_asBools, & + tNode_get_byKey_asString, & + tNode_get_byKey_asStrings + generic :: & + get => tNode_get_byIndex, & + tNode_get_byKey + generic :: & + get_asFloat => tNode_get_byIndex_asFloat, & + tNode_get_byKey_asFloat + generic :: & + get_asFloats => tNode_get_byIndex_asFloats, & + tNode_get_byKey_asFloats + generic :: & + get_asInt => tNode_get_byIndex_asInt, & + tNode_get_byKey_asInt + generic :: & + get_asInts => tNode_get_byIndex_asInts, & + tNode_get_byKey_asInts + generic :: & + get_asBool => tNode_get_byIndex_asBool, & + tNode_get_byKey_asBool + generic :: & + get_asBools => tNode_get_byIndex_asBools, & + tNode_get_byKey_asBools + generic :: & + get_asString => tNode_get_byIndex_asString, & + tNode_get_byKey_asString + generic :: & + get_asStrings => tNode_get_byIndex_asStrings, & + tNode_get_byKey_asStrings + end type tNode + + + type, extends(tNode) :: tScalar + + character(len=:), allocatable, private :: value + + contains + procedure :: asFormattedString => tScalar_asFormattedString + procedure :: & + asFloat => tScalar_asFloat + procedure :: & + asInt => tScalar_asInt + procedure :: & + asBool => tScalar_asBool + procedure :: & + asString => tScalar_asString + end type tScalar + + type, extends(tNode) :: tList + + class(tItem), pointer :: first => null() + + contains + procedure :: asFormattedString => tList_asFormattedString + procedure :: append => tList_append + procedure :: & + asFloats => tList_asFloats + procedure :: & + asInts => tList_asInts + procedure :: & + asBools => tList_asBools + procedure :: & + asStrings => tList_asStrings + final :: tList_finalize + end type tList + + type, extends(tList) :: tDict + contains + procedure :: asFormattedString => tDict_asFormattedString + procedure :: set => tDict_set + final :: tDict_finalize + end type tDict + + + type :: tItem + character(len=:), allocatable :: key + class(tNode), allocatable :: node + class(tItem), pointer :: next => null() + end type tItem + + abstract interface + + recursive function asFormattedString(self,indent) + import tNode + character(len=:), allocatable :: asFormattedString + class(tNode), intent(in), target :: self + integer, intent(in), optional :: indent + end function asFormattedString + + end interface + + interface tScalar + module procedure tScalar_init__ + end interface tScalar + + interface assignment (=) + module procedure tScalar_assign__ + end interface assignment (=) + +contains + +subroutine types_init + call unitTest +end subroutine types_init + + +subroutine unitTest + + type(tScalar),target :: s1,s2 + + s1 = '1' + if(s1%asInt() /= 1) call IO_error(0,ext_msg='tScalar_asInt') + if(dNeq(s1%asFloat(),1.0_pReal)) call IO_error(0,ext_msg='tScalar_asFloat') + s1 = 'True' + if(.not. s1%asBool()) call IO_error(0,ext_msg='tScalar_asBool') + if(s1%asString() /= 'True') call IO_error(0,ext_msg='tScalar_asString') + + + block + type(tList), target :: l1, l2 + class(tNode), pointer :: n + + s1 = '2' + s2 = '3' + call l1%append(s1) + call l1%append(s2) + call l2%append(l1) + n => l1 + + if(any(l1%asInts() /= [2,3])) call IO_error(0,ext_msg='tList_asInts') + if(any(dNeq(l1%asFloats(),[2.0_pReal,3.0_pReal]))) call IO_error(0,ext_msg='tList_asFloats') + if(n%get_asInt(1) /= 2) call IO_error(0,ext_msg='byIndex_asInt') + if(dNeq(n%get_asFloat(2),3.0_pReal)) call IO_error(0,ext_msg='byIndex_asFloat') + if(any(l2%get_asInts(1) /= [2,3])) call IO_error(0,ext_msg='byIndex_asInts') + if(any(dNeq(l2%get_asFloats(1),[2.0_pReal,3.0_pReal]))) call IO_error(0,ext_msg='byIndex_asFloats') + end block + + block + type(tList), target :: l1, l2 + class(tNode), pointer :: n + s1 = 'True' + s2 = 'False' + call l1%append(s1) + call l1%append(s2) + call l2%append(l1) + n=> l1 + + if(any(l1%asBools() .neqv. [.true., .false.])) call IO_error(0,ext_msg='tList_asBools') + if(any(l1%asStrings() /= ['True ','False'])) call IO_error(0,ext_msg='tList_asStrings') + if(n%get_asBool(2)) call IO_error(0,ext_msg='byIndex_asBool') + if(n%get_asString(1) /= 'True') call IO_error(0,ext_msg='byIndex_asString') + if(any(l2%get_asBools(1) .neqv. [.true., .false.])) call IO_error(0,ext_msg='byIndex_asBools') + if(any(l2%get_asStrings(1) /= ['True ','False'])) call IO_error(0,ext_msg='byIndex_asStrings') + end block + +end subroutine unitTest + + +!--------------------------------------------------------------------------------------------------- +!> @brief init from string +!--------------------------------------------------------------------------------------------------- +type(tScalar) pure function tScalar_init__(value) + + character(len=*), intent(in) :: value + + tScalar_init__%value =value + +end function tScalar_init__ + + +!--------------------------------------------------------------------------------------------------- +!> @brief set value from string +!--------------------------------------------------------------------------------------------------- +elemental pure subroutine tScalar_assign__(self,value) + + type(tScalar), intent(out) :: self + character(len=*), intent(in) :: value + + self%value = value + +end subroutine tScalar_assign__ + + +!-------------------------------------------------------------------------------------------------- +!> @brief Type guard, guarantee scalar +!-------------------------------------------------------------------------------------------------- +function tNode_asScalar(self) result(scalar) + + class(tNode), intent(in), target :: self + class(tScalar), pointer :: scalar + + select type(self) + class is(tScalar) + scalar => self + class default + call IO_error(0) + end select + +end function tNode_asScalar + + +!-------------------------------------------------------------------------------------------------- +!> @brief Type guard, guarantee list +!-------------------------------------------------------------------------------------------------- +function tNode_asList(self) result(list) + + class(tNode), intent(in), target :: self + class(tList), pointer :: list + + select type(self) + class is(tList) + list => self + class default + call IO_error(0) + end select + +end function tNode_asList + + +!-------------------------------------------------------------------------------------------------- +!> @brief Type guard, guarantee dict +!-------------------------------------------------------------------------------------------------- +function tNode_asDict(self) result(dict) + + class(tNode), intent(in), target :: self + class(tDict), pointer :: dict + + select type(self) + class is(tDict) + dict => self + class default + call IO_error(0) + 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 + + self_ => self%asList() + if(i < 1 .or. i > self_%length) call IO_error(0) + + j = 1 + item => self_%first + do while(j item%next + j = j + 1 + enddo + 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), target :: self + integer, intent(in) :: i + real(pReal) :: nodeAsFloat + + class(tNode), pointer :: node + type(tScalar), pointer :: scalar + + node => self%get(i) + scalar => node%asScalar() + nodeAsFloat = scalar%asFloat() + +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), target :: self + integer, intent(in) :: i + integer :: nodeAsInt + + class(tNode), pointer :: node + type(tScalar), pointer :: scalar + + node => self%get(i) + scalar => node%asScalar() + nodeAsInt = scalar%asInt() + +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), target :: self + integer, intent(in) :: i + logical :: nodeAsBool + + class(tNode), pointer :: node + type(tScalar), pointer :: scalar + + node => self%get(i) + scalar => node%asScalar() + nodeAsBool = scalar%asBool() + +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), target :: self + integer, intent(in) :: i + character(len=:), allocatable :: nodeAsString + + class(tNode), pointer :: node + type(tScalar), pointer :: scalar + + node => self%get(i) + scalar => node%asScalar() + nodeAsString = scalar%asString() + +end function tNode_get_byIndex_asString + + +!-------------------------------------------------------------------------------------------------- +!> @brief Access by index and convert to float array +!-------------------------------------------------------------------------------------------------- +function tNode_get_byIndex_asFloats(self,i) result(nodeAsFloats) + + class(tNode), intent(in), target :: self + integer, intent(in) :: i + real(pReal), dimension(:), allocatable :: nodeAsFloats + + class(tNode), pointer :: node + class(tList), pointer :: list + + node => self%get(i) + list => node%asList() + nodeAsFloats = list%asFloats() + +end function tNode_get_byIndex_asFloats + + +!-------------------------------------------------------------------------------------------------- +!> @brief Access by index and convert to int array +!-------------------------------------------------------------------------------------------------- +function tNode_get_byIndex_asInts(self,i) result(nodeAsInts) + + class(tNode), intent(in), target :: self + integer, intent(in) :: i + integer, dimension(:), allocatable :: nodeAsInts + + class(tNode), pointer :: node + class(tList), pointer :: list + + node => self%get(i) + list => node%asList() + nodeAsInts = list%asInts() + +end function tNode_get_byIndex_asInts + + +!-------------------------------------------------------------------------------------------------- +!> @brief Access by index and convert to bool array +!-------------------------------------------------------------------------------------------------- +function tNode_get_byIndex_asBools(self,i) result(nodeAsBools) + + class(tNode), intent(in), target :: self + integer, intent(in) :: i + logical, dimension(:), allocatable :: nodeAsBools + + class(tNode), pointer :: node + class(tList), pointer :: list + + node => self%get(i) + list => node%asList() + nodeAsBools = list%asBools() + +end function tNode_get_byIndex_asBools + + +!-------------------------------------------------------------------------------------------------- +!> @brief Access by index and convert to string array +!-------------------------------------------------------------------------------------------------- +function tNode_get_byIndex_asStrings(self,i) result(nodeAsStrings) + + class(tNode), intent(in), target :: self + integer, intent(in) :: i + character(len=:), allocatable, dimension(:) :: nodeAsStrings + + class(tNode), pointer :: node + type(tList), pointer :: list + + node => self%get(i) + list => node%asList() + nodeAsStrings = list%asStrings() + +end function tNode_get_byIndex_asStrings + + +!-------------------------------------------------------------------------------------------------- +!> @brief Access by index +!-------------------------------------------------------------------------------------------------- +function tNode_get_byKey(self,k) result(node) + + class(tNode), intent(in), target :: self + character(len=*), intent(in) :: k + class(tNode), pointer :: node + + type(tDict), pointer :: self_ + type(tItem), pointer :: item + integer :: j + + self_ => self%asDict() + + j = 1 + item => self_%first + do while(j <= self_%length) + if (item%key == k) exit + item => item%next + j = j + 1 + enddo + if (.not. item%key == k) call IO_error(0) + node => item%node + +end function tNode_get_byKey + + +!-------------------------------------------------------------------------------------------------- +!> @brief Access by key and convert to float +!-------------------------------------------------------------------------------------------------- +function tNode_get_byKey_asFloat(self,k) result(nodeAsFloat) + + class(tNode), intent(in), target :: self + character(len=*), intent(in) :: k + real(pReal) :: nodeAsFloat + + class(tNode), pointer :: node + type(tScalar), pointer :: scalar + + node => self%get(k) + scalar => node%asScalar() + nodeAsFloat = scalar%asFloat() + +end function tNode_get_byKey_asFloat + + +!-------------------------------------------------------------------------------------------------- +!> @brief Access by key and convert to int +!-------------------------------------------------------------------------------------------------- +function tNode_get_byKey_asInt(self,k) result(nodeAsInt) + + class(tNode), intent(in), target :: self + character(len=*), intent(in) :: k + integer :: nodeAsInt + + class(tNode), pointer :: node + type(tScalar), pointer :: scalar + + node => self%get(k) + scalar => node%asScalar() + nodeAsInt = scalar%asInt() + +end function tNode_get_byKey_asInt + + +!-------------------------------------------------------------------------------------------------- +!> @brief Access by key and convert to bool +!-------------------------------------------------------------------------------------------------- +function tNode_get_byKey_asBool(self,k) result(nodeAsBool) + + class(tNode), intent(in), target :: self + character(len=*), intent(in) :: k + logical :: nodeAsBool + + class(tNode), pointer :: node + type(tScalar), pointer :: scalar + + node => self%get(k) + scalar => node%asScalar() + nodeAsBool = scalar%asBool() + +end function tNode_get_byKey_asBool + + +!-------------------------------------------------------------------------------------------------- +!> @brief Access by key and convert to string +!-------------------------------------------------------------------------------------------------- +function tNode_get_byKey_asString(self,k) result(nodeAsString) + + class(tNode), intent(in), target :: self + character(len=*), intent(in) :: k + character(len=:), allocatable :: nodeAsString + + class(tNode), pointer :: node + type(tScalar), pointer :: scalar + + node => self%get(k) + scalar => node%asScalar() + nodeAsString = scalar%asString() + +end function tNode_get_byKey_asString + + +!-------------------------------------------------------------------------------------------------- +!> @brief Access by key and convert to float array +!-------------------------------------------------------------------------------------------------- +function tNode_get_byKey_asFloats(self,k) result(nodeAsFloats) + + class(tNode), intent(in), target :: self + character(len=*), intent(in) :: k + real(pReal), dimension(:), allocatable :: nodeAsFloats + + class(tNode), pointer :: node + type(tList), pointer :: list + + node => self%get(k) + list => node%asList() + nodeAsFloats = list%asFloats() + +end function tNode_get_byKey_asFloats + + +!-------------------------------------------------------------------------------------------------- +!> @brief Access by key and convert to int array +!-------------------------------------------------------------------------------------------------- +function tNode_get_byKey_asInts(self,k) result(nodeAsInts) + + class(tNode), intent(in), target :: self + character(len=*), intent(in) :: k + integer, dimension(:), allocatable :: nodeAsInts + + class(tNode), pointer :: node + type(tList), pointer :: list + + node => self%get(k) + list => node%asList() + nodeAsInts = list%asInts() + +end function tNode_get_byKey_asInts + + +!-------------------------------------------------------------------------------------------------- +!> @brief Access by key and convert to bool array +!-------------------------------------------------------------------------------------------------- +function tNode_get_byKey_asBools(self,k) result(nodeAsBools) + + class(tNode), intent(in), target :: self + character(len=*), intent(in) :: k + logical, dimension(:), allocatable :: nodeAsBools + + class(tNode), pointer :: node + type(tList), pointer :: list + + node => self%get(k) + list => node%asList() + nodeAsBools = list%asBools() + +end function tNode_get_byKey_asBools + + +!-------------------------------------------------------------------------------------------------- +!> @brief Access by key and convert to string array +!-------------------------------------------------------------------------------------------------- +function tNode_get_byKey_asStrings(self,k) result(nodeAsStrings) + + class(tNode), intent(in), target :: self + character(len=*), intent(in) :: k + character(len=:), allocatable, dimension(:) :: nodeAsStrings + + class(tNode), pointer :: node + type(tList), pointer :: list + + node => self%get(k) + list => node%asList() + nodeAsStrings = list%asStrings() + +end function tNode_get_byKey_asStrings + + +!-------------------------------------------------------------------------------------------------- +!> @brief Return scalar as string +!-------------------------------------------------------------------------------------------------- +recursive function tScalar_asFormattedString(self,indent) + + character(len=:), allocatable :: tScalar_asFormattedString + class(tScalar), intent(in), target :: self + integer, intent(in), optional :: indent + + integer :: indent_ + + if(present(indent)) then + indent_ = indent + else + indent_ = 0 + endif + + tScalar_asFormattedString = repeat(' ',indent_)//trim(self%value)//IO_EOL + +end function tScalar_asFormattedString + + +!-------------------------------------------------------------------------------------------------- +!> @brief Return 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 + + class(tItem), pointer :: item + character(len=:), allocatable :: str + integer :: i,indent_ + + if(present(indent)) then + indent_ = indent + else + indent_ = 0 + endif + + item => self%first + do i = 1, self%length + str = str//repeat(' ',indent_)//'-'//IO_EOL//item%node%asFormattedString(indent_+2) + item => item%next + enddo + +end function tList_asFormattedString + + +!-------------------------------------------------------------------------------------------------- +!> @brief Return 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 + + class(tItem), pointer :: item + character(len=:), allocatable :: str + integer :: i,indent_ + + if(present(indent)) then + indent_ = indent + else + indent_ = 0 + endif + + item => self%first + do i = 1, self%length + str = str//repeat(' ',indent_)//item%key//':'//IO_EOL//item%node%asFormattedString(indent_+2) + item => item%next + enddo + +end function tDict_asFormattedString + + +!-------------------------------------------------------------------------------------------------- +!> @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 +!-------------------------------------------------------------------------------------------------- +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 +!-------------------------------------------------------------------------------------------------- +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 +!-------------------------------------------------------------------------------------------------- +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 +!-------------------------------------------------------------------------------------------------- +function tList_asFloats(self) + + class(tList), intent(in), target :: self + real(pReal), dimension(:), allocatable :: tList_asFloats + + integer :: i + type(tItem), pointer :: item + type(tScalar), pointer :: scalar + + allocate(tList_asFloats(self%length)) + item => self%first + do i = 1, self%length + scalar => item%node%asScalar() + tList_asFloats(i) = scalar%asFloat() + item => item%next + enddo + +end function tList_asFloats + + +!-------------------------------------------------------------------------------------------------- +!> @brief Convert to int array +!-------------------------------------------------------------------------------------------------- +function tList_asInts(self) + + class(tList), intent(in), target :: self + integer, dimension(:), allocatable :: tList_asInts + + integer :: i + type(tItem), pointer :: item + type(tScalar), pointer :: scalar + + allocate(tList_asInts(self%length)) + item => self%first + do i = 1, self%length + scalar => item%node%asScalar() + tList_asInts(i) = scalar%asInt() + item => item%next + enddo + +end function tList_asInts + + +!-------------------------------------------------------------------------------------------------- +!> @brief Convert to bool array +!-------------------------------------------------------------------------------------------------- +function tList_asBools(self) + + class(tList), intent(in), target :: self + logical, dimension(:), allocatable :: tList_asBools + + integer :: i + type(tItem), pointer :: item + type(tScalar), pointer :: scalar + + allocate(tList_asBools(self%length)) + item => self%first + do i = 1, self%length + scalar => item%node%asScalar() + tList_asBools(i) = scalar%asBool() + item => item%next + enddo + +end function tList_asBools + + +!-------------------------------------------------------------------------------------------------- +!> @brief Convert to string array +!-------------------------------------------------------------------------------------------------- +function tList_asStrings(self) + + class(tList), intent(in), target :: self + character(len=:), allocatable, dimension(:) :: tList_asStrings + + integer :: i,len_max + type(tItem), pointer :: item + type(tScalar), pointer :: scalar + + len_max = 0 + allocate(character(len=pStringLen) :: tList_asStrings(self%length)) + item => self%first + do i = 1, self%length + scalar => item%node%asScalar() + tList_asStrings(i) = scalar%asString() + len_max = max(len_max, len_trim(tList_asStrings(i))) + item => item%next + enddo + + !ToDo: trim to len_max + +end function tList_asStrings + + +!-------------------------------------------------------------------------------------------------- +!> @brief Append element +!-------------------------------------------------------------------------------------------------- +subroutine tList_append(self,node) + + class(tList), intent(inout) :: self + class(tNode), intent(in) :: node + + type(tItem), pointer :: item + + if (.not. associated(self%first)) then + allocate(self%first) + item => self%first + else + item => self%first + do while (associated(item%next)) + item => item%next + end do + allocate(item%next) + item => item%next + end if + + allocate(item%node,source=node) ! ToDo: Discuss ownership (copy vs referencing) + self%length = self%length + 1 + +end subroutine tList_append + + +!-------------------------------------------------------------------------------------------------- +!> @brief Set the value of a key (either replace or add new) +!-------------------------------------------------------------------------------------------------- +subroutine tDict_set(self,key,node) + + class (tDict), intent(inout) :: self + character(len=*), intent(in) :: key + class(tNode), intent(in) :: node + + type(tItem), pointer :: item + + if (.not.associated(self%first)) then + allocate(self%first) + item => self%first + self%length = 1 + else + item => self%first + searchExisting: do while (associated(item%next)) + if (item%key == key) exit + item => item%next + end do searchExisting + if (.not. item%key == key) then + allocate(item%next) + item => item%next + self%length = self%length + 1 + end if + end if + + item%key = key + allocate(item%node,source=node) ! ToDo: Discuss ownership (copy vs referencing) + +end subroutine tDict_set + + +!-------------------------------------------------------------------------------------------------- +!> @brief empties dictionary and frees associated memory +!> @details called when variable goes out of scope. Triggers a chain reaction +!-------------------------------------------------------------------------------------------------- +recursive subroutine tDict_finalize(self) + + type (tDict),intent(inout) :: self + + type (tItem),pointer :: current, & + next + current => self%first + do while (associated(current)) + next => current%next + deallocate(current%node) + current => next + end do + nullify(self%first) + +end subroutine tDict_finalize + + +!-------------------------------------------------------------------------------------------------- +!> @brief empties lists and free associated memory +!> @details called when variable goes out of scope. +!-------------------------------------------------------------------------------------------------- +recursive subroutine tList_finalize(self) + + type (tList),intent(inout) :: self + + type (tItem),pointer :: current, & + next + current => self%first + do while (associated(current)) + next => current%next + deallocate(current%node) + current => next + end do + nullify(self%first) + +end subroutine tList_finalize + + +end module types diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 64ad3e1d7..f13778f01 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -7,6 +7,7 @@ #include "numerics.f90" #include "debug.f90" #include "list.f90" +#include "YAML_types.f90" #include "future.f90" #include "config.f90" #include "LAPACK_interface.f90" From 6a0a8f1d275e88a5788045b85600f74f06f96794 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 22 Apr 2020 15:51:05 +0200 Subject: [PATCH 03/15] Fortran syntax check showed an error --- src/YAML_types.f90 | 54 ++++++++++++++++++++++++++++++---------------- 1 file changed, 36 insertions(+), 18 deletions(-) diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index 165a34033..049029203 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -33,25 +33,43 @@ module types asList => tNode_asList procedure :: & asDict => tNode_asDict + procedure :: & + tNode_get_byIndex => tNode_get_byIndex procedure :: & - tNode_get_byIndex, & - tNode_get_byIndex_asFloat, & - tNode_get_byIndex_asFloats, & - tNode_get_byIndex_asInt, & - tNode_get_byIndex_asInts, & - tNode_get_byIndex_asBool, & - tNode_get_byIndex_asBools, & - tNode_get_byIndex_asString, & - tNode_get_byIndex_asStrings, & - tNode_get_byKey, & - tNode_get_byKey_asFloat, & - tNode_get_byKey_asFloats, & - tNode_get_byKey_asInt, & - tNode_get_byKey_asInts, & - tNode_get_byKey_asBool, & - tNode_get_byKey_asBools, & - tNode_get_byKey_asString, & - tNode_get_byKey_asStrings + tNode_get_byIndex_asFloat => tNode_get_byIndex_asFloat + procedure :: & + tNode_get_byIndex_asFloats => tNode_get_byIndex_asFloats + procedure :: & + tNode_get_byIndex_asInt => tNode_get_byIndex_asInt + procedure :: & + tNode_get_byIndex_asInts => tNode_get_byIndex_asInts + procedure :: & + tNode_get_byIndex_asBool => tNode_get_byIndex_asBool + procedure :: & + tNode_get_byIndex_asBools => tNode_get_byIndex_asBools + procedure :: & + tNode_get_byIndex_asString => tNode_get_byIndex_asString + procedure :: & + tNode_get_byIndex_asStrings => tNode_get_byIndex_asStrings + procedure :: & + tNode_get_byKey => tNode_get_byKey + procedure :: & + tNode_get_byKey_asFloat => tNode_get_byKey_asFloat + procedure :: & + tNode_get_byKey_asFloats => tNode_get_byKey_asFloats + procedure :: & + tNode_get_byKey_asInt => tNode_get_byKey_asInt + procedure :: & + tNode_get_byKey_asInts => tNode_get_byKey_asInts + procedure :: & + tNode_get_byKey_asBool => tNode_get_byKey_asBool + procedure :: & + tNode_get_byKey_asBools => tNode_get_byKey_asBools + procedure :: & + tNode_get_byKey_asString => tNode_get_byKey_asString + procedure :: & + tNode_get_byKey_asStrings => tNode_get_byKey_asStrings + generic :: & get => tNode_get_byIndex, & tNode_get_byKey From 11c4ff7787f2d980fd527f3d8f804a8df27e3ddc Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 22 Apr 2020 16:49:31 +0200 Subject: [PATCH 04/15] finalization error --- src/YAML_types.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index 049029203..2edff3a58 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -984,7 +984,7 @@ recursive subroutine tList_finalize(self) current => self%first do while (associated(current)) next => current%next - deallocate(current%node) + if(allocated(current%node)) deallocate(current%node) current => next end do nullify(self%first) From 7fe2a52b65eb8e22aeadb731a95818504e6c1f9d Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 23 Apr 2020 17:10:33 +0200 Subject: [PATCH 05/15] better logic for finalization --- src/YAML_types.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index 2edff3a58..e951c2c83 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -214,7 +214,7 @@ subroutine unitTest call l1%append(s2) call l2%append(l1) n=> l1 - + if(any(l1%asBools() .neqv. [.true., .false.])) call IO_error(0,ext_msg='tList_asBools') if(any(l1%asStrings() /= ['True ','False'])) call IO_error(0,ext_msg='tList_asStrings') if(n%get_asBool(2)) call IO_error(0,ext_msg='byIndex_asBool') @@ -960,13 +960,13 @@ recursive subroutine tDict_finalize(self) type (tItem),pointer :: current, & next + current => self%first do while (associated(current)) next => current%next - deallocate(current%node) + deallocate(current) current => next end do - nullify(self%first) end subroutine tDict_finalize @@ -981,13 +981,13 @@ recursive subroutine tList_finalize(self) type (tItem),pointer :: current, & next + current => self%first do while (associated(current)) next => current%next - if(allocated(current%node)) deallocate(current%node) + deallocate(current) current => next end do - nullify(self%first) end subroutine tList_finalize From ca6aa4bcd1ba6036aa0ac7d40c481085fe8c0046 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Fri, 24 Apr 2020 16:50:42 +0200 Subject: [PATCH 06/15] child type would inherit procedures from parent type --- src/YAML_types.f90 | 24 +----------------------- 1 file changed, 1 insertion(+), 23 deletions(-) diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index e951c2c83..9dba4fd37 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -138,7 +138,6 @@ module types contains procedure :: asFormattedString => tDict_asFormattedString procedure :: set => tDict_set - final :: tDict_finalize end type tDict @@ -951,28 +950,7 @@ end subroutine tDict_set !-------------------------------------------------------------------------------------------------- -!> @brief empties dictionary and frees associated memory -!> @details called when variable goes out of scope. Triggers a chain reaction -!-------------------------------------------------------------------------------------------------- -recursive subroutine tDict_finalize(self) - - type (tDict),intent(inout) :: self - - type (tItem),pointer :: current, & - next - - current => self%first - do while (associated(current)) - next => current%next - deallocate(current) - current => next - end do - -end subroutine tDict_finalize - - -!-------------------------------------------------------------------------------------------------- -!> @brief empties lists and free associated memory +!> @brief empties lists and dicts and free associated memory !> @details called when variable goes out of scope. !-------------------------------------------------------------------------------------------------- recursive subroutine tList_finalize(self) From f3be26ffa251330d2dbd10aa2f54d7ff6b1dd247 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 28 Apr 2020 10:05:36 +0200 Subject: [PATCH 07/15] long error and warning functions at the end of public methods --- src/IO.f90 | 170 ++++++++++++++++++++++++++--------------------------- 1 file changed, 85 insertions(+), 85 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 11ce664f8..1bd2df833 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -29,13 +29,13 @@ module IO IO_getTag, & IO_stringPos, & IO_stringValue, & - IO_floatValue, & IO_intValue, & + IO_floatValue, & + IO_lc, & + IO_rmComment, & IO_stringAsInt, & IO_stringAsFloat, & IO_stringAsBool, & - IO_rmComment, & - IO_lc, & IO_error, & IO_warning @@ -298,6 +298,88 @@ pure function IO_lc(string) end function IO_lc +!-------------------------------------------------------------------------------------------------- +! @brief Remove comments (characters beyond '#') and trailing space +! ToDo: Discuss name (the trim aspect is not clear) +!-------------------------------------------------------------------------------------------------- +function IO_rmComment(line) + + character(len=*), intent(in) :: line + character(len=:), allocatable :: IO_rmComment + integer :: split + + split = index(line,IO_COMMENT) + + if (split == 0) then + IO_rmComment = trim(line) + else + IO_rmComment = trim(line(:split-1)) + endif + +end function IO_rmComment + + +!-------------------------------------------------------------------------------------------------- +!> @brief return verified integer value in given string +!-------------------------------------------------------------------------------------------------- +integer function IO_stringAsInt(string) + + character(len=*), intent(in) :: string !< string for conversion to int value + + integer :: readStatus + character(len=*), parameter :: VALIDCHARS = '0123456789+- ' + + valid: if (verify(string,VALIDCHARS) == 0) then + read(string,*,iostat=readStatus) IO_stringAsInt + if (readStatus /= 0) call IO_error(111,ext_msg=string) + else valid + IO_stringAsInt = 0 + call IO_error(111,ext_msg=string) + endif valid + +end function IO_stringAsInt + + +!-------------------------------------------------------------------------------------------------- +!> @brief return verified float value in given string +!-------------------------------------------------------------------------------------------------- +real(pReal) function IO_stringAsFloat(string) + + character(len=*), intent(in) :: string !< string for conversion to float value + + integer :: readStatus + character(len=*), parameter :: VALIDCHARS = '0123456789eE.+- ' + + valid: if (verify(string,VALIDCHARS) == 0) then + read(string,*,iostat=readStatus) IO_stringAsFloat + if (readStatus /= 0) call IO_error(112,ext_msg=string) + else valid + IO_stringAsFloat = 0.0_pReal + call IO_error(112,ext_msg=string) + endif valid + +end function IO_stringAsFloat + + +!-------------------------------------------------------------------------------------------------- +!> @brief return verified logical value in given string +!-------------------------------------------------------------------------------------------------- +logical function IO_stringAsBool(string) + + character(len=*), intent(in) :: string !< string for conversion to int value + + if (trim(adjustl(string)) == 'True') then + IO_stringAsBool = .true. + elseif (trim(adjustl(string)) == 'False') then + IO_stringAsBool = .false. + else + IO_stringAsBool = .false. + call IO_error(113,ext_msg=string) + endif + +end function IO_stringAsBool + + !-------------------------------------------------------------------------------------------------- !> @brief write error statements to standard out and terminate the Marc/spectral run with exit #9xxx !-------------------------------------------------------------------------------------------------- @@ -611,88 +693,6 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg) end subroutine IO_warning -!-------------------------------------------------------------------------------------------------- -!> @brief return verified integer value in given string -!-------------------------------------------------------------------------------------------------- -integer function IO_stringAsInt(string) - - character(len=*), intent(in) :: string !< string for conversion to int value - - integer :: readStatus - character(len=*), parameter :: VALIDCHARS = '0123456789+- ' - - valid: if (verify(string,VALIDCHARS) == 0) then - read(string,*,iostat=readStatus) IO_stringAsInt - if (readStatus /= 0) call IO_error(111,ext_msg=string) - else valid - IO_stringAsInt = 0 - call IO_error(111,ext_msg=string) - endif valid - -end function IO_stringAsInt - - -!-------------------------------------------------------------------------------------------------- -!> @brief return verified float value in given string -!-------------------------------------------------------------------------------------------------- -real(pReal) function IO_stringAsFloat(string) - - character(len=*), intent(in) :: string !< string for conversion to float value - - integer :: readStatus - character(len=*), parameter :: VALIDCHARS = '0123456789eE.+- ' - - valid: if (verify(string,VALIDCHARS) == 0) then - read(string,*,iostat=readStatus) IO_stringAsFloat - if (readStatus /= 0) call IO_error(112,ext_msg=string) - else valid - IO_stringAsFloat = 0.0_pReal - call IO_error(112,ext_msg=string) - endif valid - -end function IO_stringAsFloat - - -!-------------------------------------------------------------------------------------------------- -!> @brief return verified logical value in given string -!-------------------------------------------------------------------------------------------------- -logical function IO_stringAsBool(string) - - character(len=*), intent(in) :: string !< string for conversion to int value - - if (trim(adjustl(string)) == 'True') then - IO_stringAsBool = .true. - elseif (trim(adjustl(string)) == 'False') then - IO_stringAsBool = .false. - else - IO_stringAsBool = .false. - call IO_error(113,ext_msg=string) - endif - -end function IO_stringAsBool - - -!-------------------------------------------------------------------------------------------------- -! @brief Remove comments (characters beyond '#') and trailing space -! ToDo: Discuss name (the trim aspect is not clear) -!-------------------------------------------------------------------------------------------------- -function IO_rmComment(line) - - character(len=*), intent(in) :: line - character(len=:), allocatable :: IO_rmComment - integer :: split - - split = index(line,IO_COMMENT) - - if (split == 0) then - IO_rmComment = trim(line) - else - IO_rmComment = trim(line(:split-1)) - endif - -end function IO_rmComment - - !-------------------------------------------------------------------------------------------------- !> @brief check correctness of some IO functions !-------------------------------------------------------------------------------------------------- From 20b604a334fee662a5905927440adaa7551f39af Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 28 Apr 2020 10:29:13 +0200 Subject: [PATCH 08/15] finalize does not work for gfortran --- src/CPFEM.f90 | 4 ++-- src/CPFEM2.f90 | 4 ++-- src/YAML_types.f90 | 49 +++++++++++++++++++++++++++++----------------- 3 files changed, 35 insertions(+), 22 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index f26d4d064..83ecf65a4 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -10,7 +10,7 @@ module CPFEM use FEsolving use math use rotations - use types + use YAML_types use discretization_marc use material use config @@ -84,7 +84,7 @@ subroutine CPFEM_initAll(el,ip) call config_init call math_init call rotations_init - call types_init + call YAML_types_init call HDF5_utilities_init call results_init call discretization_marc_init(ip, el) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 2893b4759..9f61e4ebd 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -11,7 +11,7 @@ module CPFEM2 use FEsolving use math use rotations - use types + use YAML_types use material use lattice use IO @@ -51,7 +51,7 @@ subroutine CPFEM_initAll call config_init call math_init call rotations_init - call types_init + call YAML_types_init call lattice_init call HDF5_utilities_init call results_init diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index 9dba4fd37..26f17430a 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -8,7 +8,7 @@ !! functions exist to convert this scalar type to its respective primitive data type. !-------------------------------------------------------------------------------------------------- -module types +module YAML_types use IO use prec @@ -17,11 +17,12 @@ module types private - public tNode - public tScalar - public tDict - public tList - public types_init + public :: & + tNode, & + tScalar, & + tDict, & + tList, & + YAML_types_init type, abstract :: tNode integer :: length = 0 @@ -69,7 +70,7 @@ module types tNode_get_byKey_asString => tNode_get_byKey_asString procedure :: & tNode_get_byKey_asStrings => tNode_get_byKey_asStrings - + generic :: & get => tNode_get_byIndex, & tNode_get_byKey @@ -102,7 +103,7 @@ module types type, extends(tNode) :: tScalar - character(len=:), allocatable, private :: value + character(len=:), allocatable, private :: value contains procedure :: asFormattedString => tScalar_asFormattedString @@ -117,7 +118,7 @@ module types end type tScalar type, extends(tNode) :: tList - + class(tItem), pointer :: first => null() contains @@ -131,7 +132,9 @@ module types asBools => tList_asBools procedure :: & asStrings => tList_asStrings +#ifndef __GFORTRAN__ final :: tList_finalize +#endif end type tList type, extends(tList) :: tDict @@ -168,14 +171,24 @@ module types contains -subroutine types_init +!-------------------------------------------------------------------------------------------------- +!> @brief do sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine YAML_types_init + + write(6,'(/,a)') ' <<<+- YAML_types init -+>>>' + call unitTest -end subroutine types_init + +end subroutine YAML_types_init +!-------------------------------------------------------------------------------------------------- +!> @brief check correctness of some type bound procedures +!-------------------------------------------------------------------------------------------------- subroutine unitTest - type(tScalar),target :: s1,s2 + type(tScalar),target :: s1,s2 s1 = '1' if(s1%asInt() /= 1) call IO_error(0,ext_msg='tScalar_asInt') @@ -213,7 +226,7 @@ subroutine unitTest call l1%append(s2) call l2%append(l1) n=> l1 - + if(any(l1%asBools() .neqv. [.true., .false.])) call IO_error(0,ext_msg='tList_asBools') if(any(l1%asStrings() /= ['True ','False'])) call IO_error(0,ext_msg='tList_asStrings') if(n%get_asBool(2)) call IO_error(0,ext_msg='byIndex_asBool') @@ -598,7 +611,7 @@ function tNode_get_byKey_asFloats(self,k) result(nodeAsFloats) class(tNode), pointer :: node type(tList), pointer :: list - + node => self%get(k) list => node%asList() nodeAsFloats = list%asFloats() @@ -926,7 +939,7 @@ subroutine tDict_set(self,key,node) type(tItem), pointer :: item - if (.not.associated(self%first)) then + if (.not. associated(self%first)) then allocate(self%first) item => self%first self%length = 1 @@ -944,7 +957,7 @@ subroutine tDict_set(self,key,node) end if item%key = key - allocate(item%node,source=node) ! ToDo: Discuss ownership (copy vs referencing) + allocate(item%node,source=node) end subroutine tDict_set @@ -959,7 +972,7 @@ recursive subroutine tList_finalize(self) type (tItem),pointer :: current, & next - + current => self%first do while (associated(current)) next => current%next @@ -970,4 +983,4 @@ recursive subroutine tList_finalize(self) end subroutine tList_finalize -end module types +end module YAML_types From 10710bc4460fe4286594c364d72adbac6375830f Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 30 Apr 2020 21:29:59 +0200 Subject: [PATCH 09/15] using pointers makes finalize general for GNU and Intel --- src/YAML_types.f90 | 253 ++++++++++++++++++++++++++++----------------- 1 file changed, 159 insertions(+), 94 deletions(-) diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index 26f17430a..7a53bdbd3 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -70,6 +70,8 @@ module YAML_types tNode_get_byKey_asString => tNode_get_byKey_asString procedure :: & tNode_get_byKey_asStrings => tNode_get_byKey_asStrings + procedure :: & + getIndex => tNode_get_byKey_asIndex generic :: & get => tNode_get_byIndex, & @@ -132,9 +134,7 @@ module YAML_types asBools => tList_asBools procedure :: & asStrings => tList_asStrings -#ifndef __GFORTRAN__ final :: tList_finalize -#endif end type tList type, extends(tList) :: tDict @@ -146,18 +146,20 @@ module YAML_types type :: tItem character(len=:), allocatable :: key - class(tNode), allocatable :: node + class(tNode), pointer :: node => null() class(tItem), pointer :: next => null() + + contains + final :: tItem_finalize end type tItem abstract interface - recursive function asFormattedString(self,indent) + recursive subroutine asFormattedString(self,indent) import tNode - character(len=:), allocatable :: asFormattedString class(tNode), intent(in), target :: self integer, intent(in), optional :: indent - end function asFormattedString + end subroutine asFormattedString end interface @@ -188,52 +190,76 @@ end subroutine YAML_types_init !-------------------------------------------------------------------------------------------------- subroutine unitTest - type(tScalar),target :: s1,s2 - - s1 = '1' - if(s1%asInt() /= 1) call IO_error(0,ext_msg='tScalar_asInt') - if(dNeq(s1%asFloat(),1.0_pReal)) call IO_error(0,ext_msg='tScalar_asFloat') - s1 = 'True' - if(.not. s1%asBool()) call IO_error(0,ext_msg='tScalar_asBool') - if(s1%asString() /= 'True') call IO_error(0,ext_msg='tScalar_asString') - + class(tNode), pointer :: s1,s2 + allocate(tScalar::s1) + allocate(tScalar::s2) + select type(s1) + class is(tScalar) + s1 = '1' + if(s1%asInt() /= 1) call IO_error(0,ext_msg='tScalar_asInt') + if(dNeq(s1%asFloat(),1.0_pReal)) call IO_error(0,ext_msg='tScalar_asFloat') + s1 = 'True' + if(.not. s1%asBool()) call IO_error(0,ext_msg='tScalar_asBool') + if(s1%asString() /= 'True') call IO_error(0,ext_msg='tScalar_asString') + end select block - type(tList), target :: l1, l2 - class(tNode), pointer :: n + class(tNode), pointer :: l1, l2, n + character(len=1) :: test = '2' + select type(s1) + class is(tScalar) + s1 = test + endselect + + select type(s2) + class is(tScalar) + s2 = '3' + endselect - s1 = '2' - s2 = '3' - call l1%append(s1) - call l1%append(s2) - call l2%append(l1) - n => l1 + allocate(tList::l1) + select type(l1) + class is(tList) + call l1%append(s1) + call l1%append(s2) + n => l1 + if(any(l1%asInts() /= [2,3])) call IO_error(0,ext_msg='tList_asInts') + if(any(dNeq(l1%asFloats(),[2.0_pReal,3.0_pReal]))) call IO_error(0,ext_msg='tList_asFloats') + if(n%get_asInt(1) /= 2) call IO_error(0,ext_msg='byIndex_asInt') + if(dNeq(n%get_asFloat(2),3.0_pReal)) call IO_error(0,ext_msg='byIndex_asFloat') + endselect + + allocate(tList::l2) + select type(l2) + class is(tList) + call l2%append(l1) + if(any(l2%get_asInts(1) /= [2,3])) call IO_error(0,ext_msg='byIndex_asInts') + if(any(dNeq(l2%get_asFloats(1),[2.0_pReal,3.0_pReal]))) call IO_error(0,ext_msg='byIndex_asFloats') + n => l2 + end select + deallocate(n) + end block - if(any(l1%asInts() /= [2,3])) call IO_error(0,ext_msg='tList_asInts') - if(any(dNeq(l1%asFloats(),[2.0_pReal,3.0_pReal]))) call IO_error(0,ext_msg='tList_asFloats') - if(n%get_asInt(1) /= 2) call IO_error(0,ext_msg='byIndex_asInt') - if(dNeq(n%get_asFloat(2),3.0_pReal)) call IO_error(0,ext_msg='byIndex_asFloat') - if(any(l2%get_asInts(1) /= [2,3])) call IO_error(0,ext_msg='byIndex_asInts') - if(any(dNeq(l2%get_asFloats(1),[2.0_pReal,3.0_pReal]))) call IO_error(0,ext_msg='byIndex_asFloats') - end block - - block - type(tList), target :: l1, l2 - class(tNode), pointer :: n - s1 = 'True' - s2 = 'False' - call l1%append(s1) - call l1%append(s2) - call l2%append(l1) - n=> l1 - - if(any(l1%asBools() .neqv. [.true., .false.])) call IO_error(0,ext_msg='tList_asBools') - if(any(l1%asStrings() /= ['True ','False'])) call IO_error(0,ext_msg='tList_asStrings') - if(n%get_asBool(2)) call IO_error(0,ext_msg='byIndex_asBool') - if(n%get_asString(1) /= 'True') call IO_error(0,ext_msg='byIndex_asString') - if(any(l2%get_asBools(1) .neqv. [.true., .false.])) call IO_error(0,ext_msg='byIndex_asBools') - if(any(l2%get_asStrings(1) /= ['True ','False'])) call IO_error(0,ext_msg='byIndex_asStrings') - 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%asBools() .neqv. [.true., .false.])) call IO_error(0,ext_msg='tList_asBools') + if(any(l1%asStrings() /= ['True ','False'])) call IO_error(0,ext_msg='tList_asStrings') + if(n%get_asBool(2)) call IO_error(0,ext_msg='byIndex_asBool') + if(n%get_asString(1) /= 'True') call IO_error(0,ext_msg='byIndex_asString') + end block end subroutine unitTest @@ -676,14 +702,40 @@ function tNode_get_byKey_asStrings(self,k) result(nodeAsStrings) end function tNode_get_byKey_asStrings -!-------------------------------------------------------------------------------------------------- -!> @brief Return scalar as string -!-------------------------------------------------------------------------------------------------- -recursive function tScalar_asFormattedString(self,indent) +!------------------------------------------------------------------------------------------------------- +!> @brief Returns the index of a key in a dictionary +!------------------------------------------------------------------------------------------------------- +function tNode_get_byKey_asIndex(self,key) result(keyIndex) - character(len=:), allocatable :: tScalar_asFormattedString - class(tScalar), intent(in), target :: self - integer, intent(in), optional :: indent + class(tNode), intent(in), target :: self + character(len=*), intent(in) :: key + + integer :: keyIndex + integer :: i + type(tDict), pointer :: dict + type(tItem), pointer :: item + + dict => self%asDict() + item => dict%first + do i = 1, dict%length + if(key == item%key) then + keyIndex = i + exit + else + item => item%next + endif + enddo + +end function tNode_get_byKey_asIndex + + +!-------------------------------------------------------------------------------------------------- +!> @brief Prints scalar as string +!-------------------------------------------------------------------------------------------------- +recursive subroutine tScalar_asFormattedString(self,indent) + + class (tScalar), intent(in), target :: self + integer, intent(in), optional :: indent integer :: indent_ @@ -693,22 +745,21 @@ recursive function tScalar_asFormattedString(self,indent) indent_ = 0 endif - tScalar_asFormattedString = repeat(' ',indent_)//trim(self%value)//IO_EOL + write (6,'(a)') trim(self%value) -end function tScalar_asFormattedString +end subroutine tScalar_asFormattedString !-------------------------------------------------------------------------------------------------- -!> @brief Return list as string (YAML block style) +!> @brief Prints list as string (YAML block style) !-------------------------------------------------------------------------------------------------- -recursive function tList_asFormattedString(self,indent) result(str) +recursive subroutine tList_asFormattedString(self,indent) - class(tList), intent(in), target :: self - integer, intent(in), optional :: indent + class (tList),intent(in),target :: self + integer, intent(in),optional :: indent - class(tItem), pointer :: item - character(len=:), allocatable :: str - integer :: i,indent_ + type (tItem), pointer :: item + integer :: i, indent_ if(present(indent)) then indent_ = indent @@ -718,24 +769,25 @@ recursive function tList_asFormattedString(self,indent) result(str) item => self%first do i = 1, self%length - str = str//repeat(' ',indent_)//'-'//IO_EOL//item%node%asFormattedString(indent_+2) + if( i /= 1) write (6,'(a)',advance='NO') repeat(' ',indent_) + write (6,'(a)',advance='NO') '- ' + call item%node%asFormattedString(indent_+2) item => item%next - enddo + end do -end function tList_asFormattedString +end subroutine tList_asFormattedString !-------------------------------------------------------------------------------------------------- -!> @brief Return dictionary as string (YAML block style) +!> @brief Prints dictionary as string (YAML block style) !-------------------------------------------------------------------------------------------------- -recursive function tDict_asFormattedString(self,indent) result(str) +recursive subroutine tDict_asFormattedString(self,indent) - class(tDict), intent(in), target :: self - integer, intent(in), optional :: indent - - class(tItem), pointer :: item - character(len=:), allocatable :: str - integer :: i,indent_ + class (tDict),intent(in),target :: self + integer, intent(in),optional :: indent + + type (tItem),pointer :: item + integer :: i, indent_ if(present(indent)) then indent_ = indent @@ -745,11 +797,20 @@ recursive function tDict_asFormattedString(self,indent) result(str) item => self%first do i = 1, self%length - str = str//repeat(' ',indent_)//item%key//':'//IO_EOL//item%node%asFormattedString(indent_+2) + if( i /= 1) write (6,'(a)',advance='NO') repeat(' ',indent_) + select type (node_ => item%node) + class is (tScalar) + write (6,'(a)',advance='NO') trim(item%key)//': ' + call node_%asFormattedString(indent_+len_trim(item%key)+2) + class default + write (6,'(a)') trim(item%key)//':' + write (6,'(a)',advance='NO') repeat(' ',indent_+2) + call node_%asFormattedString(indent_+2) + end select item => item%next - enddo + end do -end function tDict_asFormattedString +end subroutine tDict_asFormattedString !-------------------------------------------------------------------------------------------------- @@ -905,8 +966,8 @@ end function tList_asStrings !-------------------------------------------------------------------------------------------------- subroutine tList_append(self,node) - class(tList), intent(inout) :: self - class(tNode), intent(in) :: node + class(tList), intent(inout) :: self + class(tNode), intent(in), target :: node type(tItem), pointer :: item @@ -922,7 +983,7 @@ subroutine tList_append(self,node) item => item%next end if - allocate(item%node,source=node) ! ToDo: Discuss ownership (copy vs referencing) + item%node => node self%length = self%length + 1 end subroutine tList_append @@ -933,9 +994,9 @@ end subroutine tList_append !-------------------------------------------------------------------------------------------------- subroutine tDict_set(self,key,node) - class (tDict), intent(inout) :: self - character(len=*), intent(in) :: key - class(tNode), intent(in) :: node + class (tDict), intent(inout) :: self + character(len=*), intent(in) :: key + class(tNode), intent(in), target :: node type(tItem), pointer :: item @@ -957,7 +1018,7 @@ subroutine tDict_set(self,key,node) end if item%key = key - allocate(item%node,source=node) + item%node => node end subroutine tDict_set @@ -970,17 +1031,21 @@ recursive subroutine tList_finalize(self) type (tList),intent(inout) :: self - type (tItem),pointer :: current, & - next - - current => self%first - do while (associated(current)) - next => current%next - deallocate(current) - current => next - end do + deallocate(self%first) end subroutine tList_finalize +!-------------------------------------------------------------------------------------------------- +!> @brief empties nodes and frees associated memory +!-------------------------------------------------------------------------------------------------- +recursive subroutine tItem_finalize(self) + + type(tItem),intent(inout) :: self + + deallocate(self%node) + if(associated(self%next)) deallocate(self%next) + +end subroutine tItem_finalize + end module YAML_types From 815608ac4213287f6e00a84f87a3f467f741989b Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 30 Apr 2020 21:34:11 +0200 Subject: [PATCH 10/15] polishing --- src/YAML_types.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index 7a53bdbd3..02b2d5fdb 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -205,10 +205,9 @@ subroutine unitTest block class(tNode), pointer :: l1, l2, n - character(len=1) :: test = '2' select type(s1) class is(tScalar) - s1 = test + s1 = '2' endselect select type(s2) From 47f85402c492fe5c3cae3b5091f74195c2dca9dc Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Sat, 2 May 2020 23:03:11 +0200 Subject: [PATCH 11/15] using function makes it more readable --- src/YAML_types.f90 | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index 02b2d5fdb..f1af2f9cb 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -155,11 +155,12 @@ module YAML_types abstract interface - recursive subroutine asFormattedString(self,indent) + recursive function asFormattedString(self,indent) import tNode + character(len=:), allocatable :: asFormattedString class(tNode), intent(in), target :: self integer, intent(in), optional :: indent - end subroutine asFormattedString + end function asFormattedString end interface @@ -731,8 +732,9 @@ end function tNode_get_byKey_asIndex !-------------------------------------------------------------------------------------------------- !> @brief Prints scalar as string !-------------------------------------------------------------------------------------------------- -recursive subroutine tScalar_asFormattedString(self,indent) +recursive function tScalar_asFormattedString(self,indent) + character(len=:), allocatable :: tScalar_asFormattedString class (tScalar), intent(in), target :: self integer, intent(in), optional :: indent @@ -744,20 +746,21 @@ recursive subroutine tScalar_asFormattedString(self,indent) indent_ = 0 endif - write (6,'(a)') trim(self%value) + tScalar_asFormattedString = trim(self%value)//IO_EOL -end subroutine tScalar_asFormattedString +end function tScalar_asFormattedString !-------------------------------------------------------------------------------------------------- !> @brief Prints list as string (YAML block style) !-------------------------------------------------------------------------------------------------- -recursive subroutine tList_asFormattedString(self,indent) +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_ if(present(indent)) then @@ -768,24 +771,24 @@ recursive subroutine tList_asFormattedString(self,indent) item => self%first do i = 1, self%length - if( i /= 1) write (6,'(a)',advance='NO') repeat(' ',indent_) - write (6,'(a)',advance='NO') '- ' - call item%node%asFormattedString(indent_+2) + if(i /= 1) str = str//repeat(' ',indent_) + str = str//'- '//item%node%asFormattedString(indent_+2) item => item%next end do -end subroutine tList_asFormattedString +end function tList_asFormattedString !-------------------------------------------------------------------------------------------------- !> @brief Prints dictionary as string (YAML block style) !-------------------------------------------------------------------------------------------------- -recursive subroutine tDict_asFormattedString(self,indent) +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_ if(present(indent)) then @@ -796,20 +799,17 @@ recursive subroutine tDict_asFormattedString(self,indent) item => self%first do i = 1, self%length - if( i /= 1) write (6,'(a)',advance='NO') repeat(' ',indent_) - select type (node_ => item%node) - class is (tScalar) - write (6,'(a)',advance='NO') trim(item%key)//': ' - call node_%asFormattedString(indent_+len_trim(item%key)+2) + 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 - write (6,'(a)') trim(item%key)//':' - write (6,'(a)',advance='NO') repeat(' ',indent_+2) - call node_%asFormattedString(indent_+2) - end select + str = str//trim(item%key)//':'//IO_EOL//repeat(' ',indent_+2)//item%node%asFormattedString(indent_+2) + endselect item => item%next end do -end subroutine tDict_asFormattedString +end function tDict_asFormattedString !-------------------------------------------------------------------------------------------------- From 00deddac44df1657bd5b5c312273535cce5ee278 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Sat, 2 May 2020 23:17:53 +0200 Subject: [PATCH 12/15] initialization needed --- src/YAML_types.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index f1af2f9cb..314c099f8 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -762,7 +762,8 @@ recursive function tList_asFormattedString(self,indent) result(str) type (tItem), pointer :: item character(len=:), allocatable :: str integer :: i, indent_ - + + str = '' if(present(indent)) then indent_ = indent else @@ -791,6 +792,7 @@ recursive function tDict_asFormattedString(self,indent) result(str) character(len=:), allocatable :: str integer :: i, indent_ + str = '' if(present(indent)) then indent_ = indent else From 0c70f1a54f1ffe2fb90e76cdd6bc4864bf6e9624 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 7 May 2020 21:13:25 +0200 Subject: [PATCH 13/15] polishing --- src/YAML_types.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index 314c099f8..aa09364df 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -638,7 +638,7 @@ function tNode_get_byKey_asFloats(self,k) result(nodeAsFloats) class(tNode), pointer :: node type(tList), pointer :: list - node => self%get(k) + node => self%get(k) list => node%asList() nodeAsFloats = list%asFloats() @@ -657,7 +657,7 @@ function tNode_get_byKey_asInts(self,k) result(nodeAsInts) class(tNode), pointer :: node type(tList), pointer :: list - node => self%get(k) + node => self%get(k) list => node%asList() nodeAsInts = list%asInts() @@ -676,7 +676,7 @@ function tNode_get_byKey_asBools(self,k) result(nodeAsBools) class(tNode), pointer :: node type(tList), pointer :: list - node => self%get(k) + node => self%get(k) list => node%asList() nodeAsBools = list%asBools() @@ -695,7 +695,7 @@ function tNode_get_byKey_asStrings(self,k) result(nodeAsStrings) class(tNode), pointer :: node type(tList), pointer :: list - node => self%get(k) + node => self%get(k) list => node%asList() nodeAsStrings = list%asStrings() From 1610a6e12a7e227fad70d8c2c9ebfdb94e83d3f2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 May 2020 23:10:27 +0200 Subject: [PATCH 14/15] editorial changes --- src/YAML_types.f90 | 76 +++++++++++++++++++++++----------------------- 1 file changed, 38 insertions(+), 38 deletions(-) diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index aa09364df..dc7c09815 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -1,11 +1,10 @@ !-------------------------------------------------------------------------------------------------- -!> @brief yaml_types +!> @author Sharan Roongta, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Data types to create a scalar, a list, and a dictionary/hash !> @details module describes the various functions to store and get the yaml data. -!! tNode is the fundamental derived data type. It can be of tScalar, & -!! tList or tDict. -!! Every 'value' in a key: value pair is of tNode and is a pointer. -!! If 'value' is of tScalar, it can either be a string, real, integer or logical, & -!! functions exist to convert this scalar type to its respective primitive data type. +!! A node is the base class for scalar, list and dictionary, list items and dictionary entries point +!! to a node. !-------------------------------------------------------------------------------------------------- module YAML_types @@ -70,7 +69,7 @@ module YAML_types tNode_get_byKey_asString => tNode_get_byKey_asString procedure :: & tNode_get_byKey_asStrings => tNode_get_byKey_asStrings - procedure :: & + procedure :: & getIndex => tNode_get_byKey_asIndex generic :: & @@ -148,7 +147,7 @@ module YAML_types character(len=:), allocatable :: key class(tNode), pointer :: node => null() class(tItem), pointer :: next => null() - + contains final :: tItem_finalize end type tItem @@ -195,7 +194,7 @@ subroutine unitTest allocate(tScalar::s1) allocate(tScalar::s2) select type(s1) - class is(tScalar) + class is(tScalar) s1 = '1' if(s1%asInt() /= 1) call IO_error(0,ext_msg='tScalar_asInt') if(dNeq(s1%asFloat(),1.0_pReal)) call IO_error(0,ext_msg='tScalar_asFloat') @@ -210,7 +209,7 @@ subroutine unitTest class is(tScalar) s1 = '2' endselect - + select type(s2) class is(tScalar) s2 = '3' @@ -222,44 +221,44 @@ subroutine unitTest call l1%append(s1) call l1%append(s2) n => l1 - if(any(l1%asInts() /= [2,3])) call IO_error(0,ext_msg='tList_asInts') - if(any(dNeq(l1%asFloats(),[2.0_pReal,3.0_pReal]))) call IO_error(0,ext_msg='tList_asFloats') - if(n%get_asInt(1) /= 2) call IO_error(0,ext_msg='byIndex_asInt') - if(dNeq(n%get_asFloat(2),3.0_pReal)) call IO_error(0,ext_msg='byIndex_asFloat') + if(any(l1%asInts() /= [2,3])) call IO_error(0,ext_msg='tList_asInts') + if(any(dNeq(l1%asFloats(),[2.0_pReal,3.0_pReal]))) call IO_error(0,ext_msg='tList_asFloats') + if(n%get_asInt(1) /= 2) call IO_error(0,ext_msg='byIndex_asInt') + if(dNeq(n%get_asFloat(2),3.0_pReal)) call IO_error(0,ext_msg='byIndex_asFloat') endselect - + allocate(tList::l2) select type(l2) class is(tList) call l2%append(l1) - if(any(l2%get_asInts(1) /= [2,3])) call IO_error(0,ext_msg='byIndex_asInts') - if(any(dNeq(l2%get_asFloats(1),[2.0_pReal,3.0_pReal]))) call IO_error(0,ext_msg='byIndex_asFloats') + if(any(l2%get_asInts(1) /= [2,3])) call IO_error(0,ext_msg='byIndex_asInts') + if(any(dNeq(l2%get_asFloats(1),[2.0_pReal,3.0_pReal]))) call IO_error(0,ext_msg='byIndex_asFloats') n => l2 end select deallocate(n) - end block + end block - 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%asBools() .neqv. [.true., .false.])) call IO_error(0,ext_msg='tList_asBools') - if(any(l1%asStrings() /= ['True ','False'])) call IO_error(0,ext_msg='tList_asStrings') - if(n%get_asBool(2)) call IO_error(0,ext_msg='byIndex_asBool') - if(n%get_asString(1) /= 'True') call IO_error(0,ext_msg='byIndex_asString') - end block + + if(any(l1%asBools() .neqv. [.true., .false.])) call IO_error(0,ext_msg='tList_asBools') + if(any(l1%asStrings() /= ['True ','False'])) call IO_error(0,ext_msg='tList_asStrings') + if(n%get_asBool(2)) call IO_error(0,ext_msg='byIndex_asBool') + if(n%get_asString(1) /= 'True') call IO_error(0,ext_msg='byIndex_asString') + end block end subroutine unitTest @@ -531,7 +530,7 @@ function tNode_get_byKey(self,k) result(node) character(len=*), intent(in) :: k class(tNode), pointer :: node - type(tDict), pointer :: self_ + type(tDict), pointer :: self_ type(tItem), pointer :: item integer :: j @@ -702,9 +701,9 @@ function tNode_get_byKey_asStrings(self,k) result(nodeAsStrings) end function tNode_get_byKey_asStrings -!------------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @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 @@ -717,6 +716,7 @@ function tNode_get_byKey_asIndex(self,key) result(keyIndex) dict => self%asDict() item => dict%first + keyIndex = -1 do i = 1, dict%length if(key == item%key) then keyIndex = i @@ -730,7 +730,7 @@ end function tNode_get_byKey_asIndex !-------------------------------------------------------------------------------------------------- -!> @brief Prints scalar as string +!> @brief Scalar as string (YAML block style) !-------------------------------------------------------------------------------------------------- recursive function tScalar_asFormattedString(self,indent) @@ -752,7 +752,7 @@ end function tScalar_asFormattedString !-------------------------------------------------------------------------------------------------- -!> @brief Prints list as string (YAML block style) +!> @brief List as string (YAML block style) !-------------------------------------------------------------------------------------------------- recursive function tList_asFormattedString(self,indent) result(str) @@ -762,7 +762,7 @@ recursive function tList_asFormattedString(self,indent) result(str) type (tItem), pointer :: item character(len=:), allocatable :: str integer :: i, indent_ - + str = '' if(present(indent)) then indent_ = indent @@ -781,15 +781,15 @@ end function tList_asFormattedString !-------------------------------------------------------------------------------------------------- -!> @brief Prints dictionary as string (YAML block style) +!> @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 + character(len=:), allocatable :: str integer :: i, indent_ str = '' @@ -801,7 +801,7 @@ recursive function tDict_asFormattedString(self,indent) result(str) item => self%first do i = 1, self%length - if(i /= 1) str = str//repeat(' ',indent_) + 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) @@ -1043,7 +1043,7 @@ end subroutine tList_finalize recursive subroutine tItem_finalize(self) type(tItem),intent(inout) :: self - + deallocate(self%node) if(associated(self%next)) deallocate(self%next) From 620154a1a8ab08e0bc42cf515c0a72f006a7da08 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Mon, 11 May 2020 14:00:19 +0200 Subject: [PATCH 15/15] not needed --- src/YAML_types.f90 | 8 -------- 1 file changed, 8 deletions(-) diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index dc7c09815..07541bc1a 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -738,14 +738,6 @@ recursive function tScalar_asFormattedString(self,indent) class (tScalar), intent(in), target :: self integer, intent(in), optional :: indent - integer :: indent_ - - if(present(indent)) then - indent_ = indent - else - indent_ = 0 - endif - tScalar_asFormattedString = trim(self%value)//IO_EOL end function tScalar_asFormattedString