DAMASK_EICMD/src/config.f90

346 lines
13 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
2019-03-29 13:04:44 +05:30
use prec, only: &
pReal
use list, only: &
tPartitionedStringList
implicit none
type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: &
config_phase, &
config_microstructure, &
config_homogenization, &
config_texture, &
config_crystallite
2019-03-29 13:04:44 +05:30
type(tPartitionedStringList), public, protected :: &
config_numerics, &
config_debug
2019-03-29 13:04:44 +05:30
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
2018-06-27 00:24:54 +05:30
! ToDo: Remove, use size(config_phase) etc
2019-03-29 13:04:44 +05:30
integer, public, protected :: &
material_Nphase, & !< number of phases
material_Nhomogenization !< number of homogenizations
2019-03-29 13:04:44 +05:30
public :: &
config_init, &
config_deallocate
contains
!--------------------------------------------------------------------------------------------------
!> @brief reads material.config and stores its content per part
!--------------------------------------------------------------------------------------------------
subroutine config_init
2019-03-29 13:04:44 +05:30
use prec, only: &
pStringLen
use DAMASK_interface, only: &
getSolverJobName
use IO, only: &
IO_read_ASCII, &
IO_error, &
IO_lc, &
IO_getTag
use debug, only: &
debug_level, &
debug_material, &
debug_levelBasic
implicit none
integer :: myDebug,i
character(len=pStringLen) :: &
line, &
part
character(len=pStringLen), dimension(:), allocatable :: fileContent
logical :: fileExists
write(6,'(/,a)') ' <<<+- config init -+>>>'
myDebug = debug_level(debug_material)
inquire(file=trim(getSolverJobName())//'.materialConfig',exist=fileExists)
if(fileExists) then
write(6,'(/,a)') ' reading '//trim(getSolverJobName())//'.materialConfig'; flush(6)
fileContent = read_materialConfig(trim(getSolverJobName())//'.materialConfig')
else
inquire(file='material.config',exist=fileExists)
if(.not. fileExists) call IO_error(100,ext_msg='material.config')
write(6,'(/,a)') ' reading material.config'; flush(6)
fileContent = read_materialConfig('material.config')
endif
do i = 1, size(fileContent)
line = trim(fileContent(i))
part = IO_lc(IO_getTag(line,'<','>'))
select case (trim(part))
2019-03-29 13:04:44 +05:30
case (trim('phase'))
call parse_materialConfig(phase_name,config_phase,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Phase parsed'; flush(6)
2019-03-29 13:04:44 +05:30
case (trim('microstructure'))
call parse_materialConfig(microstructure_name,config_microstructure,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Microstructure parsed'; flush(6)
2019-03-29 13:04:44 +05:30
case (trim('crystallite'))
call parse_materialConfig(crystallite_name,config_crystallite,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Crystallite parsed'; flush(6)
2019-03-29 13:04:44 +05:30
case (trim('homogenization'))
call parse_materialConfig(homogenization_name,config_homogenization,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Homogenization parsed'; flush(6)
2019-03-29 13:04:44 +05:30
case (trim('texture'))
call parse_materialConfig(texture_name,config_texture,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Texture parsed'; flush(6)
2019-03-29 13:04:44 +05:30
end select
2019-03-29 13:04:44 +05:30
enddo
2019-03-08 13:18:06 +05:30
2019-03-29 13:04:44 +05:30
material_Nhomogenization = size(config_homogenization)
material_Nphase = size(config_phase)
2019-03-08 13:18:06 +05:30
2019-03-29 13:04:44 +05:30
if (material_Nhomogenization < 1) call IO_error(160,ext_msg='<homogenization>')
if (size(config_microstructure) < 1) call IO_error(160,ext_msg='<microstructure>')
if (size(config_crystallite) < 1) call IO_error(160,ext_msg='<crystallite>')
if (material_Nphase < 1) call IO_error(160,ext_msg='<phase>')
if (size(config_texture) < 1) call IO_error(160,ext_msg='<texture>')
2019-03-29 13:04:44 +05:30
inquire(file='numerics.config', exist=fileExists)
if (fileExists) then
write(6,'(/,a)') ' reading numerics.config'; flush(6)
fileContent = IO_read_ASCII('numerics.config')
call parse_debugAndNumericsConfig(config_numerics,fileContent)
endif
2019-03-29 13:04:44 +05:30
inquire(file='debug.config', exist=fileExists)
if (fileExists) then
write(6,'(/,a)') ' reading debug.config'; flush(6)
fileContent = IO_read_ASCII('debug.config')
call parse_debugAndNumericsConfig(config_debug,fileContent)
endif
2018-06-09 17:18:37 +05:30
2019-03-13 02:18:33 +05:30
contains
!--------------------------------------------------------------------------------------------------
!> @brief reads material.config
!! Recursion is triggered by "{path/to/inputfile}" in a line
!--------------------------------------------------------------------------------------------------
recursive function read_materialConfig(fileName,cnt) result(fileContent)
use IO, only: &
IO_warning
implicit none
character(len=*), intent(in) :: fileName
integer, intent(in), optional :: cnt !< recursion counter
character(len=pStringLen), dimension(:), allocatable :: fileContent !< file content, separated per lines
character(len=pStringLen), dimension(:), allocatable :: includedContent
character(len=pStringLen) :: line
character(len=pStringLen), parameter :: dummy = 'https://damask.mpie.de' !< to fill up remaining array
2019-03-13 02:18:33 +05:30
character(len=:), allocatable :: rawData
integer :: &
2019-03-13 02:18:33 +05:30
fileLength, &
fileUnit, &
startPos, endPos, &
myTotalLines, & !< # lines read from file without include statements
l,i, &
myStat
logical :: warned
if (present(cnt)) then
2019-03-13 02:59:03 +05:30
if (cnt>10) call IO_error(106,ext_msg=trim(fileName))
2019-03-13 02:18:33 +05:30
endif
!--------------------------------------------------------------------------------------------------
! read data as stream
inquire(file = fileName, size=fileLength)
if (fileLength == 0) then
allocate(fileContent(0))
return
endif
open(newunit=fileUnit, file=fileName, access='stream',&
status='old', position='rewind', action='read',iostat=myStat)
2019-03-13 02:59:03 +05:30
if(myStat /= 0) call IO_error(100,ext_msg=trim(fileName))
2019-03-13 02:18:33 +05:30
allocate(character(len=fileLength)::rawData)
read(fileUnit) rawData
close(fileUnit)
!--------------------------------------------------------------------------------------------------
! count lines to allocate string array
myTotalLines = 1
do l=1, len(rawData)
2019-03-13 02:18:33 +05:30
if (rawData(l:l) == new_line('')) myTotalLines = myTotalLines+1
enddo
allocate(fileContent(myTotalLines))
!--------------------------------------------------------------------------------------------------
! split raw data at end of line and handle includes
warned = .false.
startPos = 1
l = 1
2019-03-13 02:18:33 +05:30
do while (l <= myTotalLines)
endPos = merge(startPos + scan(rawData(startPos:),new_line('')) - 2,len(rawData),l /= myTotalLines)
if (endPos - startPos > pStringLen -1) then
line = rawData(startPos:startPos+pStringLen-1)
2019-03-13 02:18:33 +05:30
if (.not. warned) then
call IO_warning(207,ext_msg=trim(fileName),el=l)
2019-03-13 02:18:33 +05:30
warned = .true.
endif
else
line = rawData(startPos:endpos)
endif
startPos = endPos + 2 ! jump to next line start
2019-03-13 02:18:33 +05:30
recursion: if (scan(trim(adjustl(line)),'{') == 1 .and. scan(trim(line),'}') > 2) then
includedContent = read_materialConfig(trim(line(scan(line,'{')+1:scan(line,'}')-1)), &
merge(cnt,1,present(cnt))) ! to track recursion depth
fileContent = [ fileContent(1:l-1), includedContent, [(dummy,i=1,myTotalLines-l)] ] ! add content and grow array
myTotalLines = myTotalLines - 1 + size(includedContent)
l = l - 1 + size(includedContent)
2019-03-13 02:18:33 +05:30
else recursion
fileContent(l) = line
2019-03-13 02:59:03 +05:30
l = l + 1
2019-03-13 02:18:33 +05:30
endif recursion
enddo
end function read_materialConfig
!--------------------------------------------------------------------------------------------------
!> @brief parses the material.config file
!--------------------------------------------------------------------------------------------------
2019-03-13 02:18:33 +05:30
subroutine parse_materialConfig(sectionNames,part,line, &
fileContent)
use prec, only: &
pStringLen
use IO, only: &
IO_intOut
2019-03-29 13:04:44 +05:30
implicit none
character(len=64), allocatable, dimension(:), intent(out) :: sectionNames
type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: part
character(len=pStringLen), intent(inout) :: line
character(len=pStringLen), dimension(:), intent(in) :: fileContent
integer, allocatable, dimension(:) :: partPosition !< position of [] tags + last line in section
integer :: i, j
logical :: echo
character(len=pStringLen) :: section_ID
2019-03-29 13:04:44 +05:30
echo = .false.
2019-03-29 13:04:44 +05:30
if (allocated(part)) call IO_error(161,ext_msg=trim(line))
allocate(partPosition(0))
2019-03-29 13:04:44 +05:30
do i = 1, size(fileContent)
line = trim(fileContent(i))
if (IO_getTag(line,'<','>') /= '') exit
nextSection: if (IO_getTag(line,'[',']') /= '') then
partPosition = [partPosition, i]
cycle
endif nextSection
if (size(partPosition) < 1) &
echo = (trim(IO_getTag(line,'/','/')) == 'echo') .or. echo
enddo
allocate(sectionNames(size(partPosition)))
allocate(part(size(partPosition)))
partPosition = [partPosition, i] ! needed when actually storing content
do i = 1, size(partPosition) -1
write(section_ID,'('//IO_intOut(size(partPosition))//')') i
sectionNames(i) = trim(section_ID)//'_'//trim(adjustl(IO_getTag(fileContent(partPosition(i)),'[',']')))
2019-03-29 13:04:44 +05:30
do j = partPosition(i) + 1, partPosition(i+1) -1
call part(i)%add(trim(adjustl(fileContent(j))))
enddo
if (echo) then
write(6,*) 'section',i, '"'//trim(sectionNames(i))//'"'
call part(i)%show()
endif
enddo
2019-03-13 02:18:33 +05:30
end subroutine parse_materialConfig
!--------------------------------------------------------------------------------------------------
!> @brief parses the material.config file
!--------------------------------------------------------------------------------------------------
subroutine parse_debugAndNumericsConfig(config_list, &
fileContent)
2019-03-29 13:04:44 +05:30
implicit none
type(tPartitionedStringList), intent(out) :: config_list
character(len=pStringLen), dimension(:), intent(in) :: fileContent
integer :: i
2019-03-29 13:04:44 +05:30
do i = 1, size(fileContent)
call config_list%add(trim(adjustl(fileContent(i))))
enddo
end subroutine parse_debugAndNumericsConfig
2019-03-13 02:18:33 +05:30
end subroutine config_init
!--------------------------------------------------------------------------------------------------
!> @brief deallocates the linked lists that store the content of the configuration files
!--------------------------------------------------------------------------------------------------
subroutine config_deallocate(what)
2019-03-29 13:04:44 +05:30
use IO, only: &
IO_error
2019-03-29 13:04:44 +05:30
implicit none
character(len=*), intent(in) :: what
2019-03-29 13:04:44 +05:30
select case(trim(what))
2019-03-29 13:04:44 +05:30
case('material.config/phase')
deallocate(config_phase)
2019-03-29 13:04:44 +05:30
case('material.config/microstructure')
deallocate(config_microstructure)
2019-03-29 13:04:44 +05:30
case('material.config/crystallite')
deallocate(config_crystallite)
2019-03-29 13:04:44 +05:30
case('material.config/homogenization')
deallocate(config_homogenization)
2019-03-29 13:04:44 +05:30
case('material.config/texture')
deallocate(config_texture)
2019-03-29 13:04:44 +05:30
case('debug.config')
call config_debug%free
2019-03-29 13:04:44 +05:30
case('numerics.config')
call config_numerics%free
2019-03-29 13:04:44 +05:30
case default
call IO_error(0,ext_msg='config_deallocate')
2019-03-29 13:04:44 +05:30
end select
end subroutine config_deallocate
end module config