DAMASK_EICMD/src/config.f90

700 lines
26 KiB
Fortran
Raw Normal View History

2018-06-10 14:37:17 +05:30
!--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Reads in the material configuration from file
!> @details Reads the material configuration file, where solverJobName.materialConfig takes
!! precedence over material.config. Stores the raw strings and the positions of delimiters for the
!! parts 'homogenization', 'crystallite', 'phase', 'texture', and 'microstucture'
!--------------------------------------------------------------------------------------------------
module config
use prec, only: &
pReal, &
pInt
implicit none
private
type, private :: tPartitionedString
character(len=:), allocatable :: val
integer(pInt), dimension(:), allocatable :: pos
end type tPartitionedString
type, public :: tPartitionedStringList
type(tPartitionedString) :: string
type(tPartitionedStringList), pointer :: next => null()
2018-06-22 03:18:34 +05:30
contains
procedure :: add => add
procedure :: show => show
procedure :: free => free
procedure :: keyExists => keyExists
procedure :: countKeys => countKeys
procedure :: getFloat => getFloat
procedure :: getInt => getInt
2018-06-22 03:18:34 +05:30
procedure :: getString => getString
procedure :: getFloats => getFloats
procedure :: getInts => getInts
2018-06-22 03:18:34 +05:30
procedure :: getStrings => getStrings
end type tPartitionedStringList
type(tPartitionedStringList), public :: emptyList
type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & ! QUESTION: rename to config_XXX?
2018-06-27 00:24:54 +05:30
config_phase, &
config_microstructure, &
config_homogenization, &
config_texture, &
config_crystallite
character(len=64), dimension(:), allocatable, public, protected :: &
phase_name, & !< name of each phase
homogenization_name, & !< name of each homogenization
crystallite_name, & !< name of each crystallite setting
microstructure_name, & !< name of each microstructure
texture_name !< name of each texture
! ToDo: make private, no one needs to know that
character(len=*), parameter, public :: &
MATERIAL_partHomogenization = 'homogenization', & !< keyword for homogenization part
MATERIAL_partCrystallite = 'crystallite', & !< keyword for crystallite part
MATERIAL_partPhase = 'phase', & !< keyword for phase part
2018-06-27 00:20:06 +05:30
MATERIAL_partMicrostructure = 'microstructure' !< keyword for microstructure part
character(len=*), parameter, private :: &
MATERIAL_partTexture = 'texture' !< keyword for texture part
2018-06-27 00:24:54 +05:30
! ToDo: Remove, use size(config_phase) etc
integer(pInt), public, protected :: &
material_Nphase, & !< number of phases
material_Nhomogenization, & !< number of homogenizations
material_Nmicrostructure, & !< number of microstructures
material_Ncrystallite !< number of crystallite settings
! ToDo: make private, no one needs to know that
character(len=*), parameter, public :: &
MATERIAL_configFile = 'material.config', & !< generic name for material configuration file
MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file
public :: &
config_init, &
config_deallocate
contains
!--------------------------------------------------------------------------------------------------
!> @brief reads material.config and stores its content per part
!--------------------------------------------------------------------------------------------------
subroutine config_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
2018-07-16 15:12:58 +05:30
use DAMASK_interface, only: &
getSolverJobName
use IO, only: &
IO_error, &
IO_lc, &
2018-07-16 15:12:58 +05:30
IO_recursiveRead, &
IO_getTag, &
IO_timeStamp, &
IO_EOF
use debug, only: &
debug_level, &
debug_material, &
debug_levelBasic
implicit none
integer(pInt) :: myDebug,i
character(len=256) :: &
line, &
part
character(len=256), dimension(:), allocatable :: fileContent
logical :: fileExists
write(6,'(/,a)') ' <<<+- config init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
myDebug = debug_level(debug_material)
inquire(file=trim(getSolverJobName())//'.'//material_localFileExt,exist=fileExists)
if(fileExists) then
2018-07-16 15:12:58 +05:30
fileContent = IO_recursiveRead(trim(getSolverJobName())//'.'//material_localFileExt)
else
inquire(file='material.config',exist=fileExists)
if(.not. fileExists) call IO_error(100_pInt,ext_msg='material.config')
2018-07-16 15:12:58 +05:30
fileContent = IO_recursiveRead('material.config')
endif
2018-07-16 15:12:58 +05:30
do i=1, size(fileContent)
line = trim(fileContent(i))
part = IO_lc(IO_getTag(line,'<','>'))
select case (trim(part))
case (trim(material_partPhase))
call parseFile(line,phase_name,config_phase,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6)
case (trim(material_partMicrostructure))
2018-07-16 15:12:58 +05:30
call parseFile(line,microstructure_name,config_microstructure,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6)
case (trim(material_partCrystallite))
2018-07-16 15:12:58 +05:30
call parseFile(line,crystallite_name,config_crystallite,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6)
case (trim(material_partHomogenization))
2018-07-16 15:12:58 +05:30
call parseFile(line,homogenization_name,config_homogenization,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6)
case (trim(material_partTexture))
2018-07-16 15:12:58 +05:30
call parseFile(line,texture_name,config_texture,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6)
end select
enddo
2018-06-09 17:18:37 +05:30
2018-06-27 00:24:54 +05:30
material_Nhomogenization = size(config_homogenization)
2018-06-09 17:18:37 +05:30
if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization)
2018-06-27 00:24:54 +05:30
material_Nmicrostructure = size(config_microstructure)
2018-06-09 17:18:37 +05:30
if (material_Nmicrostructure < 1_pInt) call IO_error(160_pInt,ext_msg=material_partMicrostructure)
2018-06-27 00:24:54 +05:30
material_Ncrystallite = size(config_crystallite)
2018-06-09 17:18:37 +05:30
if (material_Ncrystallite < 1_pInt) call IO_error(160_pInt,ext_msg=material_partCrystallite)
2018-06-27 00:24:54 +05:30
material_Nphase = size(config_phase)
2018-06-09 17:18:37 +05:30
if (material_Nphase < 1_pInt) call IO_error(160_pInt,ext_msg=material_partPhase)
2018-06-27 00:24:54 +05:30
if (size(config_texture) < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture)
2018-06-09 17:18:37 +05:30
end subroutine config_init
!--------------------------------------------------------------------------------------------------
!> @brief parses the material.config file
!--------------------------------------------------------------------------------------------------
subroutine parseFile(line,&
2018-07-16 15:12:58 +05:30
sectionNames,part,fileContent)
use IO, only: &
IO_error, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringValue, &
2018-07-16 15:12:58 +05:30
IO_stringPos
implicit none
character(len=*), dimension(:), allocatable, intent(inout) :: sectionNames
2018-07-16 15:12:58 +05:30
type(tPartitionedStringList), allocatable, dimension(:), intent(out) :: part
character(len=256), dimension(:), intent(in) :: fileContent
character(len=256),intent(out) :: line
integer(pInt), allocatable, dimension(:) :: chunkPos
2018-07-16 15:12:58 +05:30
integer(pInt) :: s,i
character(len=64) :: tag
logical :: echo
echo = .false.
2018-06-09 17:18:37 +05:30
allocate(part(0))
s = 0_pInt
2018-07-16 15:12:58 +05:30
do i=1, size(fileContent)
line = trim(fileContent(i))
if (IO_isBlank(line)) cycle ! skip empty lines
2018-07-16 15:12:58 +05:30
if (IO_getTag(line,'<','>') /= '') exit
nextSection: if (IO_getTag(line,'[',']') /= '') then
s = s + 1_pInt
2018-06-09 17:18:37 +05:30
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
cycle
endif nextSection
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key
inSection: if (s > 0_pInt) then
call part(s)%add(IO_lc(trim(line)))
else inSection
echo = (trim(tag) == '/echo/')
endif inSection
enddo
if (echo) then
do s = 1, size(sectionNames)
call part(s)%show()
end do
end if
2018-06-09 17:18:37 +05:30
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: &
IO_error
implicit none
character(len=*), intent(in) :: what
integer(pInt) :: i
! select case(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
! call IO_error(0_pInt,ext_msg='config_deallocate')
!
! end select
end subroutine config_deallocate
!##################################################################################################
! The folowing functions are part of the tPartitionedStringList object
!##################################################################################################
!--------------------------------------------------------------------------------------------------
!> @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
!--------------------------------------------------------------------------------------------------
subroutine add(this,string)
use IO, only: &
IO_isBlank, &
IO_lc, &
IO_stringPos
implicit none
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: string
type(tPartitionedStringList), pointer :: new, item
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
enddo
item%next => new
end subroutine add
!--------------------------------------------------------------------------------------------------
!> @brief prints all elements
!> @details Strings are printed in order of insertion (FIFO)
!--------------------------------------------------------------------------------------------------
subroutine show(this)
implicit none
class(tPartitionedStringList) :: this
type(tPartitionedStringList), pointer :: item
item => this%next
do while (associated(item))
write(6,'(a)') trim(item%string%val)
item => item%next
end do
end subroutine show
!--------------------------------------------------------------------------------------------------
!> @brief cleans entire list
!> @details list head remains alive
!--------------------------------------------------------------------------------------------------
subroutine free(this)
implicit none
class(tPartitionedStringList), target, intent(in) :: this
type(tPartitionedStringList), pointer :: new, item
2018-06-27 12:34:14 +05:30
if (.not. associated(this%next)) return
item => this%next
do while (associated(item%next))
new => item
deallocate(item)
item => new%next
enddo
deallocate(item)
end subroutine free
!--------------------------------------------------------------------------------------------------
!> @brief reports wether a given key (string value at first position) exists in the list
!--------------------------------------------------------------------------------------------------
logical function keyExists(this,key)
use IO, only: &
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
type(tPartitionedStringList), pointer :: item
keyExists = .false.
item => this%next
do while (associated(item) .and. .not. keyExists)
keyExists = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)
item => item%next
end do
end function keyExists
!--------------------------------------------------------------------------------------------------
!> @brief count number of key appearances
!> @details traverses list and counts each occurrence of specified key
!--------------------------------------------------------------------------------------------------
integer(pInt) function countKeys(this,key)
use IO, only: &
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
type(tPartitionedStringList), pointer :: item
countKeys = 0_pInt
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) &
countKeys = countKeys + 1_pInt
item => item%next
end do
end function countKeys
!--------------------------------------------------------------------------------------------------
2018-06-22 03:18:34 +05:30
!> @brief gets float value of for a given key from a linked list
!> @details gets the last value if the key occurs more than once. If key is not found exits with
!! error unless default is given
!--------------------------------------------------------------------------------------------------
real(pReal) function getFloat(this,key,defaultVal)
use IO, only : &
IO_error, &
IO_stringValue, &
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
found = present(defaultVal)
if (found) getFloat = defaultVal
item => this%next
do while (associated(item))
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)
getFloat = IO_FloatValue(item%string%val,item%string%pos,2)
endif
item => item%next
end do
if (.not. found) call IO_error(140_pInt,ext_msg=key)
end function getFloat
!--------------------------------------------------------------------------------------------------
2018-06-22 03:18:34 +05:30
!> @brief gets integer value of for a given key from a linked list
!> @details gets the last value if the key occurs more than once. If key is not found exits with
!! error unless default is given
!--------------------------------------------------------------------------------------------------
integer(pInt) function getInt(this,key,defaultVal)
use IO, only: &
IO_error, &
IO_stringValue, &
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
found = present(defaultVal)
if (found) getInt = defaultVal
item => this%next
do while (associated(item))
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)
getInt = IO_IntValue(item%string%val,item%string%pos,2)
endif
item => item%next
end do
if (.not. found) call IO_error(140_pInt,ext_msg=key)
end function getInt
!--------------------------------------------------------------------------------------------------
2018-06-22 03:18:34 +05:30
!> @brief gets string value of for a given key from a linked list
!> @details gets the last value if the key occurs more than once. If key is not found exits with
!! error unless default is given. If raw is true, the the complete string is returned, otherwise
!! the individual chunks are returned
!--------------------------------------------------------------------------------------------------
character(len=65536) function getString(this,key,defaultVal,raw)
use IO, only: &
IO_error, &
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
whole = merge(raw,.false.,present(raw)) ! whole string or white space splitting
found = present(defaultVal)
if (found) then
2018-06-26 22:48:23 +05:30
getString = trim(defaultVal)
if (len_trim(getString) /= len_trim(defaultVal)) call IO_error(0_pInt,ext_msg='getString')
endif
item => this%next
do while (associated(item))
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)
if (whole) then
getString = trim(item%string%val(item%string%pos(4):)) ! raw string starting a second chunk
else
getString = IO_StringValue(item%string%val,item%string%pos,2)
endif
endif
item => item%next
end do
if (.not. found) call IO_error(140_pInt,ext_msg=key)
end function getString
!--------------------------------------------------------------------------------------------------
2018-06-22 03:18:34 +05:30
!> @brief gets array of float values of for a given key from a linked list
!> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all
!! values from the last occurrence. If key is not found exits with error unless default is given.
!--------------------------------------------------------------------------------------------------
function getFloats(this,key,defaultVal,requiredShape)
2018-06-22 03:18:34 +05:30
use IO, only: &
IO_error, &
IO_stringValue, &
IO_FloatValue
implicit none
2018-06-22 03:18:34 +05:30
real(pReal), dimension(:), allocatable :: getFloats
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
real(pReal), dimension(:), intent(in), optional :: defaultVal
integer(pInt), dimension(:), intent(in), optional :: requiredShape
2018-06-22 03:18:34 +05:30
type(tPartitionedStringList), pointer :: item
integer(pInt) :: i
logical :: found, &
2018-06-22 03:18:34 +05:30
cumulative
cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
found = .false.
2018-06-22 03:18:34 +05:30
allocate(getFloats(0))
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
2018-06-26 22:48:23 +05:30
if (.not. cumulative) getFloats = [real(pReal)::]
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
2018-06-22 03:18:34 +05:30
do i = 2_pInt, item%string%pos(1)
getFloats = [getFloats,IO_FloatValue(item%string%val,item%string%pos,i)]
enddo
endif
item => item%next
end do
if (.not. found) then
if (present(defaultVal)) then; getFloats = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif
endif
2018-06-22 03:18:34 +05:30
end function getFloats
!--------------------------------------------------------------------------------------------------
2018-06-22 03:18:34 +05:30
!> @brief gets array of integer values of for a given key from a linked list
!> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all
!! values from the last occurrence. If key is not found exits with error unless default is given.
!--------------------------------------------------------------------------------------------------
function getInts(this,key,defaultVal,requiredShape)
use IO, only: &
IO_error, &
IO_stringValue, &
IO_IntValue
implicit none
integer(pInt), dimension(:), allocatable :: getInts
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
integer(pInt), dimension(:), intent(in), optional :: defaultVal, &
requiredShape
type(tPartitionedStringList), pointer :: item
integer(pInt) :: i
logical :: found, &
cumulative
cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
found = .false.
allocate(getInts(0))
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
2018-06-26 22:48:23 +05:30
if (.not. cumulative) getInts = [integer(pInt)::]
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
do i = 2_pInt, item%string%pos(1)
getInts = [getInts,IO_IntValue(item%string%val,item%string%pos,i)]
enddo
endif
item => item%next
end do
if (.not. found) then
if (present(defaultVal)) then; getInts = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif
endif
end function getInts
!--------------------------------------------------------------------------------------------------
2018-06-22 03:18:34 +05:30
!> @brief gets array of string values of for a given key from a linked list
!> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all
!! values from the last occurrence. If key is not found exits with error unless default is given.
!! If raw is true, the the complete string is returned, otherwise the individual chunks are returned
!--------------------------------------------------------------------------------------------------
function getStrings(this,key,defaultVal,requiredShape,raw)
use IO, only: &
IO_error, &
2018-06-22 03:18:34 +05:30
IO_StringValue
implicit none
2018-06-22 03:18:34 +05:30
character(len=65536),dimension(:), allocatable :: getStrings
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
character(len=65536),dimension(:), intent(in), optional :: defaultVal
integer(pInt), dimension(:), intent(in), optional :: requiredShape
2018-06-22 03:18:34 +05:30
logical, intent(in), optional :: raw
type(tPartitionedStringList), pointer :: item
character(len=65536) :: str
integer(pInt) :: i
logical :: found, &
whole, &
2018-06-22 03:18:34 +05:30
cumulative
cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
whole = merge(raw,.false.,present(raw))
found = .false.
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
2018-06-22 03:18:34 +05:30
if (allocated(getStrings) .and. .not. cumulative) deallocate(getStrings)
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
2018-06-22 03:18:34 +05:30
notAllocated: if (.not. allocated(getStrings)) then
if (whole) then
str = item%string%val(item%string%pos(4):)
getStrings = [str]
else
2018-06-22 03:18:34 +05:30
str = IO_StringValue(item%string%val,item%string%pos,2_pInt)
allocate(getStrings(1),source=str)
do i=3_pInt,item%string%pos(1)
str = IO_StringValue(item%string%val,item%string%pos,i)
getStrings = [getStrings,str]
enddo
endif
else notAllocated
if (whole) then
2018-08-01 02:45:44 +05:30
str = item%string%val(item%string%pos(4):)
getStrings = [getStrings,str]
else
2018-06-22 03:18:34 +05:30
do i=2_pInt,item%string%pos(1)
str = IO_StringValue(item%string%val,item%string%pos,i)
getStrings = [getStrings,str]
enddo
endif
endif notAllocated
endif
item => item%next
end do
if (.not. found) then
if (present(defaultVal)) then; getStrings = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif
endif
2018-06-22 03:18:34 +05:30
end function getStrings
end module config