seems to work now

anyway, nicer code
This commit is contained in:
Martin Diehl 2018-08-22 14:30:51 +02:00
parent 1b5623ad6c
commit ab45818d51
5 changed files with 38 additions and 44 deletions

View File

@ -47,7 +47,7 @@ module config
type(tPartitionedStringList), public :: emptyList type(tPartitionedStringList), public :: emptyList
type(tPartitionedStringList), public, allocatable, dimension(:) :: & type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: &
config_phase, & config_phase, &
config_microstructure, & config_microstructure, &
config_homogenization, & config_homogenization, &
@ -82,9 +82,9 @@ module config
MATERIAL_configFile = 'material.config', & !< generic name for material configuration file MATERIAL_configFile = 'material.config', & !< generic name for material configuration file
MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file
public :: & public :: &
config_init config_init, &
config_deallocate
contains contains
@ -137,7 +137,7 @@ subroutine config_init()
fileContent = IO_recursiveRead('material.config') fileContent = IO_recursiveRead('material.config')
endif endif
do i=1, size(fileContent) do i = 1_pInt, size(fileContent)
line = trim(fileContent(i)) line = trim(fileContent(i))
part = IO_lc(IO_getTag(line,'<','>')) part = IO_lc(IO_getTag(line,'<','>'))
select case (trim(part)) select case (trim(part))
@ -188,11 +188,7 @@ subroutine parseFile(line,sectionNames,part,&
pStringLen pStringLen
use IO, only: & use IO, only: &
IO_error, & IO_error, &
IO_lc, & IO_getTag
IO_getTag, &
IO_isBlank, &
IO_stringValue, &
IO_stringPos
implicit none implicit none
character(len=pStringLen), intent(out) :: line character(len=pStringLen), intent(out) :: line
@ -200,44 +196,38 @@ subroutine parseFile(line,sectionNames,part,&
type(tPartitionedStringList), allocatable, dimension(:), intent(out) :: part type(tPartitionedStringList), allocatable, dimension(:), intent(out) :: part
character(len=pStringLen), dimension(:), intent(in) :: fileContent character(len=pStringLen), dimension(:), intent(in) :: fileContent
character(len=64), allocatable, dimension(:) :: sectionNamesTemp ! Circumvent Gfortran bug integer(pInt), allocatable, dimension(:) :: partPosition
integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: i
integer(pInt) :: s,i
character(len=64) :: tag
logical :: echo logical :: echo
echo = .false. echo = .false.
allocate(part(0)) allocate(part(0))
tag='' allocate(partPosition(0))
allocate(sectionNamesTemp(0),source=tag)
s = 0_pInt do i = 1_pInt, size(fileContent)
do i=1, size(fileContent)
line = trim(fileContent(i)) line = trim(fileContent(i))
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit if (IO_getTag(line,'<','>') /= '') exit
nextSection: if (IO_getTag(line,'[',']') /= '') then nextSection: if (IO_getTag(line,'[',']') /= '') then
s = s + 1_pInt part = [part, emptyList]
part = [part, emptyList] partPosition = [partPosition, i]
tag = IO_getTag(line,'[',']')
sectionNamesTemp = [sectionNamesTemp,tag]
cycle cycle
endif nextSection endif nextSection
chunkPos = IO_stringPos(line) inSection: if (size(part) > 0_pInt) then
tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key call part(size(part))%add(trim(adjustl(line)))
inSection: if (s > 0_pInt) then
call part(s)%add(IO_lc(trim(line)))
else inSection else inSection
echo = (trim(tag) == '/echo/') if (trim(IO_getTag(line,'/','/')) == 'echo') echo = .true.
endif inSection endif inSection
enddo enddo
sectionNames = sectionNamesTemp allocate(sectionNames(size(partPosition)))
do i = 1_pInt, size(partPosition)
sectionNames(i) = trim(adjustl(fileContent(partPosition(i))))
enddo
if (echo) then if (echo) then
do s = 1, size(sectionNames) do i = 1, size(sectionNames)
write(6,*) 'section',s, '"'//trim(sectionNames(i))//'"' write(6,'(a)') 'section',i, '"'//trim(sectionNames(i))//'"'
call part(s)%show() call part(i)%show()
end do end do
end if end if
@ -252,7 +242,6 @@ subroutine config_deallocate(what)
implicit none implicit none
character(len=*), intent(in) :: what character(len=*), intent(in) :: what
integer(pInt) :: i
select case(trim(what)) select case(trim(what))
@ -336,7 +325,7 @@ end subroutine show
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief cleans entire list !> @brief empties list and frees associated memory
!> @details explicit interface to reset list. Triggers final statement (and following chain reaction) !> @details explicit interface to reset list. Triggers final statement (and following chain reaction)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine free(this) subroutine free(this)
@ -350,8 +339,8 @@ end subroutine free
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief cleans entire list !> @brief empties list and frees associated memory
!> @details called when variable goes out of scope. Triggers chain reaction. !> @details called when variable goes out of scope. Triggers chain reaction for list
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
recursive subroutine finalize(this) recursive subroutine finalize(this)
@ -364,15 +353,15 @@ end subroutine finalize
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief cleans entire list !> @brief cleans entire array of linke lists
!> @details called when variable goes out of scope. Triggers chain reaction. !> @details called when variable goes out of scope.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine finalizeArray(this) subroutine finalizeArray(this)
implicit none implicit none
integer :: i integer :: i
type(tPartitionedStringList), intent(inout), dimension(:) :: this type(tPartitionedStringList), intent(inout), dimension(:) :: this
type(tPartitionedStringList), pointer :: temp ! bug in Gfortran type(tPartitionedStringList), pointer :: temp ! bug in Gfortran?
do i=1, size(this) do i=1, size(this)
if (associated(this(i)%next)) then if (associated(this(i)%next)) then

View File

@ -65,7 +65,8 @@ subroutine constitutive_init()
material_Nphase, & material_Nphase, &
material_localFileExt, & material_localFileExt, &
phase_name, & phase_name, &
material_configFile material_configFile, &
config_deallocate
use material, only: & use material, only: &
material_phase, & material_phase, &
phase_plasticity, & phase_plasticity, &
@ -192,7 +193,7 @@ subroutine constitutive_init()
if (any(phase_kinematics == KINEMATICS_hydrogen_strain_ID)) call kinematics_hydrogen_strain_init(FILEUNIT) if (any(phase_kinematics == KINEMATICS_hydrogen_strain_ID)) call kinematics_hydrogen_strain_init(FILEUNIT)
close(FILEUNIT) close(FILEUNIT)
deallocate(config_phase) call config_deallocate('material.config/phase')
write(6,'(/,a)') ' <<<+- constitutive init -+>>>' write(6,'(/,a)') ' <<<+- constitutive init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp() write(6,'(a15,a)') ' Current time: ',IO_timeStamp()

View File

@ -172,6 +172,7 @@ subroutine crystallite_init
IO_error IO_error
use material use material
use config, only: & use config, only: &
config_deallocate, &
config_crystallite, & config_crystallite, &
crystallite_name crystallite_name
use constitutive, only: & use constitutive, only: &
@ -375,7 +376,7 @@ subroutine crystallite_init
close(FILEUNIT) close(FILEUNIT)
endif endif
deallocate(config_crystallite) call config_deallocate('material.config/crystallite')
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! initialize ! initialize

View File

@ -103,6 +103,7 @@ subroutine homogenization_init
use config, only: & use config, only: &
material_configFile, & material_configFile, &
material_localFileExt, & material_localFileExt, &
config_deallocate, &
config_homogenization, & config_homogenization, &
homogenization_name homogenization_name
use material use material
@ -374,7 +375,7 @@ subroutine homogenization_init
close(FILEUNIT) close(FILEUNIT)
endif mainProcess2 endif mainProcess2
deallocate(config_homogenization) call config_deallocate('material.config/homogenization')
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! allocate and initialize global variables ! allocate and initialize global variables

View File

@ -919,6 +919,7 @@ subroutine material_parseTexture
IO_floatValue, & IO_floatValue, &
IO_stringValue IO_stringValue
use config, only: & use config, only: &
config_deallocate, &
config_texture config_texture
use math, only: & use math, only: &
inRad, & inRad, &
@ -1058,7 +1059,7 @@ subroutine material_parseTexture
endif endif
enddo enddo
deallocate(config_texture) call config_deallocate('material.config/texture')
end subroutine material_parseTexture end subroutine material_parseTexture
@ -1090,6 +1091,7 @@ subroutine material_populateGrains
use config, only: & use config, only: &
config_homogenization, & config_homogenization, &
config_microstructure, & config_microstructure, &
config_deallocate, &
homogenization_name, & homogenization_name, &
microstructure_name microstructure_name
use IO, only: & use IO, only: &
@ -1426,7 +1428,7 @@ subroutine material_populateGrains
deallocate(texture_transformation) deallocate(texture_transformation)
deallocate(Nelems) deallocate(Nelems)
deallocate(elemsOfHomogMicro) deallocate(elemsOfHomogMicro)
deallocate(config_microstructure) call config_deallocate('material.config/microstructure')
end subroutine material_populateGrains end subroutine material_populateGrains