diff --git a/src/IO.f90 b/src/IO.f90 index 807686e86..0358785f6 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -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 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 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 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 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 diff --git a/src/config.f90 b/src/config.f90 index d26b72c80..837818756 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -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) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 7833f70cf..43207c65c 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -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 diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 0ee71b5de..b9ae84a44 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -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 diff --git a/src/debug.f90 b/src/debug.f90 index 55cc62ca0..2a4edf28e 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -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 diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 951527b19..77d301400 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -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 diff --git a/src/material.f90 b/src/material.f90 index bc267bd60..812b0c55d 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -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 diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index bdc6e12a6..59a106435 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -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 diff --git a/src/prec.f90 b/src/prec.f90 index cfbc71fec..857ec9559 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -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)