!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Routines to manage CLASSIC messages
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module classic_message_private
  use gpack_def
  !
  ! Identifier used for message identification
  integer(kind=4) :: classic_message_id = gpack_global_id  ! Default value for startup message
  !
end module classic_message_private
!
subroutine classic_message_set_id(id)
  use gbl_message
  use classic_interfaces, except_this=>classic_message_set_id
  use classic_message_private
  !---------------------------------------------------------------------
  ! @ public
  ! Alter library id into input id. Should be called by the library
  ! which wants to share its id with the current one.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: id         !
  ! Local
  character(len=message_length) :: mess
  !
  classic_message_id = id
  !
  write (mess,'(A,I3)') 'Now use id #',classic_message_id
  call classic_message(seve%d,'classic_message_set_id',mess)
  !
end subroutine classic_message_set_id
!
subroutine classic_message(mkind,procname,message)
  use gkernel_interfaces
  use classic_message_private
  !---------------------------------------------------------------------
  ! @ private
  ! Messaging facility for the current library. Calls the low-level
  ! (internal) messaging routine with its own identifier.
  !---------------------------------------------------------------------
  integer(kind=4),  intent(in) :: mkind     ! Message kind
  character(len=*), intent(in) :: procname  ! Name of calling procedure
  character(len=*), intent(in) :: message   ! Message string
  !
  call gmessage_write(classic_message_id,mkind,procname,message)
  !
end subroutine classic_message
!
subroutine classic_iostat(mkind,procname,ier)
  use gbl_message
  use gkernel_interfaces
  use classic_interfaces, except_this=>classic_iostat
  !---------------------------------------------------------------------
  ! @ private
  ! Output system message corresponding to IO error code IER, and
  ! using the MESSAGE routine
  !---------------------------------------------------------------------
  integer,          intent(in) :: mkind     ! Message severity
  character(len=*), intent(in) :: procname  ! Calling routine name
  integer,          intent(in) :: ier       ! IO error number
  ! Local
  character(len=message_length) :: msg
  !
  if (ier.eq.0) return
  call gag_iostat(msg,ier)
  call classic_message(mkind,procname,msg)
  !
end subroutine classic_iostat
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
