module n3error

  implicit none

  integer, parameter:: N3ERRNUM = 40
  integer, parameter:: MESSAGE_LEN = 80

  character(40), save, private:: infobuf(N3ERRNUM)
  integer, save, private:: xrefbuf(N3ERRNUM)
  integer, save, private:: codebuf(N3ERRNUM)
  integer, save, private:: errcount = 0
  logical, parameter, private:: debug = .true.

  INCLUDE 'errtab.inc'
  INCLUDE 'reftab.inc'

  private:: error_push

contains

  !
  ! === LOW-LEVEL ROUTINES ===
  !

  subroutine error_clear
    errcount = 0
  end subroutine

  subroutine error_push(xref, code, info)
    integer, intent(in):: xref, code
    character(*), intent(in), optional:: info
    if (errcount == N3ERRNUM) return
    errcount = errcount + 1
    xrefbuf(errcount) = xref
    codebuf(errcount) = code
    if (present(info)) then
      infobuf(errcount) = info
    endif
    if (debug) then
      print *, "#error_push", xref, code
    endif
  end subroutine

  subroutine error_set(xref, code)
    integer, intent(in):: xref, code
    call error_clear
    call error_push(xref, code)
  end subroutine

  subroutine error_add(xref, code)
    integer, intent(in):: xref, code
    call error_push(xref, code)
  end subroutine

  subroutine error_count(count)
    integer, intent(out):: count
    count = errcount
  end subroutine

  subroutine error_peek(n, message, reference)
    use n3hashraw, only: htrefer
    use n3bits, only: itoaunpack
    integer, intent(in):: n
    character(*), intent(out):: message
    character(*), intent(out):: reference
    integer:: ibuf(20)
    integer:: stat
    character(80):: strbuf
    if (n >= 1 .and. n <= errcount) then
      call htrefer(reftab, xrefbuf(n:n), ibuf, stat)
      if (stat == 0) then
        call itoaunpack(ibuf, size(ibuf), strbuf)
      else
        write(strbuf, '(A,I10.1,A)') '(loc #', xrefbuf(n), ')'
      endif
      reference = strbuf
      message = errmsg(codebuf(n))
    else
      reference = ""
      write(strbuf, '(A,I10.1)') '* BAD MSG LVL ', n
      message = strbuf
    endif
  end subroutine

  !
  ! === HIGH-LEVEL FUNCTIONS ===
  !

  subroutine trace(unit, prefix)
    use n3io1, only: writeln
    integer, intent(in), optional:: unit
    character(*), intent(in), optional:: prefix
    integer:: i, n, iunit
    character(MESSAGE_LEN):: loc, msg
    character(3):: pre
    call error_count(count = n)
    if (present(prefix)) then
      pre = prefix(1:1) // '*'
    else
      pre = ' *'
    endif
    do, i = 1, n
      call error_peek(i, msg, loc)
      if (i == 2) pre(2:2) = '+'
      call writeln(pre // trim(msg) // ' ' // trim(loc), unit)
    enddo
    call error_clear
  end subroutine

  subroutine die(xref, code, unit)
    integer, intent(in), optional:: xref, code, unit
    if (present(xref) .and. present(code)) then
      call error_push(xref, code)
    endif
    call trace(unit)
    stop 16
  end subroutine

end module