report_error Subroutine

  subroutine report_error(error_id)

    !! Adds the latest error message to the list already specified
    !! author: P J Knight, CCFE, Culham Science Centre
    !! error_id : input integer : identifier (error_type element number)
    !! for the relevant error
    !! This routine should be called if a informational, warning
    !! or error message needs to be flagged.
    !! It uses a linked list (see references) to provide
    !! an audit trail for any such messages during the program
    !! execution.
    !! <P>Up to eight integer and eight floating-point diagnostic
    !! values may be saved by the user in arrays <CODE>idiags</CODE> and
    !! <CODE>fdiags</CODE>, respectively, for debugging; these arrays must
    !! be assigned with up to eight values each prior to calling this routine.
    !! <P>The <CODE>error_status</CODE> variable returns the highest severity
    !! level that has been encountered; if a severe error is flagged
    !! (level 3) the program is terminated immediately.
    !! Introduction to Fortran 90/95, Stephen J, Chapman, pp.467-472,
    !! McGraw-Hill, ISBN 0-07-115896-0
    !
    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    implicit none

    !  Arguments

    integer, intent(in) :: error_id

    !  Local variables

    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    !  Turn on error handling if a severe error has been encountered

    if (error_type(error_id)%level == ERROR_SEVERE) errors_on = .true.

    !  Error handling is only turned on during an output step, not during
    !  intermediate iteration steps

    if (.not.errors_on) then
       idiags = INT_DEFAULT
       fdiags = FLT_DEFAULT
       return
    end if

    if (.not.associated(error_head)) then
       allocate(error_head)
       error_tail => error_head
    else

! SJP Issue #867
! Remove consecutive identical error messages

       if (error_tail%id == error_id) return

       allocate(error_tail%ptr)
       error_tail => error_tail%ptr
    end if

    error_tail%id           = error_id
    error_tail%data%level   = error_type(error_id)%level
    error_tail%data%message = error_type(error_id)%message
    error_tail%data%idiags = idiags ; idiags = INT_DEFAULT
    error_tail%data%fdiags = fdiags ; fdiags = FLT_DEFAULT

    nullify (error_tail%ptr)

    !  Update the overall error status (highest severity level encountered)
    !  and stop the program if a severe error has occurred

    error_status = max(error_status, error_type(error_id)%level)

    if (error_status == ERROR_SEVERE) then
       call show_errors
       write(*,*) 'PROCESS stopping.'
       stop 1
    end if

  end subroutine report_error