show_errors Subroutine

  subroutine show_errors

    !! Reports all informational/error messages encountered
    !! author: P J Knight, CCFE, Culham Science Centre
    !! None
    !! This routine provides a summary audit trail of all the errors
    !! encountered during the program's execution.
    !! Introduction to Fortran 90/95, Stephen J, Chapman, pp.467-472,
    !! McGraw-Hill, ISBN 0-07-115896-0
    !
    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    use constants, only: iotty, nout
    use process_output, only: oblnkl, oheadr, ocmmnt, ovarin, ostars
    implicit none

    !  Arguments

    !  Local variables

    type (error_list_item), pointer :: ptr
    integer :: i
    character(len=50) :: status_message

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

    call oheadr(iotty,'Errors and Warnings')
    call oheadr(nout,'Errors and Warnings')
    call ocmmnt(nout,'(See top of file for solver errors and warnings.)')

    select case (error_status)
    case (0)
        status_message = 'No messages'
    case (1)
        status_message = 'Information messages only'
    case (2)
        status_message = 'Warning messages'
    case (3)
        status_message = 'Errors'
    case default
        status_message = 'Incorrect value of error_status'
    end select

    call ocmmnt(nout,'PROCESS status flag:   '//status_message)
    write(*,*)       'PROCESS status flag:   '//status_message
    call oblnkl(iotty)
    call ovarin(nout,'PROCESS error status flag','(error_status)',error_status)

    ptr => error_head

    if (.not.associated(ptr)) then
       call ovarin(nout,'Final error/warning identifier','(error_id)',error_id)
       return
    end if

    write(*,*) 'ID  LEVEL  MESSAGE'

    output: do
       if (.not.associated(ptr)) exit output

       error_id = ptr%id
       write(nout,'(i3,t7,i3,t13,a80)') ptr%id,ptr%data%level,ptr%data%message
       write(*,   '(i3,t7,i3,t13,a80)') ptr%id,ptr%data%level,ptr%data%message

       if (any(ptr%data%idiags /= INT_DEFAULT)) then
          write(*,*) 'Integer diagnostic values for this error:'
          do i = 1,8
             if (ptr%data%idiags(i) /= INT_DEFAULT) then
                  write(*,'(i4,a,i14)') i,') ',ptr%data%idiags(i)
                  write(nout,'(i4,a,i14)') i,') ',ptr%data%idiags(i)
             endif
          end do
       end if
       if (any(ptr%data%fdiags /= FLT_DEFAULT)) then
          write(*,*) 'Floating point diagnostic values for this error:'
          do i = 1,8
             if (ptr%data%fdiags(i) /= FLT_DEFAULT) then
                  write(*,'(i4,a,1pe14.5)') i,') ',ptr%data%fdiags(i)
                  write(nout,'(i4,a,1pe14.5)') i,') ',ptr%data%fdiags(i)
             endif
          end do
       end if
       write(*,*) ' '

       ptr => ptr%ptr
    end do output
    call ostars(iotty, 110)
    call oblnkl(iotty)

    call ovarin(nout,'Final error identifier','(error_id)',error_id)

  end subroutine show_errors