From 52088691d1d441bfbc0bc83fc9fda91a1c688408 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 22 Aug 2018 11:51:23 +0200 Subject: [PATCH] improved linked list and fixed solution for strange bug Bug: Using automated LHS re-allocation for a string array that with global scope seems to cause trouble Hence, "parse_file" works with a local string and assings only once to it Linked_List: Now storing data in the list head also and last element is always empty. Finalize allows simple handling of deallocation --- src/config.f90 | 223 ++++++++++++++++++++++------------------- src/constitutive.f90 | 4 +- src/crystallite.f90 | 5 +- src/homogenization.f90 | 3 +- src/material.f90 | 10 +- 5 files changed, 131 insertions(+), 114 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 05da341d4..a22acbff9 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -23,7 +23,13 @@ module config contains procedure :: add => add procedure :: show => show - !procedure :: free => free + procedure :: free => free + +! currently, a finalize is needed for all shapes of tPartitionedStringList. +! with Fortran 2015, we can define one recursive elemental function +! https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/543326 + final :: finalize, & + finalizeArray procedure :: keyExists => keyExists procedure :: countKeys => countKeys @@ -35,13 +41,13 @@ module config procedure :: getFloats => getFloats procedure :: getInts => getInts procedure :: getStrings => getStrings - final :: free + end type tPartitionedStringList type(tPartitionedStringList), public :: emptyList - type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & ! QUESTION: rename to config_XXX? + type(tPartitionedStringList), public, allocatable, dimension(:) :: & config_phase, & config_microstructure, & config_homogenization, & @@ -78,8 +84,7 @@ module config public :: & - config_init, & - config_deallocate + config_init contains @@ -92,6 +97,8 @@ subroutine config_init() compiler_version, & compiler_options #endif + use prec, only: & + pStringLen use DAMASK_interface, only: & getSolverJobName use IO, only: & @@ -109,10 +116,10 @@ subroutine config_init() implicit none integer(pInt) :: myDebug,i - character(len=256) :: & + character(len=pStringLen) :: & line, & part - character(len=256), dimension(:), allocatable :: fileContent + character(len=pStringLen), dimension(:), allocatable :: fileContent logical :: fileExists write(6,'(/,a)') ' <<<+- config init -+>>>' @@ -175,8 +182,10 @@ end subroutine config_init !-------------------------------------------------------------------------------------------------- !> @brief parses the material.config file !-------------------------------------------------------------------------------------------------- -subroutine parseFile(line,& - sectionNames,part,fileContent) +subroutine parseFile(line,sectionNames,part,& + fileContent) + use prec, only: & + pStringLen use IO, only: & IO_error, & IO_lc, & @@ -186,11 +195,12 @@ subroutine parseFile(line,& IO_stringPos implicit none - character(len=*), dimension(:), allocatable, intent(inout) :: sectionNames + character(len=pStringLen), intent(out) :: line + character(len=64), allocatable, dimension(:), intent(out) :: sectionNames type(tPartitionedStringList), allocatable, dimension(:), intent(out) :: part - character(len=256), dimension(:), intent(in) :: fileContent - character(len=256),intent(out) :: line + character(len=pStringLen), dimension(:), intent(in) :: fileContent + character(len=64), allocatable, dimension(:) :: sectionNamesTemp ! Circumvent Gfortran bug integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: s,i character(len=64) :: tag @@ -198,6 +208,8 @@ subroutine parseFile(line,& echo = .false. allocate(part(0)) + tag='' + allocate(sectionNamesTemp(0),source=tag) s = 0_pInt do i=1, size(fileContent) @@ -208,11 +220,7 @@ subroutine parseFile(line,& s = s + 1_pInt part = [part, emptyList] tag = IO_getTag(line,'[',']') - GfortranBug86033: if (.not. allocated(sectionNames)) then - allocate(sectionNames(1),source=tag) - else GfortranBug86033 - sectionNames = [sectionNames,tag] - endif GfortranBug86033 + sectionNamesTemp = [sectionNamesTemp,tag] cycle endif nextSection chunkPos = IO_stringPos(line) @@ -224,8 +232,11 @@ subroutine parseFile(line,& endif inSection enddo + sectionNames = sectionNamesTemp + if (echo) then do s = 1, size(sectionNames) + write(6,*) 'section',s, '"'//trim(sectionNames(i))//'"' call part(s)%show() end do end if @@ -234,7 +245,6 @@ end subroutine parseFile !-------------------------------------------------------------------------------------------------- !> @brief deallocates the linked lists that store the content of the configuration files -! commenting out removes erratic errors with gfortran 7.3 !-------------------------------------------------------------------------------------------------- subroutine config_deallocate(what) use IO, only: & @@ -244,36 +254,21 @@ subroutine config_deallocate(what) character(len=*), intent(in) :: what integer(pInt) :: i - select case(what) + select case(trim(what)) case('material.config/phase') - !do i=1, size(config_phase) - ! call config_phase(i)%free - !enddo deallocate(config_phase) case('material.config/microstructure') - !do i=1, size(config_microstructure) - ! call config_microstructure(i)%free - !enddo deallocate(config_microstructure) case('material.config/crystallite') - !do i=1, size(config_crystallite) - ! call config_crystallite(i)%free - !enddo deallocate(config_crystallite) case('material.config/homogenization') - !do i=1, size(config_homogenization) - ! call config_homogenization(i)%free - !enddo deallocate(config_homogenization) case('material.config/texture') - !do i=1, size(config_texture) - ! call config_texture(i)%free - !enddo deallocate(config_texture) case default @@ -294,7 +289,7 @@ end subroutine config_deallocate !> @brief add element !> @details Adds a string together with the start/end position of chunks in this string. The new !! element is added at the end of the list. Empty strings are not added. All strings are converted -!! to lower case +!! to lower case. The data is not stored in the new element but in the current. !-------------------------------------------------------------------------------------------------- subroutine add(this,string) use IO, only: & @@ -305,19 +300,18 @@ subroutine add(this,string) implicit none class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: string - type(tPartitionedStringList), pointer :: new, item + type(tPartitionedStringList), pointer :: new, temp if (IO_isBlank(string)) return allocate(new) - new%string%val = IO_lc (trim(string)) - new%string%pos = IO_stringPos(trim(string)) - - item => this - do while (associated(item%next)) - item => item%next + temp => this + do while (associated(temp%next)) + temp => temp%next enddo - item%next => new + temp%string%val = IO_lc (trim(string)) + temp%string%pos = IO_stringPos(trim(string)) + temp%next => new end subroutine add @@ -329,11 +323,11 @@ end subroutine add subroutine show(this) implicit none - class(tPartitionedStringList) :: this - type(tPartitionedStringList), pointer :: item + class(tPartitionedStringList), target, intent(in) :: this + type(tPartitionedStringList), pointer :: item - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) write(6,'(a)') trim(item%string%val) item => item%next end do @@ -343,27 +337,54 @@ end subroutine show !-------------------------------------------------------------------------------------------------- !> @brief cleans entire list -!> @details list head remains alive +!> @details explicit interface to reset list. Triggers final statement (and following chain reaction) !-------------------------------------------------------------------------------------------------- subroutine free(this) implicit none - type(tPartitionedStringList), target, intent(in) :: this - type(tPartitionedStringList), pointer :: new, item + class(tPartitionedStringList), intent(inout) :: this - if (.not. associated(this%next)) return - - item => this%next - do while (associated(item%next)) - new => item - deallocate(item) - item => new%next - enddo - deallocate(item) + if(associated(this%next)) deallocate(this%next) end subroutine free +!-------------------------------------------------------------------------------------------------- +!> @brief cleans entire list +!> @details called when variable goes out of scope. Triggers chain reaction. +!-------------------------------------------------------------------------------------------------- +recursive subroutine finalize(this) + + implicit none + type(tPartitionedStringList), intent(inout) :: this + + if(associated(this%next)) deallocate(this%next) + +end subroutine finalize + + +!-------------------------------------------------------------------------------------------------- +!> @brief cleans entire list +!> @details called when variable goes out of scope. Triggers chain reaction. +!-------------------------------------------------------------------------------------------------- +subroutine finalizeArray(this) + + implicit none + integer :: i + type(tPartitionedStringList), intent(inout), dimension(:) :: this + type(tPartitionedStringList), pointer :: temp ! bug in Gfortran + + do i=1, size(this) + if (associated(this(i)%next)) then + temp => this(i)%next + !deallocate(this(i)) !internal compiler error: in gfc_build_final_call, at fortran/trans.c:975 + deallocate(temp) + endif + enddo + +end subroutine finalizeArray + + !-------------------------------------------------------------------------------------------------- !> @brief reports wether a given key (string value at first position) exists in the list !-------------------------------------------------------------------------------------------------- @@ -372,14 +393,14 @@ logical function keyExists(this,key) IO_stringValue implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: item + class(tPartitionedStringList), target, intent(in) :: this + character(len=*), intent(in) :: key + type(tPartitionedStringList), pointer :: item keyExists = .false. - item => this%next - do while (associated(item) .and. .not. keyExists) + item => this + do while (associated(item%next) .and. .not. keyExists) keyExists = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) item => item%next end do @@ -397,14 +418,14 @@ integer(pInt) function countKeys(this,key) implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: item + class(tPartitionedStringList), target, intent(in) :: this + character(len=*), intent(in) :: key + type(tPartitionedStringList), pointer :: item countKeys = 0_pInt - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) & countKeys = countKeys + 1_pInt item => item%next @@ -425,17 +446,17 @@ real(pReal) function getFloat(this,key,defaultVal) IO_FloatValue implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - real(pReal), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: item - logical :: found + class(tPartitionedStringList), target, intent(in) :: this + character(len=*), intent(in) :: key + real(pReal), intent(in), optional :: defaultVal + type(tPartitionedStringList), pointer :: item + logical :: found found = present(defaultVal) if (found) getFloat = defaultVal - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) @@ -461,17 +482,17 @@ integer(pInt) function getInt(this,key,defaultVal) IO_IntValue implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - integer(pInt), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: item - logical :: found + class(tPartitionedStringList), target, intent(in) :: this + character(len=*), intent(in) :: key + integer(pInt), intent(in), optional :: defaultVal + type(tPartitionedStringList), pointer :: item + logical :: found found = present(defaultVal) if (found) getInt = defaultVal - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) @@ -497,13 +518,13 @@ character(len=65536) function getString(this,key,defaultVal,raw) IO_stringValue implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - character(len=65536), intent(in), optional :: defaultVal - logical, intent(in), optional :: raw - type(tPartitionedStringList), pointer :: item - logical :: found, & - whole + class(tPartitionedStringList), target, intent(in) :: this + character(len=*), intent(in) :: key + character(len=65536), intent(in), optional :: defaultVal + logical, intent(in), optional :: raw + type(tPartitionedStringList), pointer :: item + logical :: found, & + whole whole = merge(raw,.false.,present(raw)) ! whole string or white space splitting found = present(defaultVal) @@ -512,8 +533,8 @@ character(len=65536) function getString(this,key,defaultVal,raw) if (len_trim(getString) /= len_trim(defaultVal)) call IO_error(0_pInt,ext_msg='getString') endif - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) @@ -545,7 +566,7 @@ function getFloats(this,key,defaultVal,requiredShape) implicit none real(pReal), dimension(:), allocatable :: getFloats - class(tPartitionedStringList), intent(in) :: this + class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key real(pReal), dimension(:), intent(in), optional :: defaultVal integer(pInt), dimension(:), intent(in), optional :: requiredShape @@ -559,8 +580,8 @@ function getFloats(this,key,defaultVal,requiredShape) allocate(getFloats(0)) - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (.not. cumulative) getFloats = [real(pReal)::] @@ -592,7 +613,7 @@ function getInts(this,key,defaultVal,requiredShape) implicit none integer(pInt), dimension(:), allocatable :: getInts - class(tPartitionedStringList), intent(in) :: this + class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key integer(pInt), dimension(:), intent(in), optional :: defaultVal, & requiredShape @@ -606,8 +627,8 @@ function getInts(this,key,defaultVal,requiredShape) allocate(getInts(0)) - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (.not. cumulative) getInts = [integer(pInt)::] @@ -639,7 +660,7 @@ function getStrings(this,key,defaultVal,requiredShape,raw) implicit none character(len=65536),dimension(:), allocatable :: getStrings - class(tPartitionedStringList), intent(in) :: this + class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key character(len=65536),dimension(:), intent(in), optional :: defaultVal integer(pInt), dimension(:), intent(in), optional :: requiredShape @@ -655,8 +676,8 @@ function getStrings(this,key,defaultVal,requiredShape,raw) whole = merge(raw,.false.,present(raw)) found = .false. - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (allocated(getStrings) .and. .not. cumulative) deallocate(getStrings) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index ce09c86a0..f27edcc07 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -58,7 +58,7 @@ subroutine constitutive_init() IO_write_jobIntFile, & IO_timeStamp use config, only: & - config_deallocate + config_phase use mesh, only: & FE_geomtype use config, only: & @@ -192,7 +192,7 @@ subroutine constitutive_init() if (any(phase_kinematics == KINEMATICS_hydrogen_strain_ID)) call kinematics_hydrogen_strain_init(FILEUNIT) close(FILEUNIT) - call config_deallocate('material.config/phase') + deallocate(config_phase) write(6,'(/,a)') ' <<<+- constitutive init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 0ee71b5de..6601fe29e 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -173,8 +173,7 @@ subroutine crystallite_init use material use config, only: & config_crystallite, & - crystallite_name, & - config_deallocate + crystallite_name use constitutive, only: & constitutive_initialFi, & constitutive_microstructure ! derived (shortcut) quantities of given state @@ -376,7 +375,7 @@ subroutine crystallite_init close(FILEUNIT) endif - call config_deallocate('material.config/crystallite') + deallocate(config_crystallite) !-------------------------------------------------------------------------------------------------- ! initialize diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 3565999a8..de195f18a 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -101,7 +101,6 @@ subroutine homogenization_init crystallite_maxSizePostResults #endif use config, only: & - config_deallocate, & material_configFile, & material_localFileExt, & config_homogenization, & @@ -375,7 +374,7 @@ subroutine homogenization_init close(FILEUNIT) endif mainProcess2 - call config_deallocate('material.config/homogenization') + deallocate(config_homogenization) !-------------------------------------------------------------------------------------------------- ! allocate and initialize global variables diff --git a/src/material.f90 b/src/material.f90 index 4c5a9ed74..73edc8281 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -360,8 +360,7 @@ subroutine material_init() homogenization_name, & microstructure_name, & phase_name, & - texture_name, & - config_deallocate + texture_name use mesh, only: & mesh_maxNips, & mesh_NcpElems, & @@ -469,7 +468,6 @@ subroutine material_init() endif debugOut call material_populateGrains - call config_deallocate('material.config/microstructure') allocate(phaseAt ( homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0_pInt) allocate(phasememberAt ( homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0_pInt) @@ -921,8 +919,7 @@ subroutine material_parseTexture IO_floatValue, & IO_stringValue use config, only: & - config_texture, & - config_deallocate + config_texture use math, only: & inRad, & math_sampleRandomOri, & @@ -1061,7 +1058,7 @@ subroutine material_parseTexture endif enddo - call config_deallocate('material.config/texture') + deallocate(config_texture) end subroutine material_parseTexture @@ -1429,6 +1426,7 @@ subroutine material_populateGrains deallocate(texture_transformation) deallocate(Nelems) deallocate(elemsOfHomogMicro) + deallocate(config_microstructure) end subroutine material_populateGrains