io2_error Subroutine

subroutine io2_error(error, message, source1, source2, token1, token2, filename, &
      & line1, line2, label1, label2)

   !> Error handler
   type(error_type), allocatable, intent(out) :: error

   !> Main error message
   character(len=*), intent(in) :: message

   !> String representing the offending input
   character(len=*), intent(in) :: source1, source2

   !> Last processed token
   type(token_type), intent(in) :: token1, token2

   !> Name of the input file
   character(len=*), intent(in), optional :: filename

   !> Line number
   integer, intent(in), optional :: line1, line2

   !> Label of the offending statement
   character(len=*), intent(in), optional :: label1, label2

   character(len=*), parameter :: nl = new_line('a')
   integer :: offset, lnum1, lnum2, width1, width2
   character(len=:), allocatable :: string

   lnum1 = 1
   lnum2 = 1
   if (present(line1)) lnum1 = line1
   if (present(line2)) lnum2 = line2
   offset = integer_width(max(lnum1, lnum2))
   width1 = token1%last - token1%first + 1
   width2 = token2%last - token2%first + 1

   string = "Error: " // message

   if (present(filename)) then
      string = string // nl // &
         repeat(" ", offset)//"--> "//filename

      string = string // ":" // to_string(lnum2)
      if (token2%first > 0 .and. token2%last >= token2%first) then
         string = string // &
            ":"//to_string(token2%first)
         if (token2%last > token2%first) string = string//"-"//to_string(token2%last)
      end if
   end if

   string = string // nl //&
      repeat(" ", offset+1)//"|"//nl//&
      to_string(lnum1, offset)//" | "//source1//nl//&
      repeat(" ", offset+1)//"|"//repeat(" ", token1%first)//repeat("-", width1)

   if (present(label1)) then
      string = string // " " // label1
   end if

   string = string // nl //&
      repeat(" ", offset+1)//":"//nl//&
      to_string(lnum2)//" | "//source2//nl//&
      repeat(" ", offset+1)//"|"//repeat(" ", token2%first)//repeat("^", width2)

   if (present(label2)) then
      string = string // " " // label2
   end if

   string = string // nl //&
      repeat(" ", offset+1)//"|"

   call fatal_error(error, string)
end subroutine io2_error