!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Routines to manage CUBE TOOLS messages
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_messaging
  use gpack_def
  use gbl_message
  use cubetools_parameters
  !
  public :: toolseve,seve,mess_l
  public :: cubetools_message_set_id,cubetools_message
  public :: cubetools_message_get_alloc,cubetools_message_set_alloc
  public :: cubetools_message_get_trace,cubetools_message_set_trace
  public :: cubetools_message_get_others,cubetools_message_set_others
  public :: cubetools_message_open_help_file,cubetools_message_close_help_file
  private
  !
  type :: cubetools_messaging_t
     integer(kind=code_k) :: alloc = seve%d
     integer(kind=code_k) :: trace = seve%t
     integer(kind=code_k) :: others = seve%d
     integer(kind=code_k) :: help = 999
  end type cubetools_messaging_t
  type(cubetools_messaging_t) :: toolseve
  !
  ! Identifier used for message identification
  integer(kind=4) :: cubetools_message_id = gpack_global_id ! Default value for startup message
  !
  integer(kind=4) :: help_lun = 0
  !
contains
  !
  subroutine cubetools_message_set_id(id)
    !---------------------------------------------------------------------
    ! 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
    !
    character(len=message_length) :: mess
    !
    cubetools_message_id = id
    !
    write (mess,'(A,I3)') 'Now use id #',cubetools_message_id
    call cubetools_message(seve%d,'cubetools_message_set_id',mess)
  end subroutine cubetools_message_set_id
  !
  subroutine cubetools_message(mkind,procname,message)
    use cubetools_cmessaging
    !---------------------------------------------------------------------
    ! 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
    !
    if (mkind.eq.toolseve%help) then
      if (help_lun.ne.0) then
        write(help_lun,'(A)')  trim(message)
      else
        call cubetools_cmessage(cubetools_message_id,seve%r,'TOOLS>'//procname,message)
      endif
    else
      call cubetools_cmessage(cubetools_message_id,mkind,'TOOLS>'//procname,message)
    endif
  end subroutine cubetools_message
  !
  subroutine cubetools_message_set_alloc(on)
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    logical, intent(in) :: on
    !
    if (on) then
       toolseve%alloc = seve%i
    else
       toolseve%alloc = seve%d
    endif
  end subroutine cubetools_message_set_alloc
  !
  subroutine cubetools_message_set_trace(on)
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    logical, intent(in) :: on
    !
    if (on) then
       toolseve%trace = seve%i
    else
       toolseve%trace = seve%t
    endif
  end subroutine cubetools_message_set_trace
  !
  subroutine cubetools_message_set_others(on)
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    logical, intent(in) :: on
    !
    if (on) then
       toolseve%others = seve%i
    else
       toolseve%others = seve%d
    endif
  end subroutine cubetools_message_set_others
  !
  function cubetools_message_get_alloc()
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    logical :: cubetools_message_get_alloc
    !
    cubetools_message_get_alloc = toolseve%alloc.eq.seve%i
  end function cubetools_message_get_alloc
  !
  function cubetools_message_get_trace()
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    logical :: cubetools_message_get_trace
    !
    cubetools_message_get_trace = toolseve%trace.eq.seve%i
  end function cubetools_message_get_trace
  !
  function cubetools_message_get_others()
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    logical :: cubetools_message_get_others
    !
    cubetools_message_get_others = toolseve%others.eq.seve%i
  end function cubetools_message_get_others
  !
  subroutine cubetools_message_open_help_file(file,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Open the file where toolseve%help messages will be redirected
    ! as long as the file is not closed.
    ! If the file is closed, these messages go to the terminal.
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: file
    logical,          intent(inout) :: error
    !
    integer(kind=4) :: ier
    character(len=*), parameter :: rname='MESSAGE>OPEN>HELP>FILE'
    !
    ier = sic_getlun(help_lun)
    if (ier.ne.1) then
      call cubetools_message(seve%e,rname,'No logical unit left')
      error = .true.
      return
    endif
    ier = sic_open(help_lun,file,'NEW',.false.)
    if (ier.ne.0) then
      call cubetools_message(seve%e,rname,'Cannot open file '//file)
      error = .true.
      call sic_frelun(help_lun)
      return
    endif
  end subroutine cubetools_message_open_help_file
  !
  subroutine cubetools_message_close_help_file(error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    logical, intent(inout) :: error
    !
    integer(kind=4) :: ier
    character(len=*), parameter :: rname='MESSAGE>CLOSE>HELP>FILE'
    !
    ier = sic_close(help_lun)
    call sic_frelun(help_lun)
    help_lun = 0
  end subroutine cubetools_message_close_help_file
end module cubetools_messaging
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
