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

added 'reset' flag for recursive function IO_read, need to reset stack when stopping exectution (will be used by constitutive and homogenization)

This commit is contained in:
Martin Diehl 2013-12-11 16:49:20 +00:00
parent 9c7335f799
commit 7885ebaf8f
6 changed files with 470 additions and 458 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
code/FEsolving.f90
View File

@ -95,7 +95,7 @@ subroutine FE_init
implicit none implicit none
#ifndef Spectral #ifndef Spectral
integer(pInt), parameter :: & integer(pInt), parameter :: &
fileunit = 222_pInt, & FILEUNIT = 222_pInt, &
maxNchunks = 6_pInt maxNchunks = 6_pInt
integer(pInt) :: j integer(pInt) :: j
character(len=64) :: tag character(len=64) :: tag
@ -117,19 +117,19 @@ subroutine FE_init
endif endif
restartRead = restartInc > 1_pInt ! only read in if "true" restart requested restartRead = restartInc > 1_pInt ! only read in if "true" restart requested
#else #else
call IO_open_inputFile(fileunit,modelName) call IO_open_inputFile(FILEUNIT,modelName)
rewind(fileunit) rewind(FILEUNIT)
do do
read (fileunit,'(a1024)',END=100) line read (FILEUNIT,'(a1024)',END=100) line
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
select case(tag) select case(tag)
case ('solver') case ('solver')
read (fileunit,'(a1024)',END=100) line ! next line read (FILEUNIT,'(a1024)',END=100) line ! next line
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
symmetricSolver = (IO_intValue(line,positions,2_pInt) /= 1_pInt) symmetricSolver = (IO_intValue(line,positions,2_pInt) /= 1_pInt)
case ('restart') case ('restart')
read (fileunit,'(a1024)',END=100) line ! next line read (FILEUNIT,'(a1024)',END=100) line ! next line
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
restartWrite = iand(IO_intValue(line,positions,1_pInt),1_pInt) > 0_pInt restartWrite = iand(IO_intValue(line,positions,1_pInt),1_pInt) > 0_pInt
restartRead = iand(IO_intValue(line,positions,1_pInt),2_pInt) > 0_pInt restartRead = iand(IO_intValue(line,positions,1_pInt),2_pInt) > 0_pInt
@ -145,14 +145,14 @@ subroutine FE_init
endif endif
end select end select
enddo enddo
100 close(fileunit) 100 close(FILEUNIT)
if (restartRead) then if (restartRead) then
#ifdef Marc4DAMASK #ifdef Marc4DAMASK
call IO_open_logFile(fileunit) call IO_open_logFile(FILEUNIT)
rewind(fileunit) rewind(FILEUNIT)
do do
read (fileunit,'(a1024)',END=200) line read (FILEUNIT,'(a1024)',END=200) line
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
if ( IO_lc(IO_stringValue(line,positions,1_pInt)) == 'restart' .and. & if ( IO_lc(IO_stringValue(line,positions,1_pInt)) == 'restart' .and. &
IO_lc(IO_stringValue(line,positions,2_pInt)) == 'file' .and. & IO_lc(IO_stringValue(line,positions,2_pInt)) == 'file' .and. &
@ -161,19 +161,19 @@ subroutine FE_init
modelName = IO_StringValue(line,positions,6_pInt) modelName = IO_StringValue(line,positions,6_pInt)
enddo enddo
#else #else
call IO_open_inputFile(fileunit,modelName) call IO_open_inputFile(FILEUNIT,modelName)
rewind(fileunit) rewind(FILEUNIT)
do do
read (fileunit,'(a1024)',END=200) line read (FILEUNIT,'(a1024)',END=200) line
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
if ( IO_lc(IO_stringValue(line,positions,1_pInt))=='*heading') then if ( IO_lc(IO_stringValue(line,positions,1_pInt))=='*heading') then
read (fileunit,'(a1024)',END=200) line read (FILEUNIT,'(a1024)',END=200) line
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
modelName = IO_StringValue(line,positions,1_pInt) modelName = IO_StringValue(line,positions,1_pInt)
endif endif
enddo enddo
#endif #endif
200 close(fileunit) 200 close(FILEUNIT)
endif endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

225
code/IO.f90
View File

@ -115,55 +115,64 @@ 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
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
recursive function IO_read(myUnit) result(line) recursive function IO_read(fileUnit,reset) result(line)
implicit none implicit none
integer(pInt), intent(in) :: myUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
logical, intent(in), optional :: reset
integer(pInt), dimension(10) :: unitOn = 0_pInt ! save the stack of recursive file units integer(pInt), dimension(10) :: unitOn = 0_pInt ! save the stack of recursive file units
integer(pInt) :: stack = 1_pInt ! current stack position integer(pInt) :: stack = 1_pInt ! current stack position
character(len=8192), dimension(10) :: pathOn = '' character(len=8192), dimension(10) :: pathOn = ''
character(len=512) :: path,input character(len=512) :: path,input
integer(pInt) :: myStat integer(pInt) :: myStat
logical :: inUse
character(len=65536) :: line character(len=65536) :: line
character(len=*), parameter :: SEP = achar(47)//achar(92) ! forward and backward slash ("/", "\") character(len=*), parameter :: SEP = achar(47)//achar(92) ! forward and backward slash ("/", "\")
unitOn(1) = myUnit !--------------------------------------------------------------------------------------------------
! reset case
if(present(reset)) then; if (reset .eqv. .true.) then ! do not short circuit here
do while (stack > 0_pInt) ! can go back to former file
close(unitOn(stack))
stack = stack-1_pInt
enddo
return
endif; endif
!--------------------------------------------------------------------------------------------------
! read from file
unitOn(1) = fileUnit
read(unitOn(stack),'(a65536)',END=100) line read(unitOn(stack),'(a65536)',END=100) line
input = IO_getTag(line,'{','}') input = IO_getTag(line,'{','}')
! --- normal case --- !--------------------------------------------------------------------------------------------------
! normal case
if (input == '') return ! regular line if (input == '') return ! regular line
! --- recursion case --- !--------------------------------------------------------------------------------------------------
! recursion case
if (stack >= 10_pInt) call IO_error(104_pInt,ext_msg=input) ! recursion limit reached if (stack >= 10_pInt) call IO_error(104_pInt,ext_msg=input) ! recursion limit reached
inquire(UNIT=unitOn(stack),NAME=path) ! path of current file inquire(UNIT=unitOn(stack),NAME=path) ! path of current file
stack = stack+1_pInt stack = stack+1_pInt
unitOn(stack) = unitOn(stack-1_pInt)+1_pInt ! assume next file unit to be free to use
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
do open(newunit=unitOn(stack),iostat=myStat,file=pathOn(stack)) ! open included file
inquire(UNIT=unitOn(stack),OPENED=inUse)
if (.not. inUse) exit
unitOn(stack) = unitOn(stack)+1_pInt ! test next fileunit
enddo
open(unitOn(stack),status='old',iostat=myStat,file=pathOn(stack)) ! open included file
if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path)
line = IO_read(myUnit) line = IO_read(fileUnit)
return return
! --- end of file case --- !--------------------------------------------------------------------------------------------------
! end of file case
100 if (stack > 1_pInt) then ! can go back to former file 100 if (stack > 1_pInt) then ! can go back to former file
close(unitOn(stack)) close(unitOn(stack))
stack = stack-1_pInt stack = stack-1_pInt
line = IO_read(myUnit) line = IO_read(fileUnit)
else ! top-most file reached else ! top-most file reached
line = IO_EOF line = IO_EOF
endif endif
@ -175,16 +184,16 @@ end function IO_read
!> @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
!! error message !! error message
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_checkAndRewind(myUnit) subroutine IO_checkAndRewind(fileUnit)
implicit none implicit none
integer(pInt), intent(in) :: myUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
logical :: fileOpened logical :: fileOpened
character(len=15) :: fileRead character(len=15) :: fileRead
inquire(unit=myUnit, opened=fileOpened, read = fileRead) inquire(unit=fileUnit, opened=fileOpened, read = fileRead)
if (fileOpened .neqv. .true. .or. trim(fileRead)/='YES') call IO_error(102_pInt) if (fileOpened .neqv. .true. .or. trim(fileRead)/='YES') call IO_error(102_pInt)
rewind(myUnit) rewind(fileUnit)
end subroutine IO_checkAndRewind end subroutine IO_checkAndRewind
@ -195,19 +204,19 @@ end subroutine IO_checkAndRewind
!> @details like IO_open_file_stat, but error is handled via call to IO_error and not via return !> @details like IO_open_file_stat, but error is handled via call to IO_error and not via return
!! value !! value
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_open_file(myUnit,relPath) subroutine IO_open_file(fileUnit,relPath)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName getSolverWorkingDirectoryName
implicit none implicit none
integer(pInt), intent(in) :: myUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: relPath !< relative path from working directory character(len=*), intent(in) :: relPath !< relative path from working directory
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//relPath path = trim(getSolverWorkingDirectoryName())//relPath
open(myUnit,status='old',iostat=myStat,file=path) open(fileUnit,status='old',iostat=myStat,file=path)
if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path)
end subroutine IO_open_file end subroutine IO_open_file
@ -218,19 +227,19 @@ end subroutine IO_open_file
!! directory !! directory
!> @details Like IO_open_file, but error is handled via return value and not via call to IO_error !> @details Like IO_open_file, but error is handled via return value and not via call to IO_error
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical function IO_open_file_stat(myUnit,relPath) logical function IO_open_file_stat(fileUnit,relPath)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName getSolverWorkingDirectoryName
implicit none implicit none
integer(pInt), intent(in) :: myUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: relPath !< relative path from working directory character(len=*), intent(in) :: relPath !< relative path from working directory
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//relPath path = trim(getSolverWorkingDirectoryName())//relPath
open(myUnit,status='old',iostat=myStat,file=path) open(fileUnit,status='old',iostat=myStat,file=path)
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
@ -242,20 +251,20 @@ end function IO_open_file_stat
!> @details like IO_open_jobFile_stat, but error is handled via call to IO_error and not via return !> @details like IO_open_jobFile_stat, but error is handled via call to IO_error and not via return
!! value !! value
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_open_jobFile(myUnit,ext) subroutine IO_open_jobFile(fileUnit,ext)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName, & getSolverWorkingDirectoryName, &
getSolverJobName getSolverJobName
implicit none implicit none
integer(pInt), intent(in) :: myUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: ext !< extension of file character(len=*), intent(in) :: ext !< extension of file
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext
open(myUnit,status='old',iostat=myStat,file=path) open(fileUnit,status='old',iostat=myStat,file=path)
if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path)
end subroutine IO_open_jobFile end subroutine IO_open_jobFile
@ -267,20 +276,20 @@ end subroutine IO_open_jobFile
!> @details Like IO_open_jobFile, but error is handled via return value and not via call to !> @details Like IO_open_jobFile, but error is handled via return value and not via call to
!! IO_error !! IO_error
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical function IO_open_jobFile_stat(myUnit,ext) logical function IO_open_jobFile_stat(fileUnit,ext)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName, & getSolverWorkingDirectoryName, &
getSolverJobName getSolverJobName
implicit none implicit none
integer(pInt), intent(in) :: myUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: ext !< extension of file character(len=*), intent(in) :: ext !< extension of file
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext
open(myUnit,status='old',iostat=myStat,file=path) open(fileUnit,status='old',iostat=myStat,file=path)
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
@ -290,14 +299,14 @@ end function IO_open_JobFile_stat
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief opens FEM input file for reading located in current working directory to given unit !> @brief opens FEM input file for reading located in current working directory to given unit
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_open_inputFile(myUnit,modelName) subroutine IO_open_inputFile(fileUnit,modelName)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName,& getSolverWorkingDirectoryName,&
getSolverJobName, & getSolverJobName, &
inputFileExtension inputFileExtension
implicit none implicit none
integer(pInt), intent(in) :: myUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: modelName !< model name, in case of restart not solver job name character(len=*), intent(in) :: modelName !< model name, in case of restart not solver job name
integer(pInt) :: myStat integer(pInt) :: myStat
@ -307,23 +316,23 @@ subroutine IO_open_inputFile(myUnit,modelName)
fileType = 1_pInt ! assume .pes fileType = 1_pInt ! assume .pes
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used
open(myUnit+1,status='old',iostat=myStat,file=path) open(fileUnit+1,status='old',iostat=myStat,file=path)
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(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType) path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType)
open(myUnit+1,status='old',iostat=myStat,file=path) open(fileUnit+1,status='old',iostat=myStat,file=path)
endif endif
if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) ! ensure that any file opened works if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) ! ensure that any file opened works
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType)//'_assembly' path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType)//'_assembly'
open(myUnit,iostat=myStat,file=path) open(fileUnit,iostat=myStat,file=path)
if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path)
if (.not.abaqus_assembleInputFile(myUnit,myUnit+1_pInt)) call IO_error(103_pInt) ! strip comments and concatenate any "include"s if (.not.abaqus_assembleInputFile(fileUnit,myUnit+1_pInt)) call IO_error(103_pInt) ! strip comments and concatenate any "include"s
close(myUnit+1_pInt) close(fileUnit+1_pInt)
#endif #endif
#ifdef Marc4DAMASK #ifdef Marc4DAMASK
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension
open(myUnit,status='old',iostat=myStat,file=path) open(fileUnit,status='old',iostat=myStat,file=path)
if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path)
#endif #endif
@ -334,20 +343,20 @@ end subroutine IO_open_inputFile
!> @brief opens existing FEM log file for reading to given unit. File is named after solver job !> @brief opens existing FEM log file for reading to given unit. File is named after solver job
!! name and located in current working directory !! name and located in current working directory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_open_logFile(myUnit) subroutine IO_open_logFile(fileUnit)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName, & getSolverWorkingDirectoryName, &
getSolverJobName, & getSolverJobName, &
LogFileExtension LogFileExtension
implicit none implicit none
integer(pInt), intent(in) :: myUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//LogFileExtension path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//LogFileExtension
open(myUnit,status='old',iostat=myStat,file=path) open(fileUnit,status='old',iostat=myStat,file=path)
if (myStat /= 0) call IO_error(100_pInt,ext_msg=path) if (myStat /= 0) call IO_error(100_pInt,ext_msg=path)
end subroutine IO_open_logFile end subroutine IO_open_logFile
@ -358,20 +367,20 @@ end subroutine IO_open_logFile
!> @brief opens FEM log file for writing to given unit. File is named after solver job name and !> @brief opens FEM log file for writing to given unit. File is named after solver job name and
!! located in current working directory !! located in current working directory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_write_jobFile(myUnit,ext) subroutine IO_write_jobFile(fileUnit,ext)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName, & getSolverWorkingDirectoryName, &
getSolverJobName getSolverJobName
implicit none implicit none
integer(pInt), intent(in) :: myUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: ext !< extension of file character(len=*), intent(in) :: ext !< extension of file
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext
open(myUnit,status='replace',iostat=myStat,file=path) open(fileUnit,status='replace',iostat=myStat,file=path)
if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path)
end subroutine IO_write_jobFile end subroutine IO_write_jobFile
@ -381,13 +390,13 @@ end subroutine IO_write_jobFile
!> @brief opens binary file containing array of pReal numbers to given unit for writing. File is !> @brief opens binary file containing array of pReal numbers to given unit for writing. File is
!! named after solver job name plus given extension and located in current working directory !! named after solver job name plus given extension and located in current working directory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_write_jobRealFile(myUnit,ext,recMultiplier) subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName, & getSolverWorkingDirectoryName, &
getSolverJobName getSolverJobName
implicit none implicit none
integer(pInt), intent(in) :: myUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: ext !< extension of file character(len=*), intent(in) :: ext !< extension of file
integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one)
@ -396,10 +405,10 @@ subroutine IO_write_jobRealFile(myUnit,ext,recMultiplier)
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext
if (present(recMultiplier)) then if (present(recMultiplier)) then
open(myUnit,status='replace',form='unformatted',access='direct', & open(fileUnit,status='replace',form='unformatted',access='direct', &
recl=pReal*recMultiplier,iostat=myStat,file=path) recl=pReal*recMultiplier,iostat=myStat,file=path)
else else
open(myUnit,status='replace',form='unformatted',access='direct', & open(fileUnit,status='replace',form='unformatted',access='direct', &
recl=pReal,iostat=myStat,file=path) recl=pReal,iostat=myStat,file=path)
endif endif
@ -412,13 +421,13 @@ end subroutine IO_write_jobRealFile
!> @brief opens binary file containing array of pInt numbers to given unit for writing. File is !> @brief opens binary file containing array of pInt numbers to given unit for writing. File is
!! named after solver job name plus given extension and located in current working directory !! named after solver job name plus given extension and located in current working directory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_write_jobIntFile(myUnit,ext,recMultiplier) subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName, & getSolverWorkingDirectoryName, &
getSolverJobName getSolverJobName
implicit none implicit none
integer(pInt), intent(in) :: myUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: ext !< extension of file character(len=*), intent(in) :: ext !< extension of file
integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one)
@ -427,10 +436,10 @@ subroutine IO_write_jobIntFile(myUnit,ext,recMultiplier)
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext
if (present(recMultiplier)) then if (present(recMultiplier)) then
open(myUnit,status='replace',form='unformatted',access='direct', & open(fileUnit,status='replace',form='unformatted',access='direct', &
recl=pInt*recMultiplier,iostat=myStat,file=path) recl=pInt*recMultiplier,iostat=myStat,file=path)
else else
open(myUnit,status='replace',form='unformatted',access='direct', & open(fileUnit,status='replace',form='unformatted',access='direct', &
recl=pInt,iostat=myStat,file=path) recl=pInt,iostat=myStat,file=path)
endif endif
@ -443,12 +452,12 @@ end subroutine IO_write_jobIntFile
!> @brief opens binary file containing array of pReal numbers to given unit for reading. File is !> @brief opens binary file containing array of pReal numbers to given unit for reading. File is
!! located in current working directory !! located in current working directory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_read_realFile(myUnit,ext,modelName,recMultiplier) subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName getSolverWorkingDirectoryName
implicit none implicit none
integer(pInt), intent(in) :: myUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: ext, & !< extension of file character(len=*), intent(in) :: ext, & !< extension of file
modelName !< model name, in case of restart not solver job name modelName !< model name, in case of restart not solver job name
integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one)
@ -458,10 +467,10 @@ subroutine IO_read_realFile(myUnit,ext,modelName,recMultiplier)
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext
if (present(recMultiplier)) then if (present(recMultiplier)) then
open(myUnit,status='old',form='unformatted',access='direct', & open(fileUnit,status='old',form='unformatted',access='direct', &
recl=pReal*recMultiplier,iostat=myStat,file=path) recl=pReal*recMultiplier,iostat=myStat,file=path)
else else
open(myUnit,status='old',form='unformatted',access='direct', & open(fileUnit,status='old',form='unformatted',access='direct', &
recl=pReal,iostat=myStat,file=path) recl=pReal,iostat=myStat,file=path)
endif endif
if (myStat /= 0) call IO_error(100_pInt,ext_msg=path) if (myStat /= 0) call IO_error(100_pInt,ext_msg=path)
@ -473,12 +482,12 @@ end subroutine IO_read_realFile
!> @brief opens binary file containing array of pInt numbers to given unit for reading. File is !> @brief opens binary file containing array of pInt numbers to given unit for reading. File is
!! located in current working directory !! located in current working directory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_read_intFile(myUnit,ext,modelName,recMultiplier) subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName getSolverWorkingDirectoryName
implicit none implicit none
integer(pInt), intent(in) :: myUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: ext, & !< extension of file character(len=*), intent(in) :: ext, & !< extension of file
modelName !< model name, in case of restart not solver job name modelName !< model name, in case of restart not solver job name
integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one)
@ -488,10 +497,10 @@ subroutine IO_read_intFile(myUnit,ext,modelName,recMultiplier)
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext
if (present(recMultiplier)) then if (present(recMultiplier)) then
open(myUnit,status='old',form='unformatted',access='direct', & open(fileUnit,status='old',form='unformatted',access='direct', &
recl=pInt*recMultiplier,iostat=myStat,file=path) recl=pInt*recMultiplier,iostat=myStat,file=path)
else else
open(myUnit,status='old',form='unformatted',access='direct', & open(fileUnit,status='old',form='unformatted',access='direct', &
recl=pInt,iostat=myStat,file=path) recl=pInt,iostat=myStat,file=path)
endif endif
if (myStat /= 0) call IO_error(100_pInt,ext_msg=path) if (myStat /= 0) call IO_error(100_pInt,ext_msg=path)
@ -503,10 +512,10 @@ end subroutine IO_read_intFile
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief check if the input file for Abaqus contains part info !> @brief check if the input file for Abaqus contains part info
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical function IO_abaqus_hasNoPart(myUnit) logical function IO_abaqus_hasNoPart(fileUnit)
implicit none implicit none
integer(pInt), intent(in) :: myUnit integer(pInt), intent(in) :: fileUnit
integer(pInt), parameter :: MAXNCHUNKS = 1_pInt integer(pInt), parameter :: MAXNCHUNKS = 1_pInt
integer(pInt), dimension(1+2*MAXNCHUNKS) :: myPos integer(pInt), dimension(1+2*MAXNCHUNKS) :: myPos
@ -515,9 +524,9 @@ logical function IO_abaqus_hasNoPart(myUnit)
IO_abaqus_hasNoPart = .true. IO_abaqus_hasNoPart = .true.
610 FORMAT(A65536) 610 FORMAT(A65536)
rewind(myUnit) rewind(fileUnit)
do do
read(myUnit,610,END=620) line read(fileUnit,610,END=620) line
myPos = IO_stringPos(line,MAXNCHUNKS) myPos = IO_stringPos(line,MAXNCHUNKS)
if (IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*part' ) then if (IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*part' ) then
IO_abaqus_hasNoPart = .false. IO_abaqus_hasNoPart = .false.
@ -725,24 +734,24 @@ end function IO_getTag
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief count number of [sections] in <part> for given file handle !> @brief count number of [sections] in <part> for given file handle
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
integer(pInt) function IO_countSections(myUnit,part) integer(pInt) function IO_countSections(fileUnit,part)
implicit none implicit none
integer(pInt), intent(in) :: myUnit !< file handle integer(pInt), intent(in) :: fileUnit !< file handle
character(len=*), intent(in) :: part !< part name in which sections are counted character(len=*), intent(in) :: part !< part name in which sections are counted
character(len=65536) :: line character(len=65536) :: line
line = '' line = ''
IO_countSections = 0_pInt IO_countSections = 0_pInt
rewind(myUnit) rewind(fileUnit)
do while (trim(line) /= IO_EOF .and. IO_getTag(line,'<','>') /= part) ! search for part do while (trim(line) /= IO_EOF .and. IO_getTag(line,'<','>') /= part) ! search for part
line = IO_read(myUnit) line = IO_read(fileUnit)
enddo enddo
do while (trim(line) /= IO_EOF) do while (trim(line) /= IO_EOF)
line = IO_read(myUnit) line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
@ -755,12 +764,12 @@ end function IO_countSections
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief returns array of tag counts within <part> for at most N [sections] !> @brief returns array of tag counts within <part> for at most N [sections]
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function IO_countTagInPart(myUnit,part,tag,Nsections) function IO_countTagInPart(fileUnit,part,tag,Nsections)
implicit none implicit none
integer(pInt), intent(in) :: Nsections !< maximum number of sections in which tag is searched for integer(pInt), intent(in) :: Nsections !< maximum number of sections in which tag is searched for
integer(pInt), dimension(Nsections) :: IO_countTagInPart integer(pInt), dimension(Nsections) :: IO_countTagInPart
integer(pInt), intent(in) :: myUnit !< file handle integer(pInt), intent(in) :: fileUnit !< file handle
character(len=*),intent(in) :: part, & !< part in which tag is searched for character(len=*),intent(in) :: part, & !< part in which tag is searched for
tag !< tag to search for tag !< tag to search for
@ -775,13 +784,13 @@ function IO_countTagInPart(myUnit,part,tag,Nsections)
counter = 0_pInt counter = 0_pInt
section = 0_pInt section = 0_pInt
rewind(myUnit) rewind(fileUnit)
do while (trim(line) /= IO_EOF .and. IO_getTag(line,'<','>') /= part) ! search for part do while (trim(line) /= IO_EOF .and. IO_getTag(line,'<','>') /= part) ! search for part
line = IO_read(myUnit) line = IO_read(fileUnit)
enddo enddo
do while (trim(line) /= IO_EOF) do while (trim(line) /= IO_EOF)
line = IO_read(myUnit) line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier
@ -800,12 +809,12 @@ end function IO_countTagInPart
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief returns array of tag presence within <part> for at most N [sections] !> @brief returns array of tag presence within <part> for at most N [sections]
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function IO_spotTagInPart(myUnit,part,tag,Nsections) function IO_spotTagInPart(fileUnit,part,tag,Nsections)
implicit none implicit none
integer(pInt), intent(in) :: Nsections !< maximum number of sections in which tag is searched for integer(pInt), intent(in) :: Nsections !< maximum number of sections in which tag is searched for
logical, dimension(Nsections) :: IO_spotTagInPart logical, dimension(Nsections) :: IO_spotTagInPart
integer(pInt), intent(in) :: myUnit !< file handle integer(pInt), intent(in) :: fileUnit !< file handle
character(len=*),intent(in) :: part, & !< part in which tag is searched for character(len=*),intent(in) :: part, & !< part in which tag is searched for
tag !< tag to search for tag !< tag to search for
@ -819,13 +828,13 @@ function IO_spotTagInPart(myUnit,part,tag,Nsections)
section = 0_pInt section = 0_pInt
line ='' line =''
rewind(myUnit) rewind(fileUnit)
do while (trim(line) /= IO_EOF .and. IO_getTag(line,'<','>') /= part) ! search for part do while (trim(line) /= IO_EOF .and. IO_getTag(line,'<','>') /= part) ! search for part
line = IO_read(myUnit) line = IO_read(fileUnit)
enddo enddo
do while (trim(line) /= IO_EOF) do while (trim(line) /= IO_EOF)
line = IO_read(myUnit) line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier
@ -842,10 +851,10 @@ function IO_spotTagInPart(myUnit,part,tag,Nsections)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief return logical whether tag is present within <part> before any [sections] !> @brief return logical whether tag is present within <part> before any [sections]
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical function IO_globalTagInPart(myUnit,part,tag) logical function IO_globalTagInPart(fileUnit,part,tag)
implicit none implicit none
integer(pInt), intent(in) :: myUnit !< file handle integer(pInt), intent(in) :: fileUnit !< file handle
character(len=*),intent(in) :: part, & !< part in which tag is searched for character(len=*),intent(in) :: part, & !< part in which tag is searched for
tag !< tag to search for tag !< tag to search for
@ -859,13 +868,13 @@ logical function IO_globalTagInPart(myUnit,part,tag)
section = 0_pInt section = 0_pInt
line ='' line =''
rewind(myUnit) rewind(fileUnit)
do while (trim(line) /= IO_EOF .and. IO_getTag(line,'<','>') /= part) ! search for part do while (trim(line) /= IO_EOF .and. IO_getTag(line,'<','>') /= part) ! search for part
line = IO_read(myUnit) line = IO_read(fileUnit)
enddo enddo
do while (trim(line) /= IO_EOF) do while (trim(line) /= IO_EOF)
line = IO_read(myUnit) line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier
@ -1131,10 +1140,10 @@ end subroutine IO_lcInplace
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief reads file to skip (at least) N chunks (may be over multiple lines) !> @brief reads file to skip (at least) N chunks (may be over multiple lines)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_skipChunks(myUnit,N) subroutine IO_skipChunks(fileUnit,N)
implicit none implicit none
integer(pInt), intent(in) :: myUnit, & !< file handle integer(pInt), intent(in) :: fileUnit, & !< file handle
N !< minimum number of chunks to skip N !< minimum number of chunks to skip
integer(pInt), parameter :: MAXNCHUNKS = 64_pInt integer(pInt), parameter :: MAXNCHUNKS = 64_pInt
@ -1147,7 +1156,7 @@ subroutine IO_skipChunks(myUnit,N)
remainingChunks = N remainingChunks = N
do while (trim(line) /= IO_EOF .and. remainingChunks > 0) do while (trim(line) /= IO_EOF .and. remainingChunks > 0)
line = IO_read(myUnit) line = IO_read(fileUnit)
myPos = IO_stringPos(line,MAXNCHUNKS) myPos = IO_stringPos(line,MAXNCHUNKS)
remainingChunks = remainingChunks - myPos(1) remainingChunks = remainingChunks - myPos(1)
enddo enddo
@ -1179,10 +1188,10 @@ end function IO_extractValue
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief count lines containig data up to next *keyword !> @brief count lines containig data up to next *keyword
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
integer(pInt) function IO_countDataLines(myUnit) integer(pInt) function IO_countDataLines(fileUnit)
implicit none implicit none
integer(pInt), intent(in) :: myUnit !< file handle integer(pInt), intent(in) :: fileUnit !< file handle
integer(pInt), parameter :: MAXNCHUNKS = 1_pInt integer(pInt), parameter :: MAXNCHUNKS = 1_pInt
@ -1194,7 +1203,7 @@ integer(pInt) function IO_countDataLines(myUnit)
line = '' line = ''
do while (trim(line) /= IO_EOF) do while (trim(line) /= IO_EOF)
line = IO_read(myUnit) line = IO_read(fileUnit)
myPos = IO_stringPos(line,MAXNCHUNKS) myPos = IO_stringPos(line,MAXNCHUNKS)
tmp = IO_lc(IO_stringValue(line,myPos,1_pInt)) tmp = IO_lc(IO_stringValue(line,myPos,1_pInt))
if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword
@ -1203,7 +1212,7 @@ integer(pInt) function IO_countDataLines(myUnit)
if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt
endif endif
enddo enddo
backspace(myUnit) backspace(fileUnit)
end function IO_countDataLines end function IO_countDataLines
@ -1214,10 +1223,10 @@ end function IO_countDataLines
!> Abaqus: triplet of start,stop,inc !> Abaqus: triplet of start,stop,inc
!> Spectral: ints concatenated range of a "to" b, multiple entries with a "of" b !> Spectral: ints concatenated range of a "to" b, multiple entries with a "of" b
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
integer(pInt) function IO_countContinuousIntValues(myUnit) integer(pInt) function IO_countContinuousIntValues(fileUnit)
implicit none implicit none
integer(pInt), intent(in) :: myUnit integer(pInt), intent(in) :: fileUnit
integer(pInt), parameter :: MAXNCHUNKS = 8192_pInt integer(pInt), parameter :: MAXNCHUNKS = 8192_pInt
#ifdef Abaqus #ifdef Abaqus
@ -1231,7 +1240,7 @@ integer(pInt) function IO_countContinuousIntValues(myUnit)
#ifndef Abaqus #ifndef Abaqus
do while (trim(line) /= IO_EOF) do while (trim(line) /= IO_EOF)
line = IO_read(myUnit) line = IO_read(fileUnit)
myPos = IO_stringPos(line,MAXNCHUNKS) myPos = IO_stringPos(line,MAXNCHUNKS)
if (myPos(1) < 1_pInt) then ! empty line if (myPos(1) < 1_pInt) then ! empty line
exit exit
@ -1251,15 +1260,15 @@ integer(pInt) function IO_countContinuousIntValues(myUnit)
endif endif
enddo enddo
#else #else
c = IO_countDataLines(myUnit) c = IO_countDataLines(fileUnit)
do l = 1_pInt,c do l = 1_pInt,c
backspace(myUnit) ! ToDo: substitute by rewind? backspace(fileUnit) ! ToDo: substitute by rewind?
enddo enddo
l = 1_pInt l = 1_pInt
do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct
l = l + 1_pInt l = l + 1_pInt
line = IO_read(myUnit) line = IO_read(fileUnit)
myPos = IO_stringPos(line,MAXNCHUNKS) myPos = IO_stringPos(line,MAXNCHUNKS)
IO_countContinuousIntValues = IO_countContinuousIntValues + 1_pInt + & ! assuming range generation IO_countContinuousIntValues = IO_countContinuousIntValues + 1_pInt + & ! assuming range generation
(IO_intValue(line,myPos,2_pInt)-IO_intValue(line,myPos,1_pInt))/& (IO_intValue(line,myPos,2_pInt)-IO_intValue(line,myPos,1_pInt))/&
@ -1277,13 +1286,13 @@ end function IO_countContinuousIntValues
!! Abaqus: triplet of start,stop,inc or named set !! Abaqus: triplet of start,stop,inc or named set
!! Spectral: ints concatenated range of a "to" b, multiple entries with a "of" b !! Spectral: ints concatenated range of a "to" b, multiple entries with a "of" b
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function IO_continuousIntValues(myUnit,maxN,lookupName,lookupMap,lookupMaxN) function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN)
implicit none implicit none
integer(pInt), intent(in) :: maxN integer(pInt), intent(in) :: maxN
integer(pInt), dimension(1+maxN) :: IO_continuousIntValues integer(pInt), dimension(1+maxN) :: IO_continuousIntValues
integer(pInt), intent(in) :: myUnit, & integer(pInt), intent(in) :: fileUnit, &
lookupMaxN lookupMaxN
integer(pInt), dimension(:,:), intent(in) :: lookupMap integer(pInt), dimension(:,:), intent(in) :: lookupMap
character(len=64), dimension(:), intent(in) :: lookupName character(len=64), dimension(:), intent(in) :: lookupName
@ -1302,7 +1311,7 @@ function IO_continuousIntValues(myUnit,maxN,lookupName,lookupMap,lookupMaxN)
#ifndef Abaqus #ifndef Abaqus
do do
read(myUnit,'(A65536)',end=100) line read(fileUnit,'(A65536)',end=100) line
myPos = IO_stringPos(line,MAXNCHUNKS) myPos = IO_stringPos(line,MAXNCHUNKS)
if (myPos(1) < 1_pInt) then ! empty line if (myPos(1) < 1_pInt) then ! empty line
exit exit
@ -1337,22 +1346,22 @@ function IO_continuousIntValues(myUnit,maxN,lookupName,lookupMap,lookupMaxN)
endif endif
enddo enddo
#else #else
c = IO_countDataLines(myUnit) c = IO_countDataLines(fileUnit)
do l = 1_pInt,c do l = 1_pInt,c
backspace(myUnit) backspace(fileUnit)
enddo enddo
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! check if the element values in the elset are auto generated ! check if the element values in the elset are auto generated
backspace(myUnit) backspace(fileUnit)
read(myUnit,'(A65536)',end=100) line read(fileUnit,'(A65536)',end=100) line
myPos = IO_stringPos(line,MAXNCHUNKS) myPos = IO_stringPos(line,MAXNCHUNKS)
do i = 1_pInt,myPos(1) do i = 1_pInt,myPos(1)
if (IO_lc(IO_stringValue(line,myPos,i)) == 'generate') rangeGeneration = .true. if (IO_lc(IO_stringValue(line,myPos,i)) == 'generate') rangeGeneration = .true.
enddo enddo
do l = 1_pInt,c do l = 1_pInt,c
read(myUnit,'(A65536)',end=100) line read(fileUnit,'(A65536)',end=100) line
myPos = IO_stringPos(line,MAXNCHUNKS) myPos = IO_stringPos(line,MAXNCHUNKS)
if (verify(IO_stringValue(line,myPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line if (verify(IO_stringValue(line,myPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line
do i = 1_pInt,myPos(1) ! loop over set names in line do i = 1_pInt,myPos(1) ! loop over set names in line

13
code/debug.f90
View File

@ -135,10 +135,11 @@ subroutine debug_init
IO_lc, & IO_lc, &
IO_floatValue, & IO_floatValue, &
IO_intValue, & IO_intValue, &
IO_timeStamp IO_timeStamp, &
IO_EOF
implicit none implicit none
integer(pInt), parameter :: fileunit = 300_pInt integer(pInt), parameter :: FILEUNIT = 300_pInt
integer(pInt), parameter :: maxNchunks = 7_pInt integer(pInt), parameter :: maxNchunks = 7_pInt
integer(pInt) :: i, what integer(pInt) :: i, what
@ -176,9 +177,9 @@ subroutine debug_init
! try to open the config file ! try to open the config file
line = '' line = ''
fileExists: if(IO_open_file_stat(fileunit,debug_configFile)) then fileExists: if(IO_open_file_stat(FILEUNIT,debug_configFile)) then
do while (trim(line) /= '#EOF#') ! read thru sections of phase part do while (trim(line) /= IO_EOF) ! read thru sections of phase part
line = IO_read(fileunit) line = IO_read(FILEUNIT)
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
@ -247,7 +248,7 @@ subroutine debug_init
enddo enddo
endif endif
enddo enddo
close(fileunit) close(FILEUNIT)
do i = 1_pInt, debug_maxNtype do i = 1_pInt, debug_maxNtype
if (debug_level(i) == 0) & if (debug_level(i) == 0) &

12
code/lattice.f90
View File

@ -740,7 +740,7 @@ subroutine lattice_init
debug_levelBasic debug_levelBasic
implicit none implicit none
integer(pInt), parameter :: fileunit = 200_pInt integer(pInt), parameter :: FILEUNIT = 200_pInt
integer(pInt) :: Nsections integer(pInt) :: Nsections
write(6,'(/,a)') ' <<<+- lattice init -+>>>' write(6,'(/,a)') ' <<<+- lattice init -+>>>'
@ -748,11 +748,11 @@ subroutine lattice_init
write(6,'(a15,a)') ' Current time: ',IO_timeStamp() write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
if (.not. IO_open_jobFile_stat(fileunit,material_localFileExt)) & ! no local material configuration present... 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 call IO_open_file(FILEUNIT,material_configFile) ! ... open material.config file
Nsections = IO_countSections(fileunit,material_partPhase) Nsections = IO_countSections(FILEUNIT,material_partPhase)
lattice_Nstructure = 2_pInt + sum(IO_countTagInPart(fileunit,material_partPhase,'covera_ratio',Nsections)) ! fcc + bcc + all hex lattice_Nstructure = 2_pInt + sum(IO_countTagInPart(FILEUNIT,material_partPhase,'covera_ratio',Nsections)) ! fcc + bcc + all hex
close(fileunit) close(FILEUNIT)
if (iand(debug_level(debug_lattice),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_lattice),debug_levelBasic) /= 0_pInt) then
write(6,'(a16,1x,i5)') ' # phases:',Nsections write(6,'(a16,1x,i5)') ' # phases:',Nsections

637
code/mesh.f90
View File

File diff suppressed because it is too large Load Diff

11
code/numerics.f90
View File

@ -137,7 +137,8 @@ subroutine numerics_init
IO_floatValue, & IO_floatValue, &
IO_intValue, & IO_intValue, &
IO_warning, & IO_warning, &
IO_timeStamp IO_timeStamp, &
IO_EOF
#ifdef Spectral #ifdef Spectral
!$ use OMP_LIB, only: omp_set_num_threads ! Use the standard conforming module file for omp if not using MSC.Marc !$ use OMP_LIB, only: omp_set_num_threads ! Use the standard conforming module file for omp if not using MSC.Marc
@ -170,14 +171,14 @@ subroutine numerics_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! try to open the config file ! try to open the config file
fileExists: if(IO_open_file_stat(fileunit,numerics_configFile)) then fileExists: if(IO_open_file_stat(FILEUNIT,numerics_configFile)) then
write(6,'(a,/)') ' using values from config file' write(6,'(a,/)') ' using values from config file'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! read variables from config file and overwrite default parameters if keyword is present ! read variables from config file and overwrite default parameters if keyword is present
line = '' line = ''
do while (trim(line) /= '#EOF#') ! read thru sections of phase part do while (trim(line) /= IO_EOF) ! read thru sections of phase part
line = IO_read(fileunit) line = IO_read(FILEUNIT)
do i=1,len(line) do i=1,len(line)
if(line(i:i) == '=') line(i:i) = ' ' ! also allow keyword = value version if(line(i:i) == '=') line(i:i) = ' ' ! also allow keyword = value version
enddo enddo
@ -335,7 +336,7 @@ subroutine numerics_init
call IO_error(300_pInt,ext_msg=tag) call IO_error(300_pInt,ext_msg=tag)
endselect endselect
enddo enddo
close(fileunit) close(FILEUNIT)
else fileExists else fileExists
write(6,'(a,/)') ' using standard values' write(6,'(a,/)') ' using standard values'