223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Merge remote-tracking branch 'remotes/origin/36-faster-file-handling-for-material-config-use-stream-access-instead-of-line-wise-reading' into development

This commit is contained in:
Franz Roters 2018-08-27 15:13:16 +02:00
parent 1a5c815310 7ecb7689f1
commit 38fd517c44
9 changed files with 296 additions and 365 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

285
src/IO.f90
View File

@ -22,6 +22,7 @@ module IO
public :: &
IO_init, &
IO_read, &
IO_recursiveRead, &
IO_checkAndRewind, &
IO_open_file_stat, &
IO_open_jobFile_stat, &
@ -35,10 +36,6 @@ module IO
IO_hybridIA, &
IO_isBlank, &
IO_getTag, &
IO_countSections, &
IO_countTagInPart, &
IO_spotTagInPart, &
IO_globalTagInPart, &
IO_stringPos, &
IO_stringValue, &
IO_fixedStringValue ,&
@ -100,6 +97,7 @@ end subroutine IO_init
!--------------------------------------------------------------------------------------------------
!> @brief recursively reads a line from a text file.
!! Recursion is triggered by "{path/to/inputfile}" in a line
!> @details unstable and buggy
!--------------------------------------------------------------------------------------------------
recursive function IO_read(fileUnit,reset) result(line)
@ -151,7 +149,7 @@ recursive function IO_read(fileUnit,reset) result(line)
pathOn(stack) = path(1:scan(path,SEP,.true.))//input ! glue include to current file's dir
endif
open(newunit=unitOn(stack),iostat=myStat,file=pathOn(stack),action='read') ! open included file
open(newunit=unitOn(stack),iostat=myStat,file=pathOn(stack),action='read',status='old',position='rewind') ! open included file
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=pathOn(stack))
line = IO_read(fileUnit)
@ -170,6 +168,80 @@ recursive function IO_read(fileUnit,reset) result(line)
end function IO_read
!--------------------------------------------------------------------------------------------------
!> @brief recursively reads a text file.
!! Recursion is triggered by "{path/to/inputfile}" in a line
!--------------------------------------------------------------------------------------------------
recursive function IO_recursiveRead(fileName,cnt) result(fileContent)
implicit none
character(len=*), intent(in) :: fileName
integer(pInt), intent(in), optional :: cnt !< recursion counter
character(len=256), dimension(:), allocatable :: fileContent !< file content, separated per lines
character(len=256), dimension(:), allocatable :: includedContent
character(len=256) :: line
character(len=256), parameter :: dummy = 'https://damask.mpie.de' !< to fill up remaining array
character(len=:), allocatable :: rawData
integer(pInt) :: &
fileLength, &
fileUnit, &
startPos, endPos, &
myTotalLines, & !< # lines read from file without include statements
includedLines, & !< # lines included from other file(s)
missingLines, & !< # lines missing from current file
l,i, &
myStat
if (merge(cnt,0_pInt,present(cnt))>10_pInt) call IO_error(106_pInt,ext_msg=trim(fileName))
!--------------------------------------------------------------------------------------------------
! read data as stream
inquire(file = fileName, size=fileLength)
open(newunit=fileUnit, file=fileName, access='stream',&
status='old', position='rewind', action='read',iostat=myStat)
if(myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=trim(fileName))
allocate(character(len=fileLength)::rawData)
read(fileUnit) rawData
close(fileUnit)
!--------------------------------------------------------------------------------------------------
! count lines to allocate string array
myTotalLines = 0_pInt
do l=1_pInt, len(rawData)
if (rawData(l:l) == new_line('')) myTotalLines = myTotalLines+1
enddo
allocate(fileContent(myTotalLines))
!--------------------------------------------------------------------------------------------------
! split raw data at end of line and handle includes
startPos = 1_pInt
endPos = 0_pInt
includedLines=0_pInt
l=0_pInt
do while (startPos <= len(rawData))
l = l + 1_pInt
endPos = endPos + scan(rawData(startPos:),new_line(''))
if(endPos - startPos >256) call IO_error(107_pInt,ext_msg=trim(fileName))
line = rawData(startPos:endPos-1_pInt)
startPos = endPos + 1_pInt
recursion: if(scan(trim(line),'{') < scan(trim(line),'}')) then
myTotalLines = myTotalLines - 1_pInt
includedContent = IO_recursiveRead(trim(line(scan(line,'{')+1_pInt:scan(line,'}')-1_pInt)), &
merge(cnt,1_pInt,present(cnt))) ! to track recursion depth
includedLines = includedLines + size(includedContent)
missingLines = myTotalLines + includedLines - size(fileContent(1:l-1)) -size(includedContent)
fileContent = [ fileContent(1:l-1_pInt), includedContent, [(dummy,i=1,missingLines)] ] ! add content and grow array
l = l - 1_pInt + size(includedContent)
else recursion
fileContent(l) = line
endif recursion
enddo
end function IO_recursiveRead
!--------------------------------------------------------------------------------------------------
!> @brief checks if unit is opened for reading, if true rewinds. Otherwise stops with
@ -178,7 +250,7 @@ end function IO_read
subroutine IO_checkAndRewind(fileUnit)
implicit none
integer(pInt), intent(in) :: fileUnit !< file unit
integer(pInt), intent(in) :: fileUnit !< file unit
logical :: fileOpened
character(len=15) :: fileRead
@ -203,7 +275,7 @@ subroutine IO_open_file(fileUnit,path)
integer(pInt) :: myStat
open(fileUnit,status='old',iostat=myStat,file=path)
open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind')
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
end subroutine IO_open_file
@ -222,7 +294,8 @@ logical function IO_open_file_stat(fileUnit,path)
integer(pInt) :: myStat
open(fileUnit,status='old',iostat=myStat,file=path)
open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind')
if (myStat /= 0_pInt) close(fileUnit)
IO_open_file_stat = (myStat == 0_pInt)
end function IO_open_file_stat
@ -246,7 +319,7 @@ subroutine IO_open_jobFile(fileUnit,ext)
character(len=1024) :: path
path = trim(getSolverJobName())//'.'//ext
open(fileUnit,status='old',iostat=myStat,file=path)
open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind')
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
end subroutine IO_open_jobFile
@ -270,7 +343,8 @@ logical function IO_open_jobFile_stat(fileUnit,ext)
character(len=1024) :: path
path = trim(getSolverJobName())//'.'//ext
open(fileUnit,status='old',iostat=myStat,file=path)
open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind')
if (myStat /= 0_pInt) close(fileUnit)
IO_open_jobFile_stat = (myStat == 0_pInt)
end function IO_open_JobFile_stat
@ -296,11 +370,11 @@ subroutine IO_open_inputFile(fileUnit,modelName)
fileType = 1_pInt ! assume .pes
path = trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used
open(fileUnit+1,status='old',iostat=myStat,file=path)
open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind')
if(myStat /= 0_pInt) then ! if .pes does not work / exist; use conventional extension, i.e.".inp"
fileType = 2_pInt
path = trim(modelName)//inputFileExtension(fileType)
open(fileUnit+1,status='old',iostat=myStat,file=path)
open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind')
endif
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
@ -335,7 +409,7 @@ subroutine IO_open_logFile(fileUnit)
character(len=1024) :: path
path = trim(getSolverJobName())//LogFileExtension
open(fileUnit,status='old',iostat=myStat,file=path)
open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind')
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
end subroutine IO_open_logFile
@ -755,16 +829,22 @@ pure function IO_getTag(string,openChar,closeChar)
character(len=*), intent(in) :: string !< string to check for tag
character(len=len_trim(string)) :: IO_getTag
character(len=*), intent(in) :: openChar, & !< indicates beginning of tag
closeChar !< indicates end of tag
character, intent(in) :: openChar, & !< indicates beginning of tag
closeChar !< indicates end of tag
character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
integer :: left,right ! no pInt
IO_getTag = ''
left = scan(string,openChar)
right = scan(string,closeChar)
if (openChar /= closeChar) then
left = scan(string,openChar)
right = scan(string,closeChar)
else
left = scan(string,openChar)
right = left + merge(scan(string(left+1:),openChar),0_pInt,len(string) > left)
endif
if (left == verify(string,SEP) .and. right > left) & ! openChar is first and closeChar occurs
IO_getTag = string(left+1:right-1)
@ -772,173 +852,6 @@ pure function IO_getTag(string,openChar,closeChar)
end function IO_getTag
!--------------------------------------------------------------------------------------------------
!> @brief count number of [sections] in <part> for given file handle
!--------------------------------------------------------------------------------------------------
integer(pInt) function IO_countSections(fileUnit,part)
implicit none
integer(pInt), intent(in) :: fileUnit !< file handle
character(len=*), intent(in) :: part !< part name in which sections are counted
character(len=65536) :: line
line = ''
IO_countSections = 0_pInt
rewind(fileUnit)
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part
line = IO_read(fileUnit)
enddo
do while (trim(line) /= IO_EOF)
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
IO_countSections = IO_countSections + 1_pInt
enddo
end function IO_countSections
!--------------------------------------------------------------------------------------------------
!> @brief returns array of tag counts within <part> for at most N [sections]
!--------------------------------------------------------------------------------------------------
function IO_countTagInPart(fileUnit,part,tag,Nsections)
implicit none
integer(pInt), intent(in) :: Nsections !< maximum number of sections in which tag is searched for
integer(pInt), dimension(Nsections) :: IO_countTagInPart
integer(pInt), intent(in) :: fileUnit !< file handle
character(len=*),intent(in) :: part, & !< part in which tag is searched for
tag !< tag to search for
integer(pInt), dimension(Nsections) :: counter
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: section
character(len=65536) :: line
line = ''
counter = 0_pInt
section = 0_pInt
rewind(fileUnit)
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part
line = IO_read(fileUnit)
enddo
do while (trim(line) /= IO_EOF)
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier
if (section > 0) then
chunkPos = IO_stringPos(line)
if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) & ! match
counter(section) = counter(section) + 1_pInt
endif
enddo
IO_countTagInPart = counter
end function IO_countTagInPart
!--------------------------------------------------------------------------------------------------
!> @brief returns array of tag presence within <part> for at most N [sections]
!--------------------------------------------------------------------------------------------------
function IO_spotTagInPart(fileUnit,part,tag,Nsections)
implicit none
integer(pInt), intent(in) :: Nsections !< maximum number of sections in which tag is searched for
logical, dimension(Nsections) :: IO_spotTagInPart
integer(pInt), intent(in) :: fileUnit !< file handle
character(len=*),intent(in) :: part, & !< part in which tag is searched for
tag !< tag to search for
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: section
character(len=65536) :: line
IO_spotTagInPart = .false. ! assume to nowhere spot tag
section = 0_pInt
line = ''
rewind(fileUnit)
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part
line = IO_read(fileUnit)
enddo
do while (trim(line) /= IO_EOF)
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
foundNextPart: if (IO_getTag(line,'<','>') /= '') then
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif foundNextPart
if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier
if (section > 0_pInt) then
chunkPos = IO_stringPos(line)
if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) & ! match
IO_spotTagInPart(section) = .true.
endif
enddo
end function IO_spotTagInPart
!--------------------------------------------------------------------------------------------------
!> @brief return logical whether tag is present within <part> before any [sections]
!--------------------------------------------------------------------------------------------------
logical function IO_globalTagInPart(fileUnit,part,tag)
implicit none
integer(pInt), intent(in) :: fileUnit !< file handle
character(len=*),intent(in) :: part, & !< part in which tag is searched for
tag !< tag to search for
integer(pInt), allocatable, dimension(:) :: chunkPos
character(len=65536) :: line
IO_globalTagInPart = .false. ! assume to nowhere spot tag
line =''
rewind(fileUnit)
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part
line = IO_read(fileUnit)
enddo
do while (trim(line) /= IO_EOF)
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
foundNextPart: if (IO_getTag(line,'<','>') /= '') then
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif foundNextPart
foundFirstSection: if (IO_getTag(line,'[',']') /= '') then
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif foundFirstSection
chunkPos = IO_stringPos(line)
match: if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) then
IO_globalTagInPart = .true.
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif match
enddo
end function IO_globalTagInPart
!--------------------------------------------------------------------------------------------------
!> @brief locates all space-separated chunks in given string and returns array containing number
!! them and the left/right position to be used by IO_xxxVal
@ -1513,6 +1426,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
msg = 'unknown output:'
case (106_pInt)
msg = 'working directory does not exist:'
case (107_pInt)
msg = 'line length exceeds limit of 256'
!--------------------------------------------------------------------------------------------------
! lattice error messages

329
src/config.f90
View File

@ -20,12 +20,17 @@ module config
type, public :: tPartitionedStringList
type(tPartitionedString) :: string
type(tPartitionedStringList), pointer :: next => null()
contains
procedure :: add => add
procedure :: show => show
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
@ -37,11 +42,10 @@ module config
procedure :: getInts => getInts
procedure :: getStrings => getStrings
end type tPartitionedStringList
type(tPartitionedStringList), public :: emptyList
type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & ! QUESTION: rename to config_XXX?
type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: &
config_phase, &
config_microstructure, &
config_homogenization, &
@ -76,7 +80,6 @@ module config
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
@ -92,12 +95,14 @@ subroutine config_init()
compiler_version, &
compiler_options
#endif
use prec, only: &
pStringLen
use DAMASK_interface, only: &
getSolverJobName
use IO, only: &
IO_error, &
IO_open_file, &
IO_read, &
IO_lc, &
IO_open_jobFile_stat, &
IO_recursiveRead, &
IO_getTag, &
IO_timeStamp, &
IO_EOF
@ -107,12 +112,13 @@ subroutine config_init()
debug_levelBasic
implicit none
integer(pInt), parameter :: FILEUNIT = 200_pInt
integer(pInt) :: myDebug
integer(pInt) :: myDebug,i
character(len=65536) :: &
character(len=pStringLen) :: &
line, &
part
character(len=pStringLen), dimension(:), allocatable :: fileContent
logical :: fileExists
write(6,'(/,a)') ' <<<+- config init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
@ -120,39 +126,40 @@ subroutine config_init()
myDebug = debug_level(debug_material)
if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present...
call IO_open_file(FILEUNIT,material_configFile) ! ...open material.config file
inquire(file=trim(getSolverJobName())//'.'//material_localFileExt,exist=fileExists)
if(fileExists) then
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')
fileContent = IO_recursiveRead('material.config')
endif
rewind(fileUnit)
line = '' ! to have it initialized
do while (trim(line) /= IO_EOF)
do i = 1_pInt, 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,FILEUNIT)
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))
call parseFile(line,microstructure_name,config_microstructure,FILEUNIT)
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))
call parseFile(line,crystallite_name,config_crystallite,FILEUNIT)
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))
call parseFile(line,homogenization_name,config_homogenization,FILEUNIT)
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))
call parseFile(line,texture_name,config_texture,FILEUNIT)
call parseFile(line,texture_name,config_texture,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6)
case default
line = IO_read(fileUnit)
end select
enddo
@ -173,107 +180,81 @@ end subroutine config_init
!--------------------------------------------------------------------------------------------------
!> @brief parses the material.config file
!--------------------------------------------------------------------------------------------------
subroutine parseFile(line,&
sectionNames,part,fileUnit)
subroutine parseFile(line,sectionNames,part,&
fileContent)
use prec, only: &
pStringLen
use IO, only: &
IO_read, &
IO_error, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringValue, &
IO_stringPos, &
IO_EOF
IO_getTag
implicit none
integer(pInt), intent(in) :: fileUnit
character(len=*), dimension(:), allocatable, intent(inout) :: sectionNames
type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: part
character(len=65536),intent(out) :: line
character(len=pStringLen), intent(out) :: line
character(len=64), allocatable, dimension(:), intent(out) :: sectionNames
type(tPartitionedStringList), allocatable, dimension(:), intent(out) :: part
character(len=pStringLen), dimension(:), intent(in) :: fileContent
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: s
character(len=65536) :: devNull
character(len=64) :: tag
integer(pInt), allocatable, dimension(:) :: partPosition ! position of [] tags + last line in section
integer(pInt) :: i, j
logical :: echo
echo = .false.
allocate(part(0))
s = 0_pInt
do while (trim(line) /= IO_EOF) ! read through sections of material part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
foundNextPart: if (IO_getTag(line,'<','>') /= '') then
devNull = IO_read(fileUnit, .true.) ! reset IO_read to close any recursively included files
exit
endif foundNextPart
allocate(partPosition(0))
do i = 1_pInt, size(fileContent)
line = trim(fileContent(i))
if (IO_getTag(line,'<','>') /= '') exit
nextSection: if (IO_getTag(line,'[',']') /= '') then
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
partPosition = [partPosition, i]
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
if (size(partPosition) < 1_pInt) &
echo = (trim(IO_getTag(line,'/','/')) == 'echo') .or. echo
enddo
if (echo) then
do s = 1, size(sectionNames)
call part(s)%show()
end do
end if
allocate(sectionNames(size(partPosition)))
allocate(part(size(partPosition)))
partPosition = [partPosition, i] ! needed when actually storing content
do i = 1_pInt, size(partPosition) -1_pInt
sectionNames(i) = trim(adjustl(fileContent(partPosition(i))))
do j = partPosition(i) + 1_pInt, partPosition(i+1) -1_pInt
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
end subroutine parseFile
!--------------------------------------------------------------------------------------------------
!> @brief deallocates the linked lists that store the content of the configuration files
!--------------------------------------------------------------------------------------------------
subroutine config_deallocate(what)
use IO, only: &
IO_error
implicit none
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
@ -284,11 +265,17 @@ subroutine config_deallocate(what)
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
!! to lower case. The data is not stored in the new element but in the current.
!--------------------------------------------------------------------------------------------------
subroutine add(this,string)
use IO, only: &
@ -299,19 +286,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
@ -323,12 +309,12 @@ 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))
write(6,'(a)') trim(item%string%val)
item => this
do while (associated(item%next))
write(6,'(a)') ' '//trim(item%string%val)
item => item%next
end do
@ -336,28 +322,55 @@ end subroutine show
!--------------------------------------------------------------------------------------------------
!> @brief cleans entire list
!> @details list head is remains alive
!> @brief empties list and frees associated memory
!> @details explicit interface to reset list. Triggers final statement (and following chain reaction)
!--------------------------------------------------------------------------------------------------
subroutine free(this)
implicit none
class(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 empties list and frees associated memory
!> @details called when variable goes out of scope. Triggers chain reaction for list
!--------------------------------------------------------------------------------------------------
recursive subroutine finalize(this)
implicit none
type(tPartitionedStringList), intent(inout) :: this
if(associated(this%next)) deallocate(this%next)
end subroutine finalize
!--------------------------------------------------------------------------------------------------
!> @brief cleans entire array of linke lists
!> @details called when variable goes out of scope.
!--------------------------------------------------------------------------------------------------
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
!--------------------------------------------------------------------------------------------------
@ -366,14 +379,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
@ -391,14 +404,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
@ -419,17 +432,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)
@ -455,17 +468,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)
@ -491,13 +504,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)
@ -506,8 +519,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)
@ -539,7 +552,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
@ -553,8 +566,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)::]
@ -586,7 +599,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
@ -600,8 +613,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)::]
@ -633,7 +646,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
@ -649,8 +662,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)

7
src/constitutive.f90
View File

@ -58,14 +58,15 @@ subroutine constitutive_init()
IO_write_jobIntFile, &
IO_timeStamp
use config, only: &
config_deallocate
config_phase
use mesh, only: &
FE_geomtype
use config, only: &
material_Nphase, &
material_localFileExt, &
phase_name, &
material_configFile
material_configFile, &
config_deallocate
use material, only: &
material_phase, &
phase_plasticity, &
@ -138,7 +139,7 @@ subroutine constitutive_init()
use kinematics_hydrogen_strain
implicit none
integer(pInt), parameter :: FILEUNIT = 200_pInt
integer(pInt), parameter :: FILEUNIT = 204_pInt
integer(pInt) :: &
o, & !< counter in output loop
ph, & !< counter in phase loop

4
src/crystallite.f90
View File

@ -172,9 +172,9 @@ subroutine crystallite_init
IO_error
use material
use config, only: &
config_deallocate, &
config_crystallite, &
crystallite_name, &
config_deallocate
crystallite_name
use constitutive, only: &
constitutive_initialFi, &
constitutive_microstructure ! derived (shortcut) quantities of given state

2
src/debug.f90
View File

@ -102,7 +102,7 @@ subroutine debug_init
IO_EOF
implicit none
integer(pInt), parameter :: FILEUNIT = 300_pInt
integer(pInt), parameter :: FILEUNIT = 330_pInt
integer(pInt) :: i, what
integer(pInt), allocatable, dimension(:) :: chunkPos

2
src/homogenization.f90
View File

@ -85,9 +85,9 @@ subroutine homogenization_init
use crystallite, only: &
crystallite_maxSizePostResults
use config, only: &
config_deallocate, &
material_configFile, &
material_localFileExt, &
config_deallocate, &
config_homogenization, &
homogenization_name
use material

14
src/material.f90
View File

@ -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, &
@ -370,7 +369,7 @@ subroutine material_init()
FE_geomtype
implicit none
integer(pInt), parameter :: FILEUNIT = 200_pInt
integer(pInt), parameter :: FILEUNIT = 210_pInt
integer(pInt) :: m,c,h, myDebug, myPhase, myHomog
integer(pInt) :: &
g, & !< grain number
@ -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,8 @@ subroutine material_parseTexture
IO_floatValue, &
IO_stringValue
use config, only: &
config_texture, &
config_deallocate
config_deallocate, &
config_texture
use math, only: &
inRad, &
math_sampleRandomOri, &
@ -1061,7 +1059,7 @@ subroutine material_parseTexture
endif
enddo
call config_deallocate('material.config/texture')
call config_deallocate('material.config/texture')
end subroutine material_parseTexture
@ -1093,6 +1091,7 @@ subroutine material_populateGrains
use config, only: &
config_homogenization, &
config_microstructure, &
config_deallocate, &
homogenization_name, &
microstructure_name
use IO, only: &
@ -1429,6 +1428,7 @@ subroutine material_populateGrains
deallocate(texture_transformation)
deallocate(Nelems)
deallocate(elemsOfHomogMicro)
call config_deallocate('material.config/microstructure')
end subroutine material_populateGrains

16
src/plastic_phenopowerlaw.f90
View File

@ -241,29 +241,29 @@ subroutine plastic_phenopowerlaw_init
select case(outputs(i))
case ('resistance_slip')
outputID = resistance_slip_ID
outputSize = sum(prm%Nslip)
outputSize = prm%totalNslip
case ('accumulatedshear_slip')
outputID = accumulatedshear_slip_ID
outputSize = sum(prm%Nslip)
outputSize = prm%totalNslip
case ('shearrate_slip')
outputID = shearrate_slip_ID
outputSize = sum(prm%Nslip)
outputSize = prm%totalNslip
case ('resolvedstress_slip')
outputID = resolvedstress_slip_ID
outputSize = sum(prm%Nslip)
outputSize = prm%totalNslip
case ('resistance_twin')
outputID = resistance_twin_ID
outputSize = sum(prm%Ntwin)
outputSize = prm%totalNtwin
case ('accumulatedshear_twin')
outputID = accumulatedshear_twin_ID
outputSize = sum(prm%Ntwin)
outputSize = prm%totalNtwin
case ('shearrate_twin')
outputID = shearrate_twin_ID
outputSize = sum(prm%Ntwin)
outputSize = prm%totalNtwin
case ('resolvedstress_twin')
outputID = resolvedstress_twin_ID
outputSize = sum(prm%Ntwin)
outputSize = prm%totalNtwin
case ('totalvolfrac_twin')
outputID = totalvolfrac_twin_ID

2
src/prec.f90
View File

@ -7,6 +7,7 @@
!> @brief setting precision for real and int type
!--------------------------------------------------------------------------------------------------
module prec
! ToDo: use, intrinsic :: iso_fortran_env, only : I8 => int64, WP => real64
implicit none
private
#if (FLOAT==8)
@ -23,6 +24,7 @@ module prec
NO SUITABLE PRECISION FOR INTEGER SELECTED, STOPPING COMPILATION
#endif
integer, parameter, public :: pStringLen = 256 !< default string lenth
integer, parameter, public :: pLongInt = 8 !< integer representation 64 bit (was selected_int_kind(12), number with at least up to +- 1e12)
real(pReal), parameter, public :: tol_math_check = 1.0e-8_pReal !< tolerance for internal math self-checks (rotation)