DAMASK_EICMD/src/IO.f90

!--------------------------------------------------------------------------------------------------
!> @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, parameter, public :: &
    IO_EOL = new_line(' ')                                                                          !< end of line str
  character(len=*), parameter, private :: &
    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, &
    IO_warning
#if defined(Marc4DAMASK) || defined(Abaqus)
  public :: &
    IO_open_inputFile
#if defined(Abaqus)
  public :: &
    IO_continuousIntValues, &
    IO_extractValue, &
    IO_countDataLines
#endif
#endif

contains


!--------------------------------------------------------------------------------------------------
!> @brief does nothing.
!--------------------------------------------------------------------------------------------------
subroutine IO_init
 
  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)

  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) == 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)
    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

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

  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,'(A)',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 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=:), allocatable :: IO_getTag
  character(len=*), intent(in)  :: string                                                           !< string to check for tag
  character,        intent(in)  :: openChar, &                                                      !< indicates beginning of tag
                                   closeChar                                                        !< indicates end of tag
 
  character(len=*), parameter   :: SEP=achar(32)//achar(9)//achar(10)//achar(13)                    ! whitespaces
  integer :: left,right
 
  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
    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)

  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)

  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
    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)

  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)

  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

  do i=1,len(string)
    IO_lc(i:i) = string(i:i)
    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=pStringLen)              :: msg
  character(len=pStringLen)              :: 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 (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
    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 (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=pStringLen)              :: msg
  character(len=pStringLen)              :: 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 (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


#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)
    read(fileUnit,'(A)') line
    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
!> @details 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
 integer :: j,l,c
 integer, allocatable, dimension(:) :: chunkPos
 character(len=pStringLen)          :: line
 logical :: rangeGeneration

 IO_continuousIntValues = 0
 rangeGeneration = .false.

 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,'(A)',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,'(A)',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

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
 
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
 
end function verifyFloatValue


!--------------------------------------------------------------------------------------------------
!> @brief check correctness of IO functions
!--------------------------------------------------------------------------------------------------
subroutine unitTest

  integer, dimension(:), allocatable :: chunkPos
  character(len=:),      allocatable :: str

  if(dNeq(1.0_pReal, verifyFloatValue('1.0')))      call IO_error(0,ext_msg='verifyFloatValue')
  if(dNeq(1.0_pReal, verifyFloatValue('1e0')))      call IO_error(0,ext_msg='verifyFloatValue')
  if(dNeq(0.1_pReal, verifyFloatValue('1e-1')))     call IO_error(0,ext_msg='verifyFloatValue')

  if(3112019  /= verifyIntValue( '3112019'))        call IO_error(0,ext_msg='verifyIntValue')
  if(3112019  /= verifyIntValue(' 3112019'))        call IO_error(0,ext_msg='verifyIntValue')
  if(-3112019 /= verifyIntValue('-3112019'))        call IO_error(0,ext_msg='verifyIntValue')
  if(3112019  /= verifyIntValue('+3112019 '))       call IO_error(0,ext_msg='verifyIntValue')

  if(any([1,1,1]     /= IO_stringPos('a')))         call IO_error(0,ext_msg='IO_stringPos')
  if(any([2,2,3,5,5] /= IO_stringPos(' aa b')))     call IO_error(0,ext_msg='IO_stringPos')

  str=' 1.0 xxx'
  chunkPos = IO_stringPos(str)
  if(dNeq(1.0_pReal,IO_floatValue(str,chunkPos,1))) call IO_error(0,ext_msg='IO_floatValue')

  str='M 3112019 F'
  chunkPos = IO_stringPos(str)
  if(3112019 /= IO_intValue(str,chunkPos,2))        call IO_error(0,ext_msg='IO_intValue')

end subroutine unitTest

end module IO