!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Routines to manage CUBE IO messages
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeio_messaging
  use gpack_def
  use gbl_message
  use gkernel_interfaces
  use cubetools_parameters
  !
  private :: cubeio_message_id
  !
  ! Identifier used for message identification
  integer(kind=4) :: cubeio_message_id = gpack_global_id  ! Default value for startup message
  !
  public :: ioseve
  !
  type :: cubeio_messaging_debug_t
     integer(kind=code_k) :: alloc = seve%d
     integer(kind=code_k) :: trans = seve%d
     integer(kind=code_k) :: trace = seve%t
     integer(kind=code_k) :: others = seve%d
  end type cubeio_messaging_debug_t
  !
  type(cubeio_messaging_debug_t) :: ioseve
  !
contains
  !
  subroutine cubeio_message_set_id(id)
    !---------------------------------------------------------------------
    ! @ 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
    !
    cubeio_message_id = id
    !
    write (mess,'(A,I3)') 'Now use id #',cubeio_message_id
    call cubeio_message(seve%d,'cubeio_message_set_id',mess)
  end subroutine cubeio_message_set_id
  !
  subroutine cubeio_message(mkind,procname,message)
    !$ use omp_lib
    use cubetools_cmessaging
    !---------------------------------------------------------------------
    ! @ 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
    ! Local
    integer(kind=4) :: nc
    logical :: parallel
    integer(kind=4), parameter :: mc=32
    character(len=mc) :: myprocname
    !
    parallel = .false.
    !$ parallel = OMP_IN_PARALLEL()
    if (parallel) then
      nc = len_trim(procname)
      if (nc.gt.mc-8)  nc = mc-8  ! Leave room for "IO>" (3 leading chars) and
                                  ! "(999)" (5 trailing chars)
      !$ write (myprocname,'(A3,A,A1,I0,A1)')  &
      !$   'IO>',procname(1:nc),'(',OMP_GET_THREAD_NUM(),')'
    else
      myprocname = 'IO>'//procname  ! Implicit truncation
    endif
    call cubetools_cmessage(cubeio_message_id,mkind,myprocname,message)
  end subroutine cubeio_message
  !
  !---------------------------------------------------------------------
  !
  subroutine cubeio_message_set_alloc(on)
    !-------------------------------------------------------------------
    !-------------------------------------------------------------------
    logical, intent(in) :: on
    if (on) then
       ioseve%alloc = seve%i
    else
       ioseve%alloc = seve%d
    endif
  end subroutine cubeio_message_set_alloc
  !
  subroutine cubeio_message_set_trans(on)
    !-------------------------------------------------------------------
    !-------------------------------------------------------------------
    logical, intent(in) :: on
    if (on) then
       ioseve%trans = seve%i
    else
       ioseve%trans = seve%d
    endif
  end subroutine cubeio_message_set_trans
  !
  subroutine cubeio_message_set_trace(on)
    !-------------------------------------------------------------------
    !-------------------------------------------------------------------
    logical, intent(in) :: on
    if (on) then
       ioseve%trace = seve%i
    else
       ioseve%trace = seve%t
    endif
  end subroutine cubeio_message_set_trace
  !
  subroutine cubeio_message_set_others(on)
    !-------------------------------------------------------------------
    !-------------------------------------------------------------------
    logical, intent(in) :: on
    if (on) then
       ioseve%others = seve%i
    else
       ioseve%others = seve%d
    endif
  end subroutine cubeio_message_set_others
  !
  !---------------------------------------------------------------------
  !
  function cubeio_message_get_alloc()
    !-------------------------------------------------------------------
    !-------------------------------------------------------------------
    logical :: cubeio_message_get_alloc
    cubeio_message_get_alloc = ioseve%alloc.eq.seve%i
  end function cubeio_message_get_alloc
  !
  function cubeio_message_get_trans()
    !-------------------------------------------------------------------
    !-------------------------------------------------------------------
    logical :: cubeio_message_get_trans
    cubeio_message_get_trans = ioseve%trans.eq.seve%i
  end function cubeio_message_get_trans
  !
  function cubeio_message_get_trace()
    !-------------------------------------------------------------------
    !-------------------------------------------------------------------
    logical :: cubeio_message_get_trace
    cubeio_message_get_trace = ioseve%trace.eq.seve%i
  end function cubeio_message_get_trace
  !
  function cubeio_message_get_others()
    !-------------------------------------------------------------------
    !-------------------------------------------------------------------
    logical :: cubeio_message_get_others
    cubeio_message_get_others = ioseve%others.eq.seve%i
  end function cubeio_message_get_others
  !
end module cubeio_messaging
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
