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 :: & public :: &
IO_init, & IO_init, &
IO_read, & IO_read, &
IO_recursiveRead, &
IO_checkAndRewind, & IO_checkAndRewind, &
IO_open_file_stat, & IO_open_file_stat, &
IO_open_jobFile_stat, & IO_open_jobFile_stat, &
@ -35,10 +36,6 @@ module IO
IO_hybridIA, & IO_hybridIA, &
IO_isBlank, & IO_isBlank, &
IO_getTag, & IO_getTag, &
IO_countSections, &
IO_countTagInPart, &
IO_spotTagInPart, &
IO_globalTagInPart, &
IO_stringPos, & IO_stringPos, &
IO_stringValue, & IO_stringValue, &
IO_fixedStringValue ,& IO_fixedStringValue ,&
@ -100,6 +97,7 @@ end subroutine IO_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief recursively reads a line from a text file. !> @brief recursively reads a line from a text file.
!! Recursion is triggered by "{path/to/inputfile}" in a line !! Recursion is triggered by "{path/to/inputfile}" in a line
!> @details unstable and buggy
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
recursive function IO_read(fileUnit,reset) result(line) 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 pathOn(stack) = path(1:scan(path,SEP,.true.))//input ! glue include to current file's dir
endif 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)) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=pathOn(stack))
line = IO_read(fileUnit) line = IO_read(fileUnit)
@ -170,6 +168,80 @@ recursive function IO_read(fileUnit,reset) result(line)
end function IO_read 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 !> @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) subroutine IO_checkAndRewind(fileUnit)
implicit none implicit none
integer(pInt), intent(in) :: fileUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
logical :: fileOpened logical :: fileOpened
character(len=15) :: fileRead character(len=15) :: fileRead
@ -203,7 +275,7 @@ subroutine IO_open_file(fileUnit,path)
integer(pInt) :: myStat 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) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
end subroutine IO_open_file end subroutine IO_open_file
@ -222,7 +294,8 @@ logical function IO_open_file_stat(fileUnit,path)
integer(pInt) :: myStat 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) IO_open_file_stat = (myStat == 0_pInt)
end function IO_open_file_stat end function IO_open_file_stat
@ -246,7 +319,7 @@ subroutine IO_open_jobFile(fileUnit,ext)
character(len=1024) :: path character(len=1024) :: path
path = trim(getSolverJobName())//'.'//ext 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) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
end subroutine IO_open_jobFile end subroutine IO_open_jobFile
@ -270,7 +343,8 @@ logical function IO_open_jobFile_stat(fileUnit,ext)
character(len=1024) :: path character(len=1024) :: path
path = trim(getSolverJobName())//'.'//ext 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) IO_open_jobFile_stat = (myStat == 0_pInt)
end function IO_open_JobFile_stat end function IO_open_JobFile_stat
@ -296,11 +370,11 @@ subroutine IO_open_inputFile(fileUnit,modelName)
fileType = 1_pInt ! assume .pes fileType = 1_pInt ! assume .pes
path = trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used 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" if(myStat /= 0_pInt) then ! if .pes does not work / exist; use conventional extension, i.e.".inp"
fileType = 2_pInt fileType = 2_pInt
path = trim(modelName)//inputFileExtension(fileType) 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 endif
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) 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 character(len=1024) :: path
path = trim(getSolverJobName())//LogFileExtension 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) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
end subroutine IO_open_logFile 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=*), intent(in) :: string !< string to check for tag
character(len=len_trim(string)) :: IO_getTag character(len=len_trim(string)) :: IO_getTag
character(len=*), intent(in) :: openChar, & !< indicates beginning of tag character, intent(in) :: openChar, & !< indicates beginning of tag
closeChar !< indicates end of tag closeChar !< indicates end of tag
character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
integer :: left,right ! no pInt integer :: left,right ! no pInt
IO_getTag = '' 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 if (left == verify(string,SEP) .and. right > left) & ! openChar is first and closeChar occurs
IO_getTag = string(left+1:right-1) IO_getTag = string(left+1:right-1)
@ -772,173 +852,6 @@ pure function IO_getTag(string,openChar,closeChar)
end function IO_getTag 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 !> @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 !! 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:' msg = 'unknown output:'
case (106_pInt) case (106_pInt)
msg = 'working directory does not exist:' msg = 'working directory does not exist:'
case (107_pInt)
msg = 'line length exceeds limit of 256'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! lattice error messages ! lattice error messages

329
src/config.f90
View File

@ -20,12 +20,17 @@ module config
type, public :: tPartitionedStringList type, public :: tPartitionedStringList
type(tPartitionedString) :: string type(tPartitionedString) :: string
type(tPartitionedStringList), pointer :: next => null() type(tPartitionedStringList), pointer :: next => null()
contains contains
procedure :: add => add procedure :: add => add
procedure :: show => show 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 :: keyExists => keyExists
procedure :: countKeys => countKeys procedure :: countKeys => countKeys
@ -37,11 +42,10 @@ module config
procedure :: getInts => getInts procedure :: getInts => getInts
procedure :: getStrings => getStrings procedure :: getStrings => getStrings
end type tPartitionedStringList end type tPartitionedStringList
type(tPartitionedStringList), public :: emptyList type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: &
type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & ! QUESTION: rename to config_XXX?
config_phase, & config_phase, &
config_microstructure, & config_microstructure, &
config_homogenization, & config_homogenization, &
@ -76,7 +80,6 @@ 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 config_deallocate
@ -92,12 +95,14 @@ subroutine config_init()
compiler_version, & compiler_version, &
compiler_options compiler_options
#endif #endif
use prec, only: &
pStringLen
use DAMASK_interface, only: &
getSolverJobName
use IO, only: & use IO, only: &
IO_error, & IO_error, &
IO_open_file, &
IO_read, &
IO_lc, & IO_lc, &
IO_open_jobFile_stat, & IO_recursiveRead, &
IO_getTag, & IO_getTag, &
IO_timeStamp, & IO_timeStamp, &
IO_EOF IO_EOF
@ -107,12 +112,13 @@ subroutine config_init()
debug_levelBasic debug_levelBasic
implicit none implicit none
integer(pInt), parameter :: FILEUNIT = 200_pInt integer(pInt) :: myDebug,i
integer(pInt) :: myDebug
character(len=65536) :: & character(len=pStringLen) :: &
line, & line, &
part part
character(len=pStringLen), dimension(:), allocatable :: fileContent
logical :: fileExists
write(6,'(/,a)') ' <<<+- config init -+>>>' write(6,'(/,a)') ' <<<+- config init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp() write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
@ -120,39 +126,40 @@ subroutine config_init()
myDebug = debug_level(debug_material) myDebug = debug_level(debug_material)
if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... inquire(file=trim(getSolverJobName())//'.'//material_localFileExt,exist=fileExists)
call IO_open_file(FILEUNIT,material_configFile) ! ...open material.config file 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) do i = 1_pInt, size(fileContent)
line = '' ! to have it initialized line = trim(fileContent(i))
do while (trim(line) /= IO_EOF)
part = IO_lc(IO_getTag(line,'<','>')) part = IO_lc(IO_getTag(line,'<','>'))
select case (trim(part)) select case (trim(part))
case (trim(material_partPhase)) 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) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6)
case (trim(material_partMicrostructure)) 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) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6)
case (trim(material_partCrystallite)) 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) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6)
case (trim(material_partHomogenization)) 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) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6)
case (trim(material_partTexture)) 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) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6)
case default
line = IO_read(fileUnit)
end select end select
enddo enddo
@ -173,107 +180,81 @@ end subroutine config_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief parses the material.config file !> @brief parses the material.config file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine parseFile(line,& subroutine parseFile(line,sectionNames,part,&
sectionNames,part,fileUnit) fileContent)
use prec, only: &
pStringLen
use IO, only: & use IO, only: &
IO_read, &
IO_error, & IO_error, &
IO_lc, & IO_getTag
IO_getTag, &
IO_isBlank, &
IO_stringValue, &
IO_stringPos, &
IO_EOF
implicit none implicit none
integer(pInt), intent(in) :: fileUnit character(len=pStringLen), intent(out) :: line
character(len=*), dimension(:), allocatable, intent(inout) :: sectionNames character(len=64), allocatable, dimension(:), intent(out) :: sectionNames
type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: part type(tPartitionedStringList), allocatable, dimension(:), intent(out) :: part
character(len=65536),intent(out) :: line character(len=pStringLen), dimension(:), intent(in) :: fileContent
integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt), allocatable, dimension(:) :: partPosition ! position of [] tags + last line in section
integer(pInt) :: s integer(pInt) :: i, j
character(len=65536) :: devNull
character(len=64) :: tag
logical :: echo logical :: echo
echo = .false. echo = .false.
allocate(part(0)) allocate(partPosition(0))
s = 0_pInt do i = 1_pInt, size(fileContent)
do while (trim(line) /= IO_EOF) ! read through sections of material part line = trim(fileContent(i))
line = IO_read(fileUnit) if (IO_getTag(line,'<','>') /= '') exit
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
nextSection: if (IO_getTag(line,'[',']') /= '') then nextSection: if (IO_getTag(line,'[',']') /= '') then
s = s + 1_pInt partPosition = [partPosition, i]
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 cycle
endif nextSection endif nextSection
chunkPos = IO_stringPos(line) if (size(partPosition) < 1_pInt) &
tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key echo = (trim(IO_getTag(line,'/','/')) == 'echo') .or. echo
inSection: if (s > 0_pInt) then
call part(s)%add(IO_lc(trim(line)))
else inSection
echo = (trim(tag) == '/echo/')
endif inSection
enddo enddo
if (echo) then allocate(sectionNames(size(partPosition)))
do s = 1, size(sectionNames) allocate(part(size(partPosition)))
call part(s)%show()
end do partPosition = [partPosition, i] ! needed when actually storing content
end if
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 end subroutine parseFile
!--------------------------------------------------------------------------------------------------
!> @brief deallocates the linked lists that store the content of the configuration files
!--------------------------------------------------------------------------------------------------
subroutine config_deallocate(what) subroutine config_deallocate(what)
use IO, only: & use IO, only: &
IO_error IO_error
implicit none implicit none
character(len=*), intent(in) :: what character(len=*), intent(in) :: what
integer(pInt) :: i
select case(what) select case(trim(what))
case('material.config/phase') case('material.config/phase')
do i=1, size(config_phase)
call config_phase(i)%free
enddo
deallocate(config_phase) deallocate(config_phase)
case('material.config/microstructure') case('material.config/microstructure')
do i=1, size(config_microstructure)
call config_microstructure(i)%free
enddo
deallocate(config_microstructure) deallocate(config_microstructure)
case('material.config/crystallite') case('material.config/crystallite')
do i=1, size(config_crystallite)
call config_crystallite(i)%free
enddo
deallocate(config_crystallite) deallocate(config_crystallite)
case('material.config/homogenization') case('material.config/homogenization')
do i=1, size(config_homogenization)
call config_homogenization(i)%free
enddo
deallocate(config_homogenization) deallocate(config_homogenization)
case('material.config/texture') case('material.config/texture')
do i=1, size(config_texture)
call config_texture(i)%free
enddo
deallocate(config_texture) deallocate(config_texture)
case default case default
@ -284,11 +265,17 @@ subroutine config_deallocate(what)
end subroutine config_deallocate end subroutine config_deallocate
!##################################################################################################
! The folowing functions are part of the tPartitionedStringList object
!##################################################################################################
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief add element !> @brief add element
!> @details Adds a string together with the start/end position of chunks in this string. The new !> @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 !! 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) subroutine add(this,string)
use IO, only: & use IO, only: &
@ -299,19 +286,18 @@ subroutine add(this,string)
implicit none implicit none
class(tPartitionedStringList), target, intent(in) :: this class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: string character(len=*), intent(in) :: string
type(tPartitionedStringList), pointer :: new, item type(tPartitionedStringList), pointer :: new, temp
if (IO_isBlank(string)) return if (IO_isBlank(string)) return
allocate(new) allocate(new)
new%string%val = IO_lc (trim(string)) temp => this
new%string%pos = IO_stringPos(trim(string)) do while (associated(temp%next))
temp => temp%next
item => this
do while (associated(item%next))
item => item%next
enddo enddo
item%next => new temp%string%val = IO_lc (trim(string))
temp%string%pos = IO_stringPos(trim(string))
temp%next => new
end subroutine add end subroutine add
@ -323,12 +309,12 @@ end subroutine add
subroutine show(this) subroutine show(this)
implicit none implicit none
class(tPartitionedStringList) :: this class(tPartitionedStringList), target, intent(in) :: this
type(tPartitionedStringList), pointer :: item type(tPartitionedStringList), pointer :: item
item => this%next item => this
do while (associated(item)) do while (associated(item%next))
write(6,'(a)') trim(item%string%val) write(6,'(a)') ' '//trim(item%string%val)
item => item%next item => item%next
end do end do
@ -336,28 +322,55 @@ end subroutine show
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief cleans entire list !> @brief empties list and frees associated memory
!> @details list head is remains alive !> @details explicit interface to reset list. Triggers final statement (and following chain reaction)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine free(this) subroutine free(this)
implicit none implicit none
class(tPartitionedStringList), target, intent(in) :: this class(tPartitionedStringList), intent(inout) :: this
type(tPartitionedStringList), pointer :: new, item
if (.not. associated(this%next)) return if(associated(this%next)) deallocate(this%next)
item => this%next
do while (associated(item%next))
new => item
deallocate(item)
item => new%next
enddo
deallocate(item)
end subroutine free 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 !> @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 IO_stringValue
implicit none implicit none
class(tPartitionedStringList), intent(in) :: this class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key character(len=*), intent(in) :: key
type(tPartitionedStringList), pointer :: item type(tPartitionedStringList), pointer :: item
keyExists = .false. keyExists = .false.
item => this%next item => this
do while (associated(item) .and. .not. keyExists) do while (associated(item%next) .and. .not. keyExists)
keyExists = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) keyExists = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)
item => item%next item => item%next
end do end do
@ -391,14 +404,14 @@ integer(pInt) function countKeys(this,key)
implicit none implicit none
class(tPartitionedStringList), intent(in) :: this class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key character(len=*), intent(in) :: key
type(tPartitionedStringList), pointer :: item type(tPartitionedStringList), pointer :: item
countKeys = 0_pInt countKeys = 0_pInt
item => this%next item => this
do while (associated(item)) do while (associated(item%next))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) & if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) &
countKeys = countKeys + 1_pInt countKeys = countKeys + 1_pInt
item => item%next item => item%next
@ -419,17 +432,17 @@ real(pReal) function getFloat(this,key,defaultVal)
IO_FloatValue IO_FloatValue
implicit none implicit none
class(tPartitionedStringList), intent(in) :: this class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key character(len=*), intent(in) :: key
real(pReal), intent(in), optional :: defaultVal real(pReal), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: item type(tPartitionedStringList), pointer :: item
logical :: found logical :: found
found = present(defaultVal) found = present(defaultVal)
if (found) getFloat = defaultVal if (found) getFloat = defaultVal
item => this%next item => this
do while (associated(item)) do while (associated(item%next))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true. found = .true.
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) 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 IO_IntValue
implicit none implicit none
class(tPartitionedStringList), intent(in) :: this class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key character(len=*), intent(in) :: key
integer(pInt), intent(in), optional :: defaultVal integer(pInt), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: item type(tPartitionedStringList), pointer :: item
logical :: found logical :: found
found = present(defaultVal) found = present(defaultVal)
if (found) getInt = defaultVal if (found) getInt = defaultVal
item => this%next item => this
do while (associated(item)) do while (associated(item%next))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true. found = .true.
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) 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 IO_stringValue
implicit none implicit none
class(tPartitionedStringList), intent(in) :: this class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key character(len=*), intent(in) :: key
character(len=65536), intent(in), optional :: defaultVal character(len=65536), intent(in), optional :: defaultVal
logical, intent(in), optional :: raw logical, intent(in), optional :: raw
type(tPartitionedStringList), pointer :: item type(tPartitionedStringList), pointer :: item
logical :: found, & logical :: found, &
whole whole
whole = merge(raw,.false.,present(raw)) ! whole string or white space splitting whole = merge(raw,.false.,present(raw)) ! whole string or white space splitting
found = present(defaultVal) 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') if (len_trim(getString) /= len_trim(defaultVal)) call IO_error(0_pInt,ext_msg='getString')
endif endif
item => this%next item => this
do while (associated(item)) do while (associated(item%next))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true. found = .true.
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) 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 implicit none
real(pReal), dimension(:), allocatable :: getFloats real(pReal), dimension(:), allocatable :: getFloats
class(tPartitionedStringList), intent(in) :: this class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key character(len=*), intent(in) :: key
real(pReal), dimension(:), intent(in), optional :: defaultVal real(pReal), dimension(:), intent(in), optional :: defaultVal
integer(pInt), dimension(:), intent(in), optional :: requiredShape integer(pInt), dimension(:), intent(in), optional :: requiredShape
@ -553,8 +566,8 @@ function getFloats(this,key,defaultVal,requiredShape)
allocate(getFloats(0)) allocate(getFloats(0))
item => this%next item => this
do while (associated(item)) do while (associated(item%next))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true. found = .true.
if (.not. cumulative) getFloats = [real(pReal)::] if (.not. cumulative) getFloats = [real(pReal)::]
@ -586,7 +599,7 @@ function getInts(this,key,defaultVal,requiredShape)
implicit none implicit none
integer(pInt), dimension(:), allocatable :: getInts integer(pInt), dimension(:), allocatable :: getInts
class(tPartitionedStringList), intent(in) :: this class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key character(len=*), intent(in) :: key
integer(pInt), dimension(:), intent(in), optional :: defaultVal, & integer(pInt), dimension(:), intent(in), optional :: defaultVal, &
requiredShape requiredShape
@ -600,8 +613,8 @@ function getInts(this,key,defaultVal,requiredShape)
allocate(getInts(0)) allocate(getInts(0))
item => this%next item => this
do while (associated(item)) do while (associated(item%next))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true. found = .true.
if (.not. cumulative) getInts = [integer(pInt)::] if (.not. cumulative) getInts = [integer(pInt)::]
@ -633,7 +646,7 @@ function getStrings(this,key,defaultVal,requiredShape,raw)
implicit none implicit none
character(len=65536),dimension(:), allocatable :: getStrings character(len=65536),dimension(:), allocatable :: getStrings
class(tPartitionedStringList), intent(in) :: this class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key character(len=*), intent(in) :: key
character(len=65536),dimension(:), intent(in), optional :: defaultVal character(len=65536),dimension(:), intent(in), optional :: defaultVal
integer(pInt), dimension(:), intent(in), optional :: requiredShape integer(pInt), dimension(:), intent(in), optional :: requiredShape
@ -649,8 +662,8 @@ function getStrings(this,key,defaultVal,requiredShape,raw)
whole = merge(raw,.false.,present(raw)) whole = merge(raw,.false.,present(raw))
found = .false. found = .false.
item => this%next item => this
do while (associated(item)) do while (associated(item%next))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true. found = .true.
if (allocated(getStrings) .and. .not. cumulative) deallocate(getStrings) 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_write_jobIntFile, &
IO_timeStamp IO_timeStamp
use config, only: & use config, only: &
config_deallocate config_phase
use mesh, only: & use mesh, only: &
FE_geomtype FE_geomtype
use config, only: & use config, only: &
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, &
@ -138,7 +139,7 @@ subroutine constitutive_init()
use kinematics_hydrogen_strain use kinematics_hydrogen_strain
implicit none implicit none
integer(pInt), parameter :: FILEUNIT = 200_pInt integer(pInt), parameter :: FILEUNIT = 204_pInt
integer(pInt) :: & integer(pInt) :: &
o, & !< counter in output loop o, & !< counter in output loop
ph, & !< counter in phase loop ph, & !< counter in phase loop

4
src/crystallite.f90
View File

@ -172,9 +172,9 @@ 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
config_deallocate
use constitutive, only: & use constitutive, only: &
constitutive_initialFi, & constitutive_initialFi, &
constitutive_microstructure ! derived (shortcut) quantities of given state constitutive_microstructure ! derived (shortcut) quantities of given state

2
src/debug.f90
View File

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

2
src/homogenization.f90
View File

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

14
src/material.f90
View File

@ -360,8 +360,7 @@ subroutine material_init()
homogenization_name, & homogenization_name, &
microstructure_name, & microstructure_name, &
phase_name, & phase_name, &
texture_name, & texture_name
config_deallocate
use mesh, only: & use mesh, only: &
mesh_maxNips, & mesh_maxNips, &
mesh_NcpElems, & mesh_NcpElems, &
@ -370,7 +369,7 @@ subroutine material_init()
FE_geomtype FE_geomtype
implicit none implicit none
integer(pInt), parameter :: FILEUNIT = 200_pInt integer(pInt), parameter :: FILEUNIT = 210_pInt
integer(pInt) :: m,c,h, myDebug, myPhase, myHomog integer(pInt) :: m,c,h, myDebug, myPhase, myHomog
integer(pInt) :: & integer(pInt) :: &
g, & !< grain number g, & !< grain number
@ -469,7 +468,6 @@ subroutine material_init()
endif debugOut endif debugOut
call material_populateGrains call material_populateGrains
call config_deallocate('material.config/microstructure')
allocate(phaseAt ( homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0_pInt) allocate(phaseAt ( homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0_pInt)
allocate(phasememberAt ( 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_floatValue, &
IO_stringValue IO_stringValue
use config, only: & use config, only: &
config_texture, & config_deallocate, &
config_deallocate config_texture
use math, only: & use math, only: &
inRad, & inRad, &
math_sampleRandomOri, & math_sampleRandomOri, &
@ -1061,7 +1059,7 @@ subroutine material_parseTexture
endif endif
enddo enddo
call config_deallocate('material.config/texture') call config_deallocate('material.config/texture')
end subroutine material_parseTexture end subroutine material_parseTexture
@ -1093,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: &
@ -1429,6 +1428,7 @@ subroutine material_populateGrains
deallocate(texture_transformation) deallocate(texture_transformation)
deallocate(Nelems) deallocate(Nelems)
deallocate(elemsOfHomogMicro) deallocate(elemsOfHomogMicro)
call config_deallocate('material.config/microstructure')
end subroutine material_populateGrains end subroutine material_populateGrains

16
src/plastic_phenopowerlaw.f90
View File

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

2
src/prec.f90
View File

@ -7,6 +7,7 @@
!> @brief setting precision for real and int type !> @brief setting precision for real and int type
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module prec module prec
! ToDo: use, intrinsic :: iso_fortran_env, only : I8 => int64, WP => real64
implicit none implicit none
private private
#if (FLOAT==8) #if (FLOAT==8)
@ -23,6 +24,7 @@ module prec
NO SUITABLE PRECISION FOR INTEGER SELECTED, STOPPING COMPILATION NO SUITABLE PRECISION FOR INTEGER SELECTED, STOPPING COMPILATION
#endif #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) 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) real(pReal), parameter, public :: tol_math_check = 1.0e-8_pReal !< tolerance for internal math self-checks (rotation)