DAMASK_EICMD/src/IO.f90

937 lines
38 KiB
Fortran
Raw Normal View History

!--------------------------------------------------------------------------------------------------
!> @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
2019-09-20 01:28:51 +05:30
use prec
use DAMASK_interface
implicit none
private
2019-12-21 12:04:40 +05:30
character(len=*), parameter, public :: &
2019-09-20 01:28:51 +05:30
IO_EOF = '#EOF#' !< end of file string
2020-01-02 19:44:12 +05:30
character, parameter, public :: &
IO_EOL = new_line(' ') !< end of line str
2019-12-21 12:04:40 +05:30
character(len=*), parameter, private :: &
2019-09-20 01:28:51 +05:30
IO_DIVIDER = '───────────────────'//&
'───────────────────'//&
'───────────────────'//&
'────────────'
public :: &
IO_init, &
IO_read_ASCII, &
IO_open_jobFile_binary, &
IO_isBlank, &
IO_getTag, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_lc, &
IO_error, &
2019-12-11 23:54:29 +05:30
IO_warning
2014-11-06 17:17:27 +05:30
#if defined(Marc4DAMASK) || defined(Abaqus)
2019-09-20 01:28:51 +05:30
public :: &
2020-01-25 18:00:42 +05:30
IO_open_inputFile
#if defined(Abaqus)
2020-01-12 20:38:38 +05:30
public :: &
2020-01-25 18:00:42 +05:30
IO_continuousIntValues, &
2019-09-20 01:28:51 +05:30
IO_extractValue, &
IO_countDataLines
#endif
2020-01-25 18:00:42 +05:30
#endif
2019-06-16 00:02:53 +05:30
contains
!--------------------------------------------------------------------------------------------------
!> @brief does nothing.
!--------------------------------------------------------------------------------------------------
subroutine IO_init
2020-01-12 20:38:38 +05:30
write(6,'(/,a)') ' <<<+- IO init -+>>>'; flush(6)
call unitTest
end subroutine IO_init
!--------------------------------------------------------------------------------------------------
!> @brief reads an entire ASCII file into an array
!--------------------------------------------------------------------------------------------------
function IO_read_ASCII(fileName) result(fileContent)
2019-05-15 02:14:38 +05:30
character(len=*), intent(in) :: fileName
2019-06-16 00:02:53 +05:30
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)
2020-01-02 19:44:12 +05:30
if (rawData(l:l) == IO_EOL) myTotalLines = myTotalLines+1
enddo
allocate(fileContent(myTotalLines))
!--------------------------------------------------------------------------------------------------
! split raw data at end of line
warned = .false.
startPos = 1
l = 1
do while (l <= myTotalLines)
2020-01-02 19:44:12 +05:30
endPos = merge(startPos + scan(rawData(startPos:),IO_EOL) - 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
2014-05-21 15:33:57 +05:30
end function IO_read_ASCII
!--------------------------------------------------------------------------------------------------
!> @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
2019-10-17 09:24:08 +05:30
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
2014-11-06 17:17:27 +05:30
#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)
2019-06-16 00:02:53 +05:30
integer, intent(in) :: fileUnit !< file unit
integer :: myStat
character(len=1024) :: path
#if defined(Abaqus)
2019-06-16 00:02:53 +05:30
integer :: fileType
2019-06-16 00:02:53 +05:30
fileType = 1 ! assume .pes
path = trim(getSolverJobName())//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used
2019-06-16 00:02:53 +05:30
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)
2019-06-16 00:02:53 +05:30
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'
2019-06-16 00:02:53 +05:30
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
2019-12-21 17:07:02 +05:30
character(len=pStringLen :: line,fname
2019-06-16 00:02:53 +05:30
logical :: createSuccess,fexist
do
2020-01-12 04:40:42 +05:30
read(unit2,'(A)',END=220) line
2019-06-16 00:02:53 +05:30
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)
2019-06-16 00:02:53 +05:30
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.
2019-06-16 00:02:53 +05:30
return
200 createSuccess =.false.
2019-06-16 00:02:53 +05:30
end function abaqus_assembleInputFile
#elif defined(Marc4DAMASK)
path = trim(getSolverJobName())//inputFileExtension
2019-06-16 00:02:53 +05:30
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 identifies strings without content
!--------------------------------------------------------------------------------------------------
logical pure function IO_isBlank(string)
2019-06-16 00:02:53 +05:30
character(len=*), intent(in) :: string !< string to check for content
2019-06-16 00:02:53 +05:30
character(len=*), parameter :: blankChar = achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
character(len=*), parameter :: comment = achar(35) ! comment id '#'
2019-06-16 00:02:53 +05:30
integer :: posNonBlank, posComment
2019-06-16 00:02:53 +05:30
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=:), allocatable :: IO_getTag
2019-06-16 00:02:53 +05:30
character(len=*), intent(in) :: string !< string to check for tag
character, intent(in) :: openChar, & !< indicates beginning of tag
closeChar !< indicates end of tag
2019-06-16 00:02:53 +05:30
character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
integer :: left,right
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
foundTag: if (left == verify(string,SEP) .and. right > left) then
2019-06-16 00:02:53 +05:30
IO_getTag = string(left+1:right-1)
else foundTag
IO_getTag = ''
endif foundTag
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)
2019-05-15 02:14:38 +05:30
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
2019-06-11 18:09:51 +05:30
integer :: left, right
2019-05-15 02:14:38 +05:30
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
2019-10-17 09:24:08 +05:30
IO_stringPos = [IO_stringPos,left,right]
2019-05-15 02:14:38 +05:30
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)
2020-01-26 23:01:56 +05:30
character(len=*), intent(in) :: string !< raw input with known start and end of each chunk
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=:), allocatable :: IO_stringValue
validChunk: if (myChunk > chunkPos(1) .or. myChunk < 1) then
IO_stringValue = ''
call IO_error(110,el=myChunk,ext_msg='IO_stringValue '//trim(string))
else validChunk
2019-06-16 00:02:53 +05:30
IO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1))
endif validChunk
end function IO_stringValue
!--------------------------------------------------------------------------------------------------
!> @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, 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
IO_intValue = verifyIntValue(IO_stringValue(string,chunkPos,myChunk))
end function IO_intValue
!--------------------------------------------------------------------------------------------------
!> @brief reads float value at myChunk from string
!--------------------------------------------------------------------------------------------------
real(pReal) function IO_floatValue(string,chunkPos,myChunk)
2020-01-26 23:01:56 +05:30
character(len=*), intent(in) :: string !< raw input with known start and end of each chunk
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
IO_floatValue = verifyFloatValue(IO_stringValue(string,chunkPos,myChunk))
end function IO_floatValue
!--------------------------------------------------------------------------------------------------
!> @brief changes characters in string to lower case
!--------------------------------------------------------------------------------------------------
pure function IO_lc(string)
2019-06-16 00:02:53 +05:30
character(len=*), intent(in) :: string !< string to convert
character(len=len(string)) :: IO_lc
2019-06-16 00:02:53 +05:30
character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
integer :: i,n
2019-06-16 00:02:53 +05:30
do i=1,len(string)
IO_lc(i:i) = string(i:i)
2019-06-16 00:02:53 +05:30
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)
2019-06-16 00:02:53 +05:30
integer, intent(in) :: error_ID
integer, optional, intent(in) :: el,ip,g,instance
character(len=*), optional, intent(in) :: ext_msg
2019-06-16 00:02:53 +05:30
external :: quit
2020-01-04 23:31:36 +05:30
character(len=pStringLen) :: msg
character(len=pStringLen) :: formatString
2019-06-16 00:02:53 +05:30
select case (error_ID)
!--------------------------------------------------------------------------------------------------
! internal errors
2019-06-16 00:02:53 +05:30
case (0)
msg = 'internal check failed:'
!--------------------------------------------------------------------------------------------------
! file handling errors
2019-06-16 00:02:53 +05:30
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 (106)
msg = 'working directory does not exist:'
!--------------------------------------------------------------------------------------------------
! file parsing errors
case (110)
msg = 'invalid chunk selected'
case (111)
msg = 'invalid character for int:'
case (112)
msg = 'invalid character for float:'
!--------------------------------------------------------------------------------------------------
! lattice error messages
2019-06-16 00:02:53 +05:30
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'
2019-09-21 06:46:08 +05:30
case (134)
msg = 'negative lattice parameter'
2019-06-16 00:02:53 +05:30
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'
2018-06-11 03:08:16 +05:30
!--------------------------------------------------------------------------------------------------
! errors related to the parsing of material.config
2019-06-16 00:02:53 +05:30
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'
2018-06-11 03:08:16 +05:30
!--------------------------------------------------------------------------------------------------
! material error messages and related messages in mesh
2019-06-16 00:02:53 +05:30
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)
2019-09-20 19:10:21 +05:30
msg = 'invalid texture transformation specified'
2019-06-16 00:02:53 +05:30
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
2019-06-16 00:02:53 +05:30
case (200)
msg = 'unknown elasticity specified:'
case (201)
msg = 'unknown plasticity specified:'
2019-06-16 00:02:53 +05:30
case (210)
msg = 'unknown material parameter:'
case (211)
msg = 'material parameter out of bounds:'
!--------------------------------------------------------------------------------------------------
! numerics error messages
2019-06-16 00:02:53 +05:30
case (300)
msg = 'unknown numerics parameter:'
case (301)
msg = 'numerics parameter out of bounds:'
!--------------------------------------------------------------------------------------------------
! math errors
2019-06-16 00:02:53 +05:30
case (400)
msg = 'matrix inversion error'
case (401)
msg = 'math_check failed'
2019-09-20 19:10:21 +05:30
case (402)
msg = 'invalid orientation specified'
!-------------------------------------------------------------------------------------------------
! homogenization errors
2019-06-16 00:02:53 +05:30
case (500)
msg = 'unknown homogenization specified'
!--------------------------------------------------------------------------------------------------
! user errors
2019-06-16 00:02:53 +05:30
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
2019-06-16 00:02:53 +05:30
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'
2019-06-30 03:36:47 +05:30
case (839)
msg = 'non-positive restart frequency in grid load case'
2019-06-16 00:02:53 +05:30
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
2019-06-16 00:02:53 +05:30
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
2019-06-16 00:02:53 +05:30
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//'┤'
2020-01-26 23:01:56 +05:30
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)'
2019-06-16 00:02:53 +05:30
write(0,formatString) '│ ',trim(msg), '│'
if (present(ext_msg)) then
2020-01-26 23:01:56 +05:30
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)'
2019-06-16 00:02:53 +05:30
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)
2009-01-20 00:40:58 +05:30
end subroutine IO_error
!--------------------------------------------------------------------------------------------------
!> @brief writes warning statement to standard out
!--------------------------------------------------------------------------------------------------
subroutine IO_warning(warning_ID,el,ip,g,ext_msg)
2019-06-16 00:02:53 +05:30
integer, intent(in) :: warning_ID
integer, optional, intent(in) :: el,ip,g
character(len=*), optional, intent(in) :: ext_msg
2020-01-04 23:31:36 +05:30
character(len=pStringLen) :: msg
character(len=pStringLen) :: formatString
2019-06-16 00:02:53 +05:30
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 (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//'┤'
2020-01-26 23:01:56 +05:30
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)'
2019-06-16 00:02:53 +05:30
write(6,formatString) '│ ',trim(msg), '│'
if (present(ext_msg)) then
2020-01-26 23:01:56 +05:30
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)'
2019-06-16 00:02:53 +05:30
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
#ifdef Abaqus
!--------------------------------------------------------------------------------------------------
!> @brief extracts string value from key=value pair and check whether key matches
!--------------------------------------------------------------------------------------------------
character(len=300) pure function IO_extractValue(pair,key)
2019-09-20 01:28:51 +05:30
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
!--------------------------------------------------------------------------------------------------
2019-05-15 02:14:38 +05:30
integer function IO_countDataLines(fileUnit)
2019-09-20 01:28:51 +05:30
integer, intent(in) :: fileUnit !< file handle
integer, allocatable, dimension(:) :: chunkPos
2019-12-21 17:07:02 +05:30
character(len=pStringLen) :: line, &
2019-09-20 01:28:51 +05:30
tmp
IO_countDataLines = 0
line = ''
do while (trim(line) /= IO_EOF)
2020-01-25 18:00:42 +05:30
read(fileUnit,'(A)') line
2019-09-20 01:28:51 +05:30
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
!--------------------------------------------------------------------------------------------------
!> @brief return integer list corresponding to items in consecutive lines.
!! First integer in array is counter
2020-01-25 18:00:42 +05:30
!> @details Abaqus: triplet of start,stop,inc or named set
!--------------------------------------------------------------------------------------------------
function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN)
2019-05-15 02:14:38 +05:30
integer, intent(in) :: maxN
integer, dimension(1+maxN) :: IO_continuousIntValues
2019-05-15 02:14:38 +05:30
integer, intent(in) :: fileUnit, &
lookupMaxN
2019-05-15 02:14:38 +05:30
integer, dimension(:,:), intent(in) :: lookupMap
2019-12-21 17:07:02 +05:30
character(len=*), dimension(:), intent(in) :: lookupName
2019-05-15 02:14:38 +05:30
integer :: i,first,last
integer :: j,l,c
integer, allocatable, dimension(:) :: chunkPos
2019-12-21 17:07:02 +05:30
character(len=pStringLen) :: line
logical :: rangeGeneration
2019-05-15 02:14:38 +05:30
IO_continuousIntValues = 0
rangeGeneration = .false.
c = IO_countDataLines(fileUnit)
2019-05-15 02:14:38 +05:30
do l = 1,c
backspace(fileUnit)
enddo
!--------------------------------------------------------------------------------------------------
! check if the element values in the elset are auto generated
backspace(fileUnit)
2020-01-12 04:40:42 +05:30
read(fileUnit,'(A)',end=100) line
chunkPos = IO_stringPos(line)
2019-05-15 02:14:38 +05:30
do i = 1,chunkPos(1)
if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'generate') rangeGeneration = .true.
enddo
2019-05-15 02:14:38 +05:30
do l = 1,c
2020-01-12 04:40:42 +05:30
read(fileUnit,'(A)',end=100) line
chunkPos = IO_stringPos(line)
2019-05-15 02:14:38 +05:30
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
2019-05-15 02:14:38 +05:30
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
2019-05-15 02:14:38 +05:30
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
2019-05-15 02:14:38 +05:30
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
100 end function IO_continuousIntValues
#endif
!--------------------------------------------------------------------------------------------------
! internal helper functions
!--------------------------------------------------------------------------------------------------
!> @brief returns verified integer value in given string
!--------------------------------------------------------------------------------------------------
integer function verifyIntValue(string)
character(len=*), intent(in) :: string !< string for conversion to int value
integer :: readStatus, invalidWhere
character(len=*), parameter :: VALIDCHARS = '0123456789+- '
invalidWhere = verify(string,VALIDCHARS)
valid: if (invalidWhere == 0) then
read(string,*,iostat=readStatus) verifyIntValue
if (readStatus /= 0) call IO_error(111,ext_msg=string)
else valid
verifyIntValue = 0
call IO_error(111,ext_msg=string)
endif valid
2020-01-02 19:44:12 +05:30
end function verifyIntValue
!--------------------------------------------------------------------------------------------------
!> @brief returns verified float value in given string
!--------------------------------------------------------------------------------------------------
real(pReal) function verifyFloatValue(string)
character(len=*), intent(in) :: string !< string for conversion to float value
integer :: readStatus, invalidWhere
character(len=*), parameter :: VALIDCHARS = '0123456789eE.+- '
invalidWhere = verify(string,VALIDCHARS)
valid: if (invalidWhere == 0) then
read(string,*,iostat=readStatus) verifyFloatValue
if (readStatus /= 0) call IO_error(112,ext_msg=string)
else valid
verifyFloatValue = 0.0_pReal
call IO_error(112,ext_msg=string)
endif valid
2020-01-02 19:44:12 +05:30
end function verifyFloatValue
!--------------------------------------------------------------------------------------------------
!> @brief check correctness of IO functions
!--------------------------------------------------------------------------------------------------
subroutine unitTest
if(dNeq(1.0_pReal, verifyFloatValue('1.0'))) call IO_error(401,ext_msg='verifyFloatValue')
if(dNeq(1.0_pReal, verifyFloatValue('1e0'))) call IO_error(401,ext_msg='verifyFloatValue')
if(dNeq(0.1_pReal, verifyFloatValue('1e-1'))) call IO_error(401,ext_msg='verifyFloatValue')
if(3112019 /= verifyIntValue( '3112019')) call IO_error(401,ext_msg='verifyIntValue')
if(3112019 /= verifyIntValue(' 3112019')) call IO_error(401,ext_msg='verifyIntValue')
if(-3112019 /= verifyIntValue('-3112019')) call IO_error(401,ext_msg='verifyIntValue')
if(3112019 /= verifyIntValue('+3112019 ')) call IO_error(401,ext_msg='verifyIntValue')
if(any([2,1,2,4,4] /= IO_stringPos('aa b'))) call IO_error(401,ext_msg='IO_stringPos')
end subroutine unitTest
end module IO