1203 lines
50 KiB
Fortran
1203 lines
50 KiB
Fortran
!--------------------------------------------------------------------------------------------------
|
|
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
|
|
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
|
|
!> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH
|
|
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
|
|
!> @brief input/output functions, partly depending on chosen solver
|
|
!--------------------------------------------------------------------------------------------------
|
|
module IO
|
|
use prec
|
|
use DAMASK_interface
|
|
|
|
implicit none
|
|
private
|
|
character(len=*), parameter, public :: &
|
|
IO_EOF = '#EOF#' !< end of file string
|
|
character(len=*), parameter, private :: &
|
|
IO_DIVIDER = '───────────────────'//&
|
|
'───────────────────'//&
|
|
'───────────────────'//&
|
|
'────────────'
|
|
public :: &
|
|
IO_init, &
|
|
IO_read_ASCII, &
|
|
IO_open_file, &
|
|
IO_open_jobFile_binary, &
|
|
IO_write_jobFile, &
|
|
IO_isBlank, &
|
|
IO_getTag, &
|
|
IO_stringPos, &
|
|
IO_stringValue, &
|
|
IO_floatValue, &
|
|
IO_intValue, &
|
|
IO_lc, &
|
|
IO_error, &
|
|
IO_warning
|
|
#if defined(Marc4DAMASK) || defined(Abaqus)
|
|
public :: &
|
|
IO_open_inputFile, &
|
|
IO_countContinuousIntValues, &
|
|
IO_continuousIntValues, &
|
|
#if defined(Abaqus)
|
|
IO_extractValue, &
|
|
IO_countDataLines
|
|
#elif defined(Marc4DAMASK)
|
|
IO_fixedNoEFloatValue, &
|
|
IO_fixedIntValue, &
|
|
IO_countNumericalDataLines
|
|
#endif
|
|
#endif
|
|
|
|
private :: &
|
|
IO_verifyFloatValue, &
|
|
IO_verifyIntValue
|
|
|
|
contains
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief does nothing.
|
|
! ToDo: needed?
|
|
!--------------------------------------------------------------------------------------------------
|
|
subroutine IO_init
|
|
|
|
write(6,'(/,a)') ' <<<+- IO init -+>>>'
|
|
|
|
end subroutine IO_init
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief reads an entire ASCII file into an array
|
|
!--------------------------------------------------------------------------------------------------
|
|
function IO_read_ASCII(fileName) result(fileContent)
|
|
|
|
character(len=*), intent(in) :: fileName
|
|
|
|
character(len=pStringLen), dimension(:), allocatable :: fileContent !< file content, separated per lines
|
|
character(len=pStringLen) :: line
|
|
character(len=:), allocatable :: rawData
|
|
integer :: &
|
|
fileLength, &
|
|
fileUnit, &
|
|
startPos, endPos, &
|
|
myTotalLines, & !< # lines read from file
|
|
l, &
|
|
myStat
|
|
logical :: warned
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
! read data as stream
|
|
inquire(file = fileName, size=fileLength)
|
|
if (fileLength == 0) then
|
|
allocate(fileContent(0))
|
|
return
|
|
endif
|
|
open(newunit=fileUnit, file=fileName, access='stream',&
|
|
status='old', position='rewind', action='read',iostat=myStat)
|
|
if(myStat /= 0) call IO_error(100,ext_msg=trim(fileName))
|
|
allocate(character(len=fileLength)::rawData)
|
|
read(fileUnit) rawData
|
|
close(fileUnit)
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
! count lines to allocate string array
|
|
myTotalLines = 1
|
|
do l=1, len(rawData)
|
|
if (rawData(l:l) == new_line('')) myTotalLines = myTotalLines+1
|
|
enddo
|
|
allocate(fileContent(myTotalLines))
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
! split raw data at end of line
|
|
warned = .false.
|
|
startPos = 1
|
|
l = 1
|
|
do while (l <= myTotalLines)
|
|
endPos = merge(startPos + scan(rawData(startPos:),new_line('')) - 2,len(rawData),l /= myTotalLines)
|
|
if (endPos - startPos > pStringLen-1) then
|
|
line = rawData(startPos:startPos+pStringLen-1)
|
|
if (.not. warned) then
|
|
call IO_warning(207,ext_msg=trim(fileName),el=l)
|
|
warned = .true.
|
|
endif
|
|
else
|
|
line = rawData(startPos:endpos)
|
|
endif
|
|
startPos = endPos + 2 ! jump to next line start
|
|
|
|
fileContent(l) = line
|
|
l = l + 1
|
|
|
|
enddo
|
|
|
|
end function IO_read_ASCII
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief opens existing file for reading to given unit. Path to file is relative to working
|
|
!! directory
|
|
!--------------------------------------------------------------------------------------------------
|
|
subroutine IO_open_file(fileUnit,path)
|
|
|
|
integer, intent(in) :: fileUnit !< file unit
|
|
character(len=*), intent(in) :: path !< relative path from working directory
|
|
|
|
integer :: myStat
|
|
|
|
open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind')
|
|
if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path)
|
|
|
|
end subroutine IO_open_file
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief opens an existing file for reading or a new file for writing. Name is the job name
|
|
!> @details replaces an existing file when writing
|
|
!--------------------------------------------------------------------------------------------------
|
|
integer function IO_open_jobFile_binary(extension,mode)
|
|
|
|
character(len=*), intent(in) :: extension
|
|
character, intent(in), optional :: mode
|
|
|
|
if (present(mode)) then
|
|
IO_open_jobFile_binary = IO_open_binary(trim(getSolverJobName())//'.'//trim(extension),mode)
|
|
else
|
|
IO_open_jobFile_binary = IO_open_binary(trim(getSolverJobName())//'.'//trim(extension))
|
|
endif
|
|
|
|
end function IO_open_jobFile_binary
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief opens an existing file for reading or a new file for writing.
|
|
!> @details replaces an existing file when writing
|
|
!--------------------------------------------------------------------------------------------------
|
|
integer function IO_open_binary(fileName,mode)
|
|
|
|
character(len=*), intent(in) :: fileName
|
|
character, intent(in), optional :: mode
|
|
|
|
character :: m
|
|
integer :: ierr
|
|
|
|
if (present(mode)) then
|
|
m = mode
|
|
else
|
|
m = 'r'
|
|
endif
|
|
|
|
if (m == 'w') then
|
|
open(newunit=IO_open_binary, file=trim(fileName),&
|
|
status='replace',access='stream',action='write',iostat=ierr)
|
|
if (ierr /= 0) call IO_error(100,ext_msg='could not open file (w): '//trim(fileName))
|
|
elseif(m == 'r') then
|
|
open(newunit=IO_open_binary, file=trim(fileName),&
|
|
status='old', access='stream',action='read', iostat=ierr)
|
|
if (ierr /= 0) call IO_error(100,ext_msg='could not open file (r): '//trim(fileName))
|
|
else
|
|
call IO_error(100,ext_msg='unknown access mode: '//m)
|
|
endif
|
|
|
|
end function IO_open_binary
|
|
|
|
|
|
#if defined(Marc4DAMASK) || defined(Abaqus)
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief opens FEM input file for reading located in current working directory to given unit
|
|
!--------------------------------------------------------------------------------------------------
|
|
subroutine IO_open_inputFile(fileUnit)
|
|
|
|
integer, intent(in) :: fileUnit !< file unit
|
|
|
|
integer :: myStat
|
|
character(len=1024) :: path
|
|
#if defined(Abaqus)
|
|
integer :: fileType
|
|
|
|
fileType = 1 ! assume .pes
|
|
path = trim(getSolverJobName())//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used
|
|
open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind')
|
|
if(myStat /= 0) then ! if .pes does not work / exist; use conventional extension, i.e.".inp"
|
|
fileType = 2
|
|
path = trim(getSolverJobName())//inputFileExtension(fileType)
|
|
open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind')
|
|
endif
|
|
if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path)
|
|
|
|
path = trim(getSolverJobName())//inputFileExtension(fileType)//'_assembly'
|
|
open(fileUnit,iostat=myStat,file=path)
|
|
if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path)
|
|
if (.not.abaqus_assembleInputFile(fileUnit,fileUnit+1)) call IO_error(103) ! strip comments and concatenate any "include"s
|
|
close(fileUnit+1)
|
|
|
|
contains
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief create a new input file for abaqus simulations by removing all comment lines and
|
|
!> including "include"s
|
|
!--------------------------------------------------------------------------------------------------
|
|
recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess)
|
|
|
|
integer, intent(in) :: unit1, &
|
|
unit2
|
|
|
|
|
|
integer, allocatable, dimension(:) :: chunkPos
|
|
character(len=pStringLen :: line,fname
|
|
logical :: createSuccess,fexist
|
|
|
|
|
|
do
|
|
read(unit2,'(A256)',END=220) line
|
|
chunkPos = IO_stringPos(line)
|
|
|
|
if (IO_lc(IO_StringValue(line,chunkPos,1))=='*include') then
|
|
fname = trim(line(9+scan(line(9:),'='):))
|
|
inquire(file=fname, exist=fexist)
|
|
if (.not.(fexist)) then
|
|
write(6,*)'ERROR: file does not exist error in abaqus_assembleInputFile'
|
|
write(6,*)'filename: ', trim(fname)
|
|
createSuccess = .false.
|
|
return
|
|
endif
|
|
open(unit2+1,err=200,status='old',file=fname)
|
|
if (abaqus_assembleInputFile(unit1,unit2+1)) then
|
|
createSuccess=.true.
|
|
close(unit2+1)
|
|
else
|
|
createSuccess=.false.
|
|
return
|
|
endif
|
|
else if (line(1:2) /= '**' .OR. line(1:8)=='**damask') then
|
|
write(unit1,'(A)') trim(line)
|
|
endif
|
|
enddo
|
|
|
|
220 createSuccess = .true.
|
|
return
|
|
|
|
200 createSuccess =.false.
|
|
|
|
end function abaqus_assembleInputFile
|
|
#elif defined(Marc4DAMASK)
|
|
path = trim(getSolverJobName())//inputFileExtension
|
|
open(fileUnit,status='old',iostat=myStat,file=path)
|
|
if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path)
|
|
#endif
|
|
|
|
end subroutine IO_open_inputFile
|
|
#endif
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief opens ASCII file to given unit for writing. File is named after solver job name plus
|
|
!! given extension and located in current working directory
|
|
!--------------------------------------------------------------------------------------------------
|
|
subroutine IO_write_jobFile(fileUnit,ext)
|
|
|
|
integer, intent(in) :: fileUnit !< file unit
|
|
character(len=*), intent(in) :: ext !< extension of file
|
|
|
|
integer :: myStat
|
|
character(len=1024) :: path
|
|
|
|
path = trim(getSolverJobName())//'.'//ext
|
|
open(fileUnit,status='replace',iostat=myStat,file=path)
|
|
if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path)
|
|
|
|
end subroutine IO_write_jobFile
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief identifies strings without content
|
|
!--------------------------------------------------------------------------------------------------
|
|
logical pure function IO_isBlank(string)
|
|
|
|
character(len=*), intent(in) :: string !< string to check for content
|
|
|
|
character(len=*), parameter :: blankChar = achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
|
|
character(len=*), parameter :: comment = achar(35) ! comment id '#'
|
|
|
|
integer :: posNonBlank, posComment
|
|
|
|
posNonBlank = verify(string,blankChar)
|
|
posComment = scan(string,comment)
|
|
IO_isBlank = posNonBlank == 0 .or. posNonBlank == posComment
|
|
|
|
end function IO_isBlank
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief get tagged content of string
|
|
!--------------------------------------------------------------------------------------------------
|
|
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, 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
|
|
|
|
IO_getTag = ''
|
|
|
|
|
|
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,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)
|
|
|
|
end function IO_getTag
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @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
|
|
!! Array size is dynamically adjusted to number of chunks found in string
|
|
!! IMPORTANT: first element contains number of chunks!
|
|
!--------------------------------------------------------------------------------------------------
|
|
pure function IO_stringPos(string)
|
|
|
|
integer, dimension(:), allocatable :: IO_stringPos
|
|
character(len=*), intent(in) :: string !< string in which chunk positions are searched for
|
|
|
|
character(len=*), parameter :: SEP=achar(44)//achar(32)//achar(9)//achar(10)//achar(13) ! comma and whitespaces
|
|
integer :: left, right
|
|
|
|
allocate(IO_stringPos(1), source=0)
|
|
right = 0
|
|
|
|
do while (verify(string(right+1:),SEP)>0)
|
|
left = right + verify(string(right+1:),SEP)
|
|
right = left + scan(string(left:),SEP) - 2
|
|
if ( string(left:left) == '#' ) exit
|
|
IO_stringPos = [IO_stringPos,left,right]
|
|
IO_stringPos(1) = IO_stringPos(1)+1
|
|
endOfString: if (right < left) then
|
|
IO_stringPos(IO_stringPos(1)*2+1) = len_trim(string)
|
|
exit
|
|
endif endOfString
|
|
enddo
|
|
|
|
end function IO_stringPos
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief reads string value at myChunk from string
|
|
!--------------------------------------------------------------------------------------------------
|
|
function IO_stringValue(string,chunkPos,myChunk,silent)
|
|
|
|
integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string
|
|
integer, intent(in) :: myChunk !< position number of desired chunk
|
|
character(len=*), intent(in) :: string !< raw input with known start and end of each chunk
|
|
character(len=:), allocatable :: IO_stringValue
|
|
|
|
logical, optional,intent(in) :: silent !< switch to trigger verbosity
|
|
character(len=*), parameter :: MYNAME = 'IO_stringValue: '
|
|
|
|
logical :: warn
|
|
|
|
if (present(silent)) then
|
|
warn = silent
|
|
else
|
|
warn = .false.
|
|
endif
|
|
|
|
IO_stringValue = ''
|
|
valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then
|
|
if (warn) call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string))
|
|
else valuePresent
|
|
IO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1))
|
|
endif valuePresent
|
|
|
|
end function IO_stringValue
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief reads float value at myChunk from string
|
|
!--------------------------------------------------------------------------------------------------
|
|
real(pReal) function IO_floatValue (string,chunkPos,myChunk)
|
|
|
|
integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string
|
|
integer, intent(in) :: myChunk !< position number of desired chunk
|
|
character(len=*), intent(in) :: string !< raw input with known start and end of each chunk
|
|
character(len=*), parameter :: MYNAME = 'IO_floatValue: '
|
|
character(len=*), parameter :: VALIDCHARACTERS = '0123456789eEdD.+-'
|
|
|
|
IO_floatValue = 0.0_pReal
|
|
|
|
valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then
|
|
call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string))
|
|
else valuePresent
|
|
IO_floatValue = &
|
|
IO_verifyFloatValue(trim(adjustl(string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)))),&
|
|
VALIDCHARACTERS,MYNAME)
|
|
endif valuePresent
|
|
|
|
end function IO_floatValue
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief reads integer value at myChunk from string
|
|
!--------------------------------------------------------------------------------------------------
|
|
integer function IO_intValue(string,chunkPos,myChunk)
|
|
|
|
character(len=*), intent(in) :: string !< raw input with known start and end of each chunk
|
|
integer, intent(in) :: myChunk !< position number of desired chunk
|
|
integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string
|
|
character(len=*), parameter :: MYNAME = 'IO_intValue: '
|
|
character(len=*), parameter :: VALIDCHARACTERS = '0123456789+-'
|
|
|
|
IO_intValue = 0
|
|
|
|
valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then
|
|
call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string))
|
|
else valuePresent
|
|
IO_intValue = IO_verifyIntValue(trim(adjustl(string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)))),&
|
|
VALIDCHARACTERS,MYNAME)
|
|
endif valuePresent
|
|
|
|
end function IO_intValue
|
|
|
|
|
|
#ifdef Marc4DAMASK
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief reads float x.y+z value at myChunk from format string
|
|
!--------------------------------------------------------------------------------------------------
|
|
real(pReal) function IO_fixedNoEFloatValue (string,ends,myChunk)
|
|
|
|
character(len=*), intent(in) :: string !< raw input with known ends of each chunk
|
|
integer, intent(in) :: myChunk !< position number of desired chunk
|
|
integer, dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string
|
|
character(len=*), parameter :: MYNAME = 'IO_fixedNoEFloatValue '
|
|
character(len=*), parameter :: VALIDBASE = '0123456789.+-'
|
|
character(len=*), parameter :: VALIDEXP = '0123456789+-'
|
|
|
|
real(pReal) :: base
|
|
integer :: expon
|
|
integer :: pos_exp
|
|
|
|
pos_exp = scan(string(ends(myChunk)+1:ends(myChunk+1)),'+-',back=.true.)
|
|
hasExponent: if (pos_exp > 1) then
|
|
base = IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1:ends(myChunk)+pos_exp-1))),&
|
|
VALIDBASE,MYNAME//'(base): ')
|
|
expon = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+pos_exp:ends(myChunk+1)))),&
|
|
VALIDEXP,MYNAME//'(exp): ')
|
|
else hasExponent
|
|
base = IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1:ends(myChunk+1)))),&
|
|
VALIDBASE,MYNAME//'(base): ')
|
|
expon = 0
|
|
endif hasExponent
|
|
IO_fixedNoEFloatValue = base*10.0_pReal**real(expon,pReal)
|
|
|
|
end function IO_fixedNoEFloatValue
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief reads integer value at myChunk from fixed format string
|
|
!--------------------------------------------------------------------------------------------------
|
|
integer function IO_fixedIntValue(string,ends,myChunk)
|
|
|
|
character(len=*), intent(in) :: string !< raw input with known ends of each chunk
|
|
integer, intent(in) :: myChunk !< position number of desired chunk
|
|
integer, dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string
|
|
character(len=*), parameter :: MYNAME = 'IO_fixedIntValue: '
|
|
character(len=*), parameter :: VALIDCHARACTERS = '0123456789+-'
|
|
|
|
IO_fixedIntValue = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+1:ends(myChunk+1)))),&
|
|
VALIDCHARACTERS,MYNAME)
|
|
|
|
end function IO_fixedIntValue
|
|
#endif
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief changes characters in string to lower case
|
|
!--------------------------------------------------------------------------------------------------
|
|
pure function IO_lc(string)
|
|
|
|
character(len=*), intent(in) :: string !< string to convert
|
|
character(len=len(string)) :: IO_lc
|
|
|
|
character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
|
|
character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
|
|
|
|
integer :: i,n
|
|
|
|
IO_lc = string
|
|
do i=1,len(string)
|
|
n = index(UPPER,IO_lc(i:i))
|
|
if (n/=0) IO_lc(i:i) = LOWER(n:n)
|
|
enddo
|
|
|
|
end function IO_lc
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief write error statements to standard out and terminate the Marc/spectral run with exit #9xxx
|
|
!> in ABAQUS either time step is reduced or execution terminated
|
|
!--------------------------------------------------------------------------------------------------
|
|
subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
|
|
|
|
integer, intent(in) :: error_ID
|
|
integer, optional, intent(in) :: el,ip,g,instance
|
|
character(len=*), optional, intent(in) :: ext_msg
|
|
|
|
external :: quit
|
|
character(len=1024) :: msg
|
|
character(len=1024) :: formatString
|
|
|
|
select case (error_ID)
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
! internal errors
|
|
case (0)
|
|
msg = 'internal check failed:'
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
! file handling errors
|
|
case (100)
|
|
msg = 'could not open file:'
|
|
case (101)
|
|
msg = 'write error for file:'
|
|
case (102)
|
|
msg = 'could not read file:'
|
|
case (103)
|
|
msg = 'could not assemble input files'
|
|
case (104)
|
|
msg = '{input} recursion limit reached'
|
|
case (105)
|
|
msg = 'unknown output:'
|
|
case (106)
|
|
msg = 'working directory does not exist:'
|
|
case (107)
|
|
msg = 'line length exceeds limit of 256'
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
! lattice error messages
|
|
case (130)
|
|
msg = 'unknown lattice structure encountered'
|
|
case (131)
|
|
msg = 'hex lattice structure with invalid c/a ratio'
|
|
case (132)
|
|
msg = 'trans_lattice_structure not possible'
|
|
case (133)
|
|
msg = 'transformed hex lattice structure with invalid c/a ratio'
|
|
case (134)
|
|
msg = 'negative lattice parameter'
|
|
case (135)
|
|
msg = 'zero entry on stiffness diagonal'
|
|
case (136)
|
|
msg = 'zero entry on stiffness diagonal for transformed phase'
|
|
case (137)
|
|
msg = 'not defined for lattice structure'
|
|
case (138)
|
|
msg = 'not enough interaction parameters given'
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
! errors related to the parsing of material.config
|
|
case (140)
|
|
msg = 'key not found'
|
|
case (141)
|
|
msg = 'number of chunks in string differs'
|
|
case (142)
|
|
msg = 'empty list'
|
|
case (143)
|
|
msg = 'no value found for key'
|
|
case (144)
|
|
msg = 'negative number systems requested'
|
|
case (145)
|
|
msg = 'too many systems requested'
|
|
case (146)
|
|
msg = 'number of values does not match'
|
|
case (147)
|
|
msg = 'not supported anymore'
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
! material error messages and related messages in mesh
|
|
case (150)
|
|
msg = 'index out of bounds'
|
|
case (151)
|
|
msg = 'microstructure has no constituents'
|
|
case (153)
|
|
msg = 'sum of phase fractions differs from 1'
|
|
case (154)
|
|
msg = 'homogenization index out of bounds'
|
|
case (155)
|
|
msg = 'microstructure index out of bounds'
|
|
case (157)
|
|
msg = 'invalid texture transformation specified'
|
|
case (160)
|
|
msg = 'no entries in config part'
|
|
case (161)
|
|
msg = 'config part found twice'
|
|
case (165)
|
|
msg = 'homogenization configuration'
|
|
case (170)
|
|
msg = 'no homogenization specified via State Variable 2'
|
|
case (180)
|
|
msg = 'no microstructure specified via State Variable 3'
|
|
case (190)
|
|
msg = 'unknown element type:'
|
|
case (191)
|
|
msg = 'mesh consists of more than one element type'
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
! plasticity error messages
|
|
case (200)
|
|
msg = 'unknown elasticity specified:'
|
|
case (201)
|
|
msg = 'unknown plasticity specified:'
|
|
|
|
case (210)
|
|
msg = 'unknown material parameter:'
|
|
case (211)
|
|
msg = 'material parameter out of bounds:'
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
! numerics error messages
|
|
case (300)
|
|
msg = 'unknown numerics parameter:'
|
|
case (301)
|
|
msg = 'numerics parameter out of bounds:'
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
! math errors
|
|
case (400)
|
|
msg = 'matrix inversion error'
|
|
case (401)
|
|
msg = 'math_check failed'
|
|
case (402)
|
|
msg = 'invalid orientation specified'
|
|
|
|
!-------------------------------------------------------------------------------------------------
|
|
! homogenization errors
|
|
case (500)
|
|
msg = 'unknown homogenization specified'
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
! user errors
|
|
case (600)
|
|
msg = 'Ping-Pong not possible when using non-DAMASK elements'
|
|
case (601)
|
|
msg = 'Ping-Pong needed when using non-local plasticity'
|
|
case (602)
|
|
msg = 'invalid selection for debug'
|
|
|
|
!-------------------------------------------------------------------------------------------------
|
|
! errors related to the grid solver
|
|
case (809)
|
|
msg = 'initializing FFTW'
|
|
case (810)
|
|
msg = 'FFTW plan creation'
|
|
case (831)
|
|
msg = 'mask consistency violated in grid load case'
|
|
case (832)
|
|
msg = 'ill-defined L (line partly defined) in grid load case'
|
|
case (834)
|
|
msg = 'negative time increment in grid load case'
|
|
case (835)
|
|
msg = 'non-positive increments in grid load case'
|
|
case (836)
|
|
msg = 'non-positive result frequency in grid load case'
|
|
case (837)
|
|
msg = 'incomplete loadcase'
|
|
case (838)
|
|
msg = 'mixed boundary conditions allow rotation'
|
|
case (839)
|
|
msg = 'non-positive restart frequency in grid load case'
|
|
case (841)
|
|
msg = 'missing header length info in grid mesh'
|
|
case (842)
|
|
msg = 'incomplete information in grid mesh header'
|
|
case (843)
|
|
msg = 'microstructure count mismatch'
|
|
case (846)
|
|
msg = 'rotation for load case rotation ill-defined (R:RT != I)'
|
|
case (891)
|
|
msg = 'unknown solver type selected'
|
|
case (892)
|
|
msg = 'unknown filter type selected'
|
|
case (894)
|
|
msg = 'MPI error'
|
|
|
|
!-------------------------------------------------------------------------------------------------
|
|
! error messages related to parsing of Abaqus input file
|
|
case (900)
|
|
msg = 'improper definition of nodes in input file (Nnodes < 2)'
|
|
case (901)
|
|
msg = 'no elements defined in input file (Nelems = 0)'
|
|
case (902)
|
|
msg = 'no element sets defined in input file (No *Elset exists)'
|
|
case (903)
|
|
msg = 'no materials defined in input file (Look into section assigments)'
|
|
case (904)
|
|
msg = 'no elements could be assigned for Elset: '
|
|
case (905)
|
|
msg = 'error in mesh_abaqus_map_materials'
|
|
case (906)
|
|
msg = 'error in mesh_abaqus_count_cpElements'
|
|
case (907)
|
|
msg = 'size of mesh_mapFEtoCPelem in mesh_abaqus_map_elements'
|
|
case (908)
|
|
msg = 'size of mesh_mapFEtoCPnode in mesh_abaqus_map_nodes'
|
|
case (909)
|
|
msg = 'size of mesh_node in mesh_abaqus_build_nodes not equal to mesh_Nnodes'
|
|
|
|
|
|
!-------------------------------------------------------------------------------------------------
|
|
! general error messages
|
|
case default
|
|
msg = 'unknown error number...'
|
|
|
|
end select
|
|
|
|
!$OMP CRITICAL (write2out)
|
|
write(0,'(/,a)') ' ┌'//IO_DIVIDER//'┐'
|
|
write(0,'(a,24x,a,40x,a)') ' │','error', '│'
|
|
write(0,'(a,24x,i3,42x,a)') ' │',error_ID, '│'
|
|
write(0,'(a)') ' ├'//IO_DIVIDER//'┤'
|
|
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len(trim(msg))),',',&
|
|
max(1,72-len(trim(msg))-4),'x,a)'
|
|
write(0,formatString) '│ ',trim(msg), '│'
|
|
if (present(ext_msg)) then
|
|
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len(trim(ext_msg))),',',&
|
|
max(1,72-len(trim(ext_msg))-4),'x,a)'
|
|
write(0,formatString) '│ ',trim(ext_msg), '│'
|
|
endif
|
|
if (present(el)) &
|
|
write(0,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│'
|
|
if (present(ip)) &
|
|
write(0,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│'
|
|
if (present(g)) &
|
|
write(0,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│'
|
|
if (present(instance)) &
|
|
write(0,'(a19,1x,i9,44x,a3)') ' │ at instance ',instance, '│'
|
|
write(0,'(a,69x,a)') ' │', '│'
|
|
write(0,'(a)') ' └'//IO_DIVIDER//'┘'
|
|
flush(0)
|
|
call quit(9000+error_ID)
|
|
!$OMP END CRITICAL (write2out)
|
|
|
|
end subroutine IO_error
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief writes warning statement to standard out
|
|
!--------------------------------------------------------------------------------------------------
|
|
subroutine IO_warning(warning_ID,el,ip,g,ext_msg)
|
|
|
|
integer, intent(in) :: warning_ID
|
|
integer, optional, intent(in) :: el,ip,g
|
|
character(len=*), optional, intent(in) :: ext_msg
|
|
|
|
character(len=1024) :: msg
|
|
character(len=1024) :: formatString
|
|
|
|
select case (warning_ID)
|
|
case (1)
|
|
msg = 'unknown key'
|
|
case (34)
|
|
msg = 'invalid restart increment given'
|
|
case (35)
|
|
msg = 'could not get $DAMASK_NUM_THREADS'
|
|
case (40)
|
|
msg = 'found spectral solver parameter'
|
|
case (42)
|
|
msg = 'parameter has no effect'
|
|
case (43)
|
|
msg = 'main diagonal of C66 close to zero'
|
|
case (47)
|
|
msg = 'no valid parameter for FFTW, using FFTW_PATIENT'
|
|
case (50)
|
|
msg = 'not all available slip system families are defined'
|
|
case (51)
|
|
msg = 'not all available twin system families are defined'
|
|
case (52)
|
|
msg = 'not all available parameters are defined'
|
|
case (53)
|
|
msg = 'not all available transformation system families are defined'
|
|
case (101)
|
|
msg = 'crystallite debugging off'
|
|
case (201)
|
|
msg = 'position not found when parsing line'
|
|
case (202)
|
|
msg = 'invalid character in string chunk'
|
|
case (203)
|
|
msg = 'interpretation of string chunk failed'
|
|
case (207)
|
|
msg = 'line truncated'
|
|
case (600)
|
|
msg = 'crystallite responds elastically'
|
|
case (601)
|
|
msg = 'stiffness close to zero'
|
|
case (650)
|
|
msg = 'polar decomposition failed'
|
|
case (700)
|
|
msg = 'unknown crystal symmetry'
|
|
case (850)
|
|
msg = 'max number of cut back exceeded, terminating'
|
|
case default
|
|
msg = 'unknown warning number'
|
|
end select
|
|
|
|
!$OMP CRITICAL (write2out)
|
|
write(6,'(/,a)') ' ┌'//IO_DIVIDER//'┐'
|
|
write(6,'(a,24x,a,38x,a)') ' │','warning', '│'
|
|
write(6,'(a,24x,i3,42x,a)') ' │',warning_ID, '│'
|
|
write(6,'(a)') ' ├'//IO_DIVIDER//'┤'
|
|
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len(trim(msg))),',',&
|
|
max(1,72-len(trim(msg))-4),'x,a)'
|
|
write(6,formatString) '│ ',trim(msg), '│'
|
|
if (present(ext_msg)) then
|
|
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len(trim(ext_msg))),',',&
|
|
max(1,72-len(trim(ext_msg))-4),'x,a)'
|
|
write(6,formatString) '│ ',trim(ext_msg), '│'
|
|
endif
|
|
if (present(el)) &
|
|
write(6,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│'
|
|
if (present(ip)) &
|
|
write(6,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│'
|
|
if (present(g)) &
|
|
write(6,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│'
|
|
write(6,'(a,69x,a)') ' │', '│'
|
|
write(6,'(a)') ' └'//IO_DIVIDER//'┘'
|
|
flush(6)
|
|
!$OMP END CRITICAL (write2out)
|
|
|
|
end subroutine IO_warning
|
|
|
|
|
|
#if defined(Abaqus) || defined(Marc4DAMASK)
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief reads a line from a text file.
|
|
!--------------------------------------------------------------------------------------------------
|
|
function IO_read(fileUnit) result(line)
|
|
|
|
integer, intent(in) :: fileUnit !< file unit
|
|
|
|
character(len=pStringLen) :: line
|
|
|
|
|
|
read(fileUnit,'(a256)',END=100) line
|
|
|
|
100 end function IO_read
|
|
|
|
|
|
#ifdef Abaqus
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief extracts string value from key=value pair and check whether key matches
|
|
!--------------------------------------------------------------------------------------------------
|
|
character(len=300) pure function IO_extractValue(pair,key)
|
|
|
|
character(len=*), intent(in) :: pair, & !< key=value pair
|
|
key !< key to be expected
|
|
|
|
character(len=*), parameter :: SEP = achar(61) ! '='
|
|
|
|
integer :: myChunk !< position number of desired chunk
|
|
|
|
IO_extractValue = ''
|
|
|
|
myChunk = scan(pair,SEP)
|
|
if (myChunk > 0 .and. pair(:myChunk-1) == key) IO_extractValue = pair(myChunk+1:) ! extract value if key matches
|
|
|
|
end function IO_extractValue
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief count lines containig data up to next *keyword
|
|
!--------------------------------------------------------------------------------------------------
|
|
integer function IO_countDataLines(fileUnit)
|
|
|
|
integer, intent(in) :: fileUnit !< file handle
|
|
|
|
|
|
integer, allocatable, dimension(:) :: chunkPos
|
|
character(len=pStringLen) :: line, &
|
|
tmp
|
|
|
|
IO_countDataLines = 0
|
|
line = ''
|
|
|
|
do while (trim(line) /= IO_EOF)
|
|
line = IO_read(fileUnit)
|
|
chunkPos = IO_stringPos(line)
|
|
tmp = IO_lc(IO_stringValue(line,chunkPos,1))
|
|
if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword
|
|
exit
|
|
else
|
|
if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1
|
|
endif
|
|
enddo
|
|
backspace(fileUnit)
|
|
|
|
end function IO_countDataLines
|
|
#endif
|
|
|
|
|
|
#ifdef Marc4DAMASK
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief count lines containig data up to next *keyword
|
|
!--------------------------------------------------------------------------------------------------
|
|
integer function IO_countNumericalDataLines(fileUnit)
|
|
|
|
integer, intent(in) :: fileUnit !< file handle
|
|
|
|
|
|
integer, allocatable, dimension(:) :: chunkPos
|
|
character(len=pStringLen) :: line, &
|
|
tmp
|
|
|
|
IO_countNumericalDataLines = 0
|
|
line = ''
|
|
|
|
do while (trim(line) /= IO_EOF)
|
|
line = IO_read(fileUnit)
|
|
chunkPos = IO_stringPos(line)
|
|
tmp = IO_lc(IO_stringValue(line,chunkPos,1))
|
|
if (verify(trim(tmp),'0123456789') == 0) then ! numerical values
|
|
IO_countNumericalDataLines = IO_countNumericalDataLines + 1
|
|
else
|
|
exit
|
|
endif
|
|
enddo
|
|
backspace(fileUnit)
|
|
|
|
end function IO_countNumericalDataLines
|
|
#endif
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief count items in consecutive lines depending on lines
|
|
!> @details Marc: ints concatenated by "c" as last char or range of values a "to" b
|
|
!> Abaqus: triplet of start,stop,inc
|
|
!--------------------------------------------------------------------------------------------------
|
|
integer function IO_countContinuousIntValues(fileUnit)
|
|
|
|
integer, intent(in) :: fileUnit
|
|
|
|
#ifdef Abaqus
|
|
integer :: l,c
|
|
#endif
|
|
integer, allocatable, dimension(:) :: chunkPos
|
|
character(len=pStringLen) :: line
|
|
|
|
IO_countContinuousIntValues = 0
|
|
line = ''
|
|
|
|
#if defined(Marc4DAMASK)
|
|
do while (trim(line) /= IO_EOF)
|
|
line = IO_read(fileUnit)
|
|
chunkPos = IO_stringPos(line)
|
|
if (chunkPos(1) < 1) then ! empty line
|
|
exit
|
|
elseif (IO_lc(IO_stringValue(line,chunkPos,2)) == 'to' ) then ! found range indicator
|
|
IO_countContinuousIntValues = 1 + abs( IO_intValue(line,chunkPos,3) &
|
|
-IO_intValue(line,chunkPos,1))
|
|
exit ! only one single range indicator allowed
|
|
else
|
|
IO_countContinuousIntValues = IO_countContinuousIntValues+chunkPos(1)-1 ! add line's count when assuming 'c'
|
|
if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value
|
|
IO_countContinuousIntValues = IO_countContinuousIntValues+1
|
|
exit ! data ended
|
|
endif
|
|
endif
|
|
enddo
|
|
#elif defined(Abaqus)
|
|
c = IO_countDataLines(fileUnit)
|
|
do l = 1,c
|
|
backspace(fileUnit)
|
|
enddo
|
|
|
|
l = 1
|
|
do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct?
|
|
l = l + 1
|
|
line = IO_read(fileUnit)
|
|
chunkPos = IO_stringPos(line)
|
|
IO_countContinuousIntValues = IO_countContinuousIntValues + 1 + & ! assuming range generation
|
|
(IO_intValue(line,chunkPos,2)-IO_intValue(line,chunkPos,1))/&
|
|
max(1,IO_intValue(line,chunkPos,3))
|
|
enddo
|
|
#endif
|
|
|
|
end function IO_countContinuousIntValues
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief return integer list corresponding to items in consecutive lines.
|
|
!! First integer in array is counter
|
|
!> @details Marc: ints concatenated by "c" as last char, range of a "to" b, or named set
|
|
!! Abaqus: triplet of start,stop,inc or named set
|
|
!--------------------------------------------------------------------------------------------------
|
|
function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN)
|
|
|
|
integer, intent(in) :: maxN
|
|
integer, dimension(1+maxN) :: IO_continuousIntValues
|
|
|
|
integer, intent(in) :: fileUnit, &
|
|
lookupMaxN
|
|
integer, dimension(:,:), intent(in) :: lookupMap
|
|
character(len=*), dimension(:), intent(in) :: lookupName
|
|
integer :: i,first,last
|
|
#ifdef Abaqus
|
|
integer :: j,l,c
|
|
#endif
|
|
integer, allocatable, dimension(:) :: chunkPos
|
|
character(len=pStringLen) :: line
|
|
logical :: rangeGeneration
|
|
|
|
IO_continuousIntValues = 0
|
|
rangeGeneration = .false.
|
|
|
|
#if defined(Marc4DAMASK)
|
|
do
|
|
read(fileUnit,'(A256)',end=100) line
|
|
chunkPos = IO_stringPos(line)
|
|
if (chunkPos(1) < 1) then ! empty line
|
|
exit
|
|
elseif (verify(IO_stringValue(line,chunkPos,1),'0123456789') > 0) then ! a non-int, i.e. set name
|
|
do i = 1, lookupMaxN ! loop over known set names
|
|
if (IO_stringValue(line,chunkPos,1) == lookupName(i)) then ! found matching name
|
|
IO_continuousIntValues = lookupMap(:,i) ! return resp. entity list
|
|
exit
|
|
endif
|
|
enddo
|
|
exit
|
|
else if (chunkPos(1) > 2 .and. IO_lc(IO_stringValue(line,chunkPos,2)) == 'to' ) then ! found range indicator
|
|
first = IO_intValue(line,chunkPos,1)
|
|
last = IO_intValue(line,chunkPos,3)
|
|
do i = first, last, sign(1,last-first)
|
|
IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1
|
|
IO_continuousIntValues(1+IO_continuousIntValues(1)) = i
|
|
enddo
|
|
exit
|
|
else
|
|
do i = 1,chunkPos(1)-1 ! interpret up to second to last value
|
|
IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1
|
|
IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i)
|
|
enddo
|
|
if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value
|
|
IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1
|
|
IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,chunkPos(1))
|
|
exit
|
|
endif
|
|
endif
|
|
enddo
|
|
#elif defined(Abaqus)
|
|
c = IO_countDataLines(fileUnit)
|
|
do l = 1,c
|
|
backspace(fileUnit)
|
|
enddo
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
! check if the element values in the elset are auto generated
|
|
backspace(fileUnit)
|
|
read(fileUnit,'(A256)',end=100) line
|
|
chunkPos = IO_stringPos(line)
|
|
do i = 1,chunkPos(1)
|
|
if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'generate') rangeGeneration = .true.
|
|
enddo
|
|
|
|
do l = 1,c
|
|
read(fileUnit,'(A256)',end=100) line
|
|
chunkPos = IO_stringPos(line)
|
|
if (verify(IO_stringValue(line,chunkPos,1),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line
|
|
do i = 1,chunkPos(1) ! loop over set names in line
|
|
do j = 1,lookupMaxN ! look through known set names
|
|
if (IO_stringValue(line,chunkPos,i) == lookupName(j)) then ! found matching name
|
|
first = 2 + IO_continuousIntValues(1) ! where to start appending data
|
|
last = first + lookupMap(1,j) - 1 ! up to where to append data
|
|
IO_continuousIntValues(first:last) = lookupMap(2:1+lookupMap(1,j),j) ! add resp. entity list
|
|
IO_continuousIntValues(1) = IO_continuousIntValues(1) + lookupMap(1,j) ! count them
|
|
endif
|
|
enddo
|
|
enddo
|
|
else if (rangeGeneration) then ! range generation
|
|
do i = IO_intValue(line,chunkPos,1),&
|
|
IO_intValue(line,chunkPos,2),&
|
|
max(1,IO_intValue(line,chunkPos,3))
|
|
IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1
|
|
IO_continuousIntValues(1+IO_continuousIntValues(1)) = i
|
|
enddo
|
|
else ! read individual elem nums
|
|
do i = 1,chunkPos(1)
|
|
IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1
|
|
IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i)
|
|
enddo
|
|
endif
|
|
enddo
|
|
#endif
|
|
|
|
100 end function IO_continuousIntValues
|
|
#endif
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
! internal helper functions
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief returns verified integer value in given string
|
|
!--------------------------------------------------------------------------------------------------
|
|
integer function IO_verifyIntValue (string,validChars,myName)
|
|
|
|
character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces!
|
|
validChars, & !< valid characters in string
|
|
myName !< name of caller function (for debugging)
|
|
integer :: readStatus, invalidWhere
|
|
|
|
IO_verifyIntValue = 0
|
|
|
|
invalidWhere = verify(string,validChars)
|
|
if (invalidWhere == 0) then
|
|
read(UNIT=string,iostat=readStatus,FMT=*) IO_verifyIntValue ! no offending chars found
|
|
if (readStatus /= 0) & ! error during string to integer conversion
|
|
call IO_warning(203,ext_msg=myName//'"'//string//'"')
|
|
else
|
|
call IO_warning(202,ext_msg=myName//'"'//string//'"') ! complain about offending characters
|
|
read(UNIT=string(1:invalidWhere-1),iostat=readStatus,FMT=*) IO_verifyIntValue ! interpret remaining string
|
|
if (readStatus /= 0) & ! error during string to integer conversion
|
|
call IO_warning(203,ext_msg=myName//'"'//string(1:invalidWhere-1)//'"')
|
|
endif
|
|
|
|
end function IO_verifyIntValue
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief returns verified float value in given string
|
|
!--------------------------------------------------------------------------------------------------
|
|
real(pReal) function IO_verifyFloatValue (string,validChars,myName)
|
|
|
|
character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces!
|
|
validChars, & !< valid characters in string
|
|
myName !< name of caller function (for debugging)
|
|
|
|
integer :: readStatus, invalidWhere
|
|
|
|
IO_verifyFloatValue = 0.0_pReal
|
|
|
|
invalidWhere = verify(string,validChars)
|
|
if (invalidWhere == 0) then
|
|
read(UNIT=string,iostat=readStatus,FMT=*) IO_verifyFloatValue ! no offending chars found
|
|
if (readStatus /= 0) & ! error during string to float conversion
|
|
call IO_warning(203,ext_msg=myName//'"'//string//'"')
|
|
else
|
|
call IO_warning(202,ext_msg=myName//'"'//string//'"') ! complain about offending characters
|
|
read(UNIT=string(1:invalidWhere-1),iostat=readStatus,FMT=*) IO_verifyFloatValue ! interpret remaining string
|
|
if (readStatus /= 0) & ! error during string to float conversion
|
|
call IO_warning(203,ext_msg=myName//'"'//string(1:invalidWhere-1)//'"')
|
|
endif
|
|
|
|
end function IO_verifyFloatValue
|
|
|
|
end module IO
|