module gbl_message_private
  use gpack_def
  use gbl_ansicodes
  !---------------------------------------------------------------------
  ! @private
  ! Support parameters and variables for message printing to screen and
  ! message file
  !---------------------------------------------------------------------
  !
  ! 1/ SEVERITIES
  !
  integer(kind=4),      parameter :: nseve = 9       ! Number of severities
  character(len=1),     parameter :: seve_levels(nseve) = &
    (/ 'F','E','W','R','I','D','T','C','U' /)        ! Severity letters. Order matters
  character(len=nseve), parameter :: seve_allflags = 'FEWRIDTCU'
  !
  ! 2/ OUTPUTS
  !
  ! General message file unit number. Packages do not have their own
  ! message file, and write into the general one
  integer(kind=4) :: meslun = 0
  !
  ! A "messaging-rules type" (message_rules_t) is provided. Each package
  ! can use it to define a structure which contains its customizable
  ! rules
  type :: message_rules_t
     !       F      E      W      R      I      D       T       C       U
     logical :: toscreen(nseve) =  &  ! FEWRI---U
        (/ .true.,.true.,.true.,.true.,.true.,.false.,.false.,.false.,.true. /)
     logical :: tofile(nseve)   =  &  ! FEWRI--CU
        (/ .true.,.true.,.true.,.true.,.true.,.false.,.false.,.true., .true. /)
  end type message_rules_t
  !
  ! Define the structure which stores all logical filters. Index 0 is
  ! the global rules which may override ALL packages rules.
  type(message_rules_t), save :: message_rules(0:gpack_max_count)
  !
  integer(kind=4), parameter :: ncolors=10
  type :: colors_t
    character(len=7) :: name(ncolors) =  &
      (/ 'NONE   ',  &
         'BLACK  ',  &
         'RED    ',  &
         'GREEN  ',  &
         'YELLOW ',  &
         'BLUE   ',  &
         'MAGENTA',  &
         'CYAN   ',  &
         'WHITE  ',  &
         'ORANGE ' /)
    character(len=11) :: code(ncolors) =  &
        (/ '           ',        &
           c_black  //'      ',  &  ! (do not forget blank padding for array constructor!)
           c_red    //'      ',  &
           c_green  //'      ',  &
           c_yellow //'      ',  &
           c_blue   //'      ',  &
           c_magenta//'      ',  &
           c_cyan   //'      ',  &
           c_white  //'      ',  &
           c_orange /)
  end type colors_t
  type(colors_t) :: colors
  !
  ! Add a "messaging-color type":
  type :: message_colors_t
     !        F      E      W       R       I       D       T       C       U
     logical :: enabled(nseve) =  &
        (/ .true.,.true.,.true.,.false.,.false.,.false.,.false.,.false.,.false. /)
     character(len=7) :: name(nseve) =  &
        (/ 'RED    ',  &  ! F
           'RED    ',  &  ! E
           'ORANGE ',  &  ! W
           'NONE   ',  &  ! R
           'NONE   ',  &  ! I
           'NONE   ',  &  ! D
           'NONE   ',  &  ! T
           'NONE   ',  &  ! C
           'NONE   '  /)  ! U
     character(len=11) :: code(nseve) =  &
        (/ c_red//'      ',  &  ! F (do not forget blank padding for array constructor!)
           c_red//'      ',  &  ! E
           c_orange,         &  ! W
           '           ',    &  ! R
           '           ',    &  ! I
           '           ',    &  ! D
           '           ',    &  ! T
           '           ',    &  ! C
           '           '    /)  ! U
     integer(kind=4) :: lcode(nseve) =  &
        (/  5, 5, 11, 0, 0, 0, 0, 0, 0 /)
  end type message_colors_t
  type(message_colors_t) :: message_colors
  !
  logical :: mes_gbl_rules  = .true.   ! Use global rules
  logical :: mes_gbl_colors = .true.   ! Use global colors
  logical :: mes_use_debug  = .false.  ! Debug (high verbosity) is in use
  logical :: mes_log_date   = .false.  ! Print date in file
  logical :: mes_log_append = .false.  ! Append file if already existing
  !
end module gbl_message_private
!
subroutine gmessage_init(logname,error)
  use gsys_interfaces, except_this=>gmessage_init
  use gbl_message_private
  !---------------------------------------------------------------------
  ! @ public
  ! Initialization routine for gmessage facility:
  !  - close previously opened message file (useful to change the file
  !    during a session)
  !  - open the (new) message file
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: logname
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='GMESSAGE>INIT'
  character(len=256) :: release
  !
  if (meslun.ne.0) then
    ! That's a close-and-open action. Warn
    call gsys_message(seve%w,rname,  &
      'Closing and reopening message file under name '//logname)
  endif
  !
  call gmessage_close(error)
  if (error) return
  !
  call gmessage_open(logname,error)
  if (error) return
  !
  ! First line of the message file is the Gildas version (always, whatever
  ! the filtering rules)
  call gag_release(release)
  write(meslun,'(A)')  trim(release)
  !
end subroutine gmessage_init
!
subroutine gmessage_parse_and_set(inid,infilter,error)
  use gsys_interfaces, except_this=>gmessage_parse_and_set
  use gbl_message
  use gbl_message_private
  !---------------------------------------------------------------------
  ! @ public
  ! Alter the message filters for input package. Inputs are:
  ! 1) The package id,
  ! 2) The alteration rule, as used in SIC command line, e.g. "s-dtu",
  !    "l=fewri", ...
  !---------------------------------------------------------------------
  integer(kind=4),  intent(in)    :: inid      ! Package id
  character(len=*), intent(in)    :: infilter  ! Filter rule
  logical,          intent(inout) :: error     ! Error flag
  ! Local
  character(len=*), parameter :: rname='MESSAGE'
  integer(kind=4) :: iseve
  logical :: reset,tofil,toscr,toflag,found,lfilter(nseve)
  character(len=1)  :: letter
  character(len=filter_length) :: filter
  character(len=message_length) :: mess
  !
  ! Local copy
  filter = infilter
  call sic_upper(filter)
  !
  ! Check if input id is correct
  if (inid .gt. gpack_get_count()) then
    write(mess,*) "Unknown package id #",inid
    call gsys_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! Affects which messages? These are exclusive letters, ie parse only
  ! once.
  letter = filter(1:1)
  filter = filter(2:)
  found  = .false.
  toscr  = .true.   ! Default is to screen
  tofil  = .false.
  if (letter.eq.'L') then
    found = .true.
    toscr = .false.
    tofil = .true.
  elseif (letter.eq.'S') then
    found = .true.
    toscr = .true.
    tofil = .false.
  elseif (letter.eq.'A') then
    found = .true.
    tofil = .true.
    toscr = .true.
  endif
  if (found) then
    letter = filter(1:1)
    filter = filter(2:)
    found  = .false.
  endif
  !
  ! Which kind of modification? These are exclusive symbols, ie parse
  ! only once.
  toflag = .true.    ! Default is '+'
  reset  = .false.   ! Default is no reset (.true. if '=')
  if (letter.eq.'-') then
    found  = .true.
    toflag = .false.
  elseif (letter.eq.'=') then
    found  = .true.
    reset  = .true.
    toflag = .true.
  elseif (letter.eq.'+') then
    found  = .true.
    toflag = .true.
  endif
  if (found) then
    letter = filter(1:1)
    filter = filter(2:)
    found = .false.
  endif
  !
  ! Reset?
  ! Forbid syntax "s=" (which redefines filter as empty)
  if (reset .and. letter.eq.' ') then
    call gsys_message(seve%e,rname,'Erasing all flags with = operator is forbidden')
    call gsys_message(seve%e,rname,'Use - operator and explicitely remove them')
    error = .true.
    return
  endif
  !
  ! Translate filter string in logical array. lfilter stores which message
  ! kinds we want to toggle, NOT the destination value.
  lfilter = .false.
  do
    if (letter.eq.' ') exit  ! All done
    do iseve=1,nseve
      if (letter.eq.seve_levels(iseve)) then
        found = .true.
        lfilter(iseve) = .true.
      endif
    enddo
    if (found) then
      letter = filter(1:1)
      filter = filter(2:)
      found  = .false.
    else
      call gsys_message(seve%e,rname,'Malformed message filter rule near '''//letter//'''')
      error = .true.
      return
    endif
  enddo
  !
  ! Finally, alter filters for current package
  if (reset.and.tofil) message_rules(inid)%tofile   = .false.
  if (reset.and.toscr) message_rules(inid)%toscreen = .false.
  !
  do iseve=1,nseve
    if (lfilter(iseve)) then
      if (toscr) message_rules(inid)%toscreen(iseve) = toflag
      if (tofil) message_rules(inid)%tofile(iseve)   = toflag
    endif
  enddo
  !
end subroutine gmessage_parse_and_set
!
subroutine gmessage_parse_and_set_all(infilter,error)
  use gsys_interfaces, except_this=>gmessage_parse_and_set_all
  !---------------------------------------------------------------------
  ! @ public
  ! Updates all filters for all packages (excluding "Global" ones),
  ! given the input alteration rule
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: infilter  ! Filter rule
  logical,          intent(inout) :: error     ! Error flag
  ! Local
  integer(kind=4) :: ipack
  !
  do ipack=1,gpack_get_count()
    call gmessage_parse_and_set(ipack,infilter,error)
    if (error)  return
  enddo
  !
end subroutine gmessage_parse_and_set_all
!
subroutine gmessage_print_active(sev,error)
  use gsys_interfaces, except_this=>gmessage_print_active
  use gpack_def
  use gbl_message_private
  !---------------------------------------------------------------------
  ! @ public
  ! Prints all filters for all ACTIVE packages (i.e. "Global" or "per
  ! package")
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: sev    ! Severity used to write output
  logical,         intent(inout) :: error  ! Error flag
  !
  if (mes_gbl_rules) then
    call gmessage_print_id(gpack_global_id,sev,error)
  else
    call gmessage_print_all(sev,error)
  endif
  !
end subroutine gmessage_print_active
!
subroutine gmessage_print_all(sev,error)
  use gsys_interfaces, except_this=>gmessage_print_all
  !---------------------------------------------------------------------
  ! @ public
  ! Prints filters for all packages (excluding "Global" ones)
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: sev    ! Severity used to write output
  logical,         intent(inout) :: error  ! Error flag
  ! Local
  integer(kind=4) :: ipack
  !
  do ipack=1,gpack_get_count()
    call gmessage_print_id(ipack,sev,error)
    if (error)  return
  enddo
  !
end subroutine gmessage_print_all
!
subroutine gmessage_print_id(id,sev,error)
  use gsys_interfaces, except_this=>gmessage_print_id
  use gpack_def
  use gbl_message
  use gbl_message_private
  !---------------------------------------------------------------------
  ! @ public
  ! Prints filters for the input package. Input is the package id.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: id     ! Package id
  integer(kind=4), intent(in)    :: sev    ! Severity used to write output
  logical,         intent(inout) :: error  ! Error flag
  ! Local
  character(len=*), parameter :: rname='MESSAGE'
  integer(kind=4) :: iseve
  character(len=nseve) :: scr_filter,fil_filter
  character(len=8) :: activity
  character(len=message_length) :: mess
  character(len=gpack_name_length) :: packname
  !
  do iseve=1,nseve
    if (message_rules(id)%toscreen(iseve)) then
      scr_filter(iseve:iseve) = seve_levels(iseve)
    else
      scr_filter(iseve:iseve) = '-'
    endif
    if (message_rules(id)%tofile(iseve)) then
      fil_filter(iseve:iseve) = seve_levels(iseve)
    else
      fil_filter(iseve:iseve) = '-'
    endif
  enddo ! iseve
  !
  ! Show filter strings
  call gpack_get_name(id,packname,error)
  if (error) return
  !
  ! Active or inactive?
  if ( (id.eq.0 .and. .not.mes_gbl_rules) .or. (id.ne.0 .and. mes_gbl_rules) ) then
    activity = 'inactive'
  else
    activity = 'active  '
  endif
  !
  ! Print
  write (mess,100) packname,'on-screen ',activity,scr_filter
  call gsys_message(sev,rname,mess)
  write (mess,100) packname,'to-mesfile',activity,fil_filter
  call gsys_message(sev,rname,mess)
  !
100  format(A,1X,A,1X,A,' filter: ',A)
  !
end subroutine gmessage_print_id
!
subroutine gmessage_print(packname,error)
  use gsys_interfaces, except_this=>gmessage_print
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! Prints filters for the input package. Input is the package name.
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: packname  ! Package name
  logical,          intent(inout) :: error     ! Error flag
  ! Local
  integer(kind=4) :: id
  !
  id = gpack_get_id(packname,.true.,error)
  if (error)  return
  !
  call gmessage_print_id(id,seve%i,error)
  if (error) return
  !
end subroutine gmessage_print
!
subroutine gmessage_translate(seve_leve,seve_code,error)
  use gsys_interfaces, except_this=>gmessage_translate
  use gbl_message_private
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! Translate a message severity letter into its corresponding integer
  ! code, as a call to gmessage_write needs.
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: seve_leve  ! Input severity letter
  integer(kind=4),  intent(out)   :: seve_code  ! Translated code
  logical,          intent(inout) :: error      ! Error flag
  ! Local
  character(len=*), parameter :: rname='MESSAGE'
  character(len=1) :: letter
  !
  letter = seve_leve
  call sic_upper(letter)
  !
  do seve_code=1,nseve
    if (letter.eq.seve_levels(seve_code)) return
  enddo
  !
  call gsys_message(seve%e,rname,'Unknown message kind '''//seve_leve//'''')
  error = .true.
  !
end subroutine gmessage_translate
!
subroutine gmessage_log_append(flag)
  use gbl_message_private
  !---------------------------------------------------------------------
  ! @ public
  ! Message file will be appended if already existing. Must be called
  ! before opening the message file.
  !---------------------------------------------------------------------
  logical, intent(in) :: flag
  !
  mes_log_append = flag
  !
end subroutine gmessage_log_append
!
subroutine gmessage_open(mesname,error)
  use gildas_def
  use gbl_message_private
  use gsys_interfaces, except_this=>gmessage_open
  !---------------------------------------------------------------------
  ! @ private
  ! Opens message file in GAG_LOG: directory. Must be called only once.
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: mesname  ! Message base filename
  logical,          intent(inout) :: error    ! Error flag
  ! Local
  integer(kind=4) :: status,ml
  character(len=17) :: failure_message='F-MESSAGE_INIT,  '
  character(len=filename_length) :: mesfile
  !
  ! Should be called only once
  if (meslun.ne.0) then
    write(*,'(A,A)') failure_message,'Message file is already opened'
    error = .true.
    return
  endif
  !
  ! Build the name of the message file
  call sic_parse_file(mesname,'GAG_LOG:','.mes',mesfile)
  !
  ! Get rid of older versions
  status = sic_purge(mesfile,2)
  ml = lenc(mesfile)
  if (mod(status,2).eq.0) then
    write(*,'(A,A,A)') failure_message,'Error purging message file ',mesfile(1:ml)
    error = .true.
    return
  endif
  !
  ! Get lun
  status = sic_getlun(meslun)
  if (status.ne.1) then
    write(*,'(A,A,A)') failure_message,'Error getting LUN for ',mesfile(1:ml)
    error = .true.
    return
  endif
  !
  ! Open file
  if (gag_inquire(mesfile,ml).eq.0 .and. mes_log_append) then
    status = sic_open(meslun,mesfile,'APPEND',.false.)
  else
    status = sic_open(meslun,mesfile,'NEW',.false.)
  endif
  if (status.ne.0) then
    write(*,'(A,A,A)') failure_message,'Error opening message file ',mesfile(1:ml)
    call putios(failure_message,status)
    error = .true.
    return
  endif
  !
end subroutine gmessage_open
!
subroutine gmessage_flush(error)
  use gbl_message
  use gbl_message_private
  use gsys_interfaces, except_this=>gmessage_flush
  !---------------------------------------------------------------------
  ! @private
  ! Closes message file and reset its logical unit for a clean handling
  ! of very last messages.
  !---------------------------------------------------------------------
  logical, intent(inout) :: error    ! Error flag
  ! Local
  character(len=*), parameter :: rname='MESSAGE_FLUSH'
  integer(kind=4) :: status
  !
  if (meslun.eq.0) return
  !
  status = sic_flush(meslun)
  if (status.ne.0) then
    error = .true.
    call gsys_message(seve%e,rname,'Error flushing message file '//  &
       'buffer onto disk')
    return
  endif
  !
end subroutine gmessage_flush
!
subroutine gmessage_close(error)
  use gbl_message
  use gbl_message_private
  use gsys_interfaces, except_this=>gmessage_close
  !---------------------------------------------------------------------
  ! @ public
  ! Closes message file and reset its logical unit for a clean handling
  ! of very last messages. Do not produce an error if no message file
  ! is opened.
  !---------------------------------------------------------------------
  logical, intent(inout) :: error    ! Error flag
  ! Local
  character(len=*), parameter :: rname='MESSAGE_CLOSE'
  integer(kind=4) :: status
  character(len=18) :: failure_message='E-MESSAGE_CLOSE,  '
  !
  if (meslun.eq.0) return
  !
  call gsys_message(seve%t,rname,'Closing message file. Bye.')
  !
  ! Close file
  status = sic_close(meslun)
  if (status.ne.0) then
    write(*,'(A,A)') failure_message,'Error closing message file'
    error = .true.
    return
  endif
  !
  ! Free lun
  status = gag_frelun(meslun)
  if (status.ne.1) then
    write(*,'(A,A)') failure_message,'Error freeing LUN for message file'
    error = .true.
    return
  endif
  !
  ! Success, reset meslun
  meslun=0
  !
  call gsys_message(seve%d,rname,'Successfully closed message file')
  !
end subroutine gmessage_close
!
subroutine gmessage_write(id,mkind,procname,message)
  use gsys_interfaces, except_this=>gmessage_write
  use gpack_def
  use gbl_message
  use gbl_message_private
  use gbl_ansicodes
  !---------------------------------------------------------------------
  ! @ public
  ! Output procname and message, with severity kind "mkind", according
  ! to current messaging filters of input package.
  !  - input id is the identifier given to the package when it
  !    registered, or the one from another package if current package
  !    wants to appear as an other into the message file (e.g. 'gio'
  !    messages appear as 'sic' messages in message file).
  !  - mkind is an integer which should be set with the severity
  !    structure provided by gbl_message module.
  !  Although this routine is public, you should call it only once (with
  !  the 4 arguments) in your <packname>-message routine, and then call
  !  everywhere in your package your <packname>-message routine with
  !  3 arguments. Your package id should be known only in the
  ! <packname>-message routine.
  !---------------------------------------------------------------------
  integer(kind=4),  intent(in) :: id        ! Package id
  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
  character(len=*), parameter :: rname='GMESSAGE'
  logical :: error
  character(len=gpack_name_length) :: packname
  character(len=message_length) :: string_s  ! To screen
  character(len=30) :: prefix                ! e.g. "I-SIC,  "
  character(len=32) :: procname_u            ! Upcased. Length should be a parameter...
  character(len=20) :: datetime = ' '        !
  integer(kind=4) :: ckind,cid               ! Corrected kind and id
  integer(kind=4) :: nl                      ! Character lengths
  !
  ! Check input kind
  ckind = mkind
  if ( mkind.lt.1 .or. mkind.gt.nseve ) then
     write (string_s, *) 'Unknown message kind ',mkind
     call gsys_message(seve%w,rname,string_s)
     ckind = seve%u  ! Keep going on with kind "Unknown"
  endif
  !
  ! Check input id?
  cid = id
  !
  ! Check which filter applies: global or private?
  if (mes_gbl_rules) cid = gpack_global_id
  !
  ! Do nothing if verbosities are disabled by filters. Must be called ASAP
  if ( gmessage_isoff(cid,ckind) ) return
  !
  ! Find packname(id) (not cid) in mesfile, because even if we use
  ! global rules, we do not want 'global' to appear in mesfile:
  error = .false.
  call gpack_get_name(id,packname,error)
  if (error) then
     cid = gpack_global_id
     packname = gpack_global_name
  endif
  nl = max(7,lenc(packname))  ! 7 at least for a better alignment in mesfile
  !
  ! Format prefix
  if (mes_gbl_rules .and. id.ne.gpack_global_id) then
    !  In debug mode, add the package name to the subroutine prefix (debug
    ! mode uses global filtering rules)
    !  No point adding the "GLOBAL>" prefix, for messages owned by no
    ! declared package (this happens if libraries have no message owner,
    ! e.g. when executing tasks)
    procname_u = trim(packname)//'>'//procname
    call sic_upper(procname_u)
  else
    procname_u = procname
    call sic_upper(procname_u)
  endif
  prefix = seve_levels(ckind)//'-'//trim(procname_u)//','
  !
  ! To screen
  if ( message_rules(cid)%toscreen(ckind) ) then
    if (mes_gbl_colors.and.message_colors%enabled(ckind)) then
      if (ckind.eq.seve%r) then  ! Without prefix
        write(*,'(A,A,A)')  &
          message_colors%code(ckind)(1:message_colors%lcode(ckind)),  &
          trim(message),  &
          c_clear
      else                       ! With prefix
        write(*,'(A,A,2X,A,A)')  &
          message_colors%code(ckind)(1:message_colors%lcode(ckind)),  &
          trim(prefix),  &
          trim(message),  &
          c_clear
      endif
    else
      if (ckind.eq.seve%r) then  ! Without prefix
        write(*,'(A)') trim(message)
      else                       ! With prefix
        write(*,'(A,2X,A)') trim(prefix), trim(message)
      endif
    endif
  endif
  !
  ! To file ("meslun.ne.0" is useful at init time)
  if ( message_rules(cid)%tofile(ckind) .and. meslun.ne.0 ) then
    !
    ! Optionally add date
    if (mes_log_date) call sic_date(datetime)
    !
    write(meslun,'(A,1X,A,A,2X,A)')  &
      trim(datetime), packname(1:nl)//': ', trim(prefix), trim(message)
    !
  endif
  !
end subroutine gmessage_write
!
subroutine gmessage_write_in_mesfile(id,mkind,procname,message)
  use gsys_interfaces, except_this=>gmessage_write_in_mesfile
  use gpack_def
  use gbl_message
  use gbl_message_private
  !---------------------------------------------------------------------
  ! @ public TEMPORARY FOR CLIC ONLY (SB, 02-jun-2008)
  ! Rewrite of gmessage_write. It writes to mesfile only and ignores
  ! filters.
  !---------------------------------------------------------------------
  ! Output procname and message, with severity kind "mkind", according
  ! to current messaging filters of input package.
  !  - input id is the identifier given to the package when it
  !    registered, or the one from another package if current package
  !    wants to appear as an other into the message file (e.g. 'gio'
  !    messages appear as 'sic' messages in message file).
  !  - mkind is an integer which should be set with the severity
  !    structure provided by gbl_message module.
  !  Although this routine is public, you should call it only once (with
  !  the 4 arguments) in your <packname>-message routine, and then call
  !  everywhere in your package your <packname>-message routine with
  !  3 arguments. Your package id should be known only in the
  ! <packname>-message routine.
  !---------------------------------------------------------------------
  integer(kind=4),  intent(in) :: id        ! Package id
  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
  logical :: error
  character(len=gpack_name_length) :: packname
  character(len=30) :: prefix                ! e.g. "I-SIC,  "
  character(len=25) :: procname_u            ! Upcased. Length should be a parameter...
  character(len=20) :: datetime = ' '        !
  integer(kind=4) :: ckind,cid               ! Corrected kind and id
  integer(kind=4) :: nl                      ! Character lengths
  !
  ! Check input kind
  ckind = mkind
  if ( mkind.lt.1 .or. mkind.gt.nseve ) then
     ckind = seve%u  ! Keep going on with kind "Unknown"
  endif
  !
  ! Check input id?
  cid = id
  !
  ! Check which filter applies: global or private?
  if (mes_gbl_rules) cid = gpack_global_id
  !
  ! Do nothing if verbosities are disabled by filters. Must be called ASAP
  ! if ( gmessage_isoff(cid,ckind) ) return
  if ( .not.message_rules(cid)%tofile(ckind) ) return
  !
  ! Find packname(id) (not cid) in mesfile, because even if we use
  ! global rules, we do not want 'global' to appear in mesfile:
  error = .false.
  call gpack_get_name(id,packname,error)
  if (error) then
     cid = gpack_global_id
     packname = gpack_global_name
  endif
  nl = max(7,lenc(packname))
  !
  ! Format prefix
  procname_u = procname
  call sic_upper(procname_u)
  prefix = seve_levels(ckind)//'-'//trim(procname_u)//','
  !
  ! To file ("meslun.ne.0" is useful at init time)
  if (meslun.ne.0 ) then
    !
    ! Optionally add date
    if (mes_log_date) call sic_date(datetime)
    !
    write(meslun,'(A,1X,A,A,2X,A)')  &
      trim(datetime), packname(1:nl)//': ', trim(prefix), trim(message)
    !
  endif
  !
end subroutine gmessage_write_in_mesfile
!
subroutine gag_message(mkind,procname,message)
  use gsys_interfaces, except_this=>gag_message
  use gpack_def
  !---------------------------------------------------------------------
  ! @ public (obsolete)
  ! Outputs procname and message, with severity kind "mkind", according
  ! to current GLOBAL messaging filters. mkind is an integer which
  ! should be set with the severity structure provided by gbl_message
  ! module.
  !---------------------------------------------------------------------
  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(gpack_global_id,mkind,procname,message)
  !
end subroutine gag_message
!
function gmessage_isoff(id,mkind)
  use gbl_message_private
  !---------------------------------------------------------------------
  ! @ private
  ! Checks if the message sent to gmessage_write is intended to be
  ! printed to at least one of the outputs (screen or message file).
  ! Should be used if you want to skip string formatting (for example)
  ! in order to save CPU time.
  !---------------------------------------------------------------------
  logical :: gmessage_isoff
  integer(kind=4), intent(in) :: id     ! Package id
  integer(kind=4), intent(in) :: mkind  ! Message kind
  !
  ! id and mkind are corrected before calling gmessage_isoff. No
  ! duplicate checks in order to save time.
  gmessage_isoff = .not.( message_rules(id)%toscreen(mkind) .or. &
                          message_rules(id)%tofile(mkind) )
  !
end function gmessage_isoff
!
subroutine gmessage_use_gbl_rules(flag)
  use gsys_interfaces, except_this=>gmessage_use_gbl_rules
  use gbl_message_private
  !---------------------------------------------------------------------
  ! @ public
  ! Activates or deactivates use of global messaging filters instead of
  ! local (per package) ones.
  !---------------------------------------------------------------------
  logical, intent(in) :: flag  ! Activate if .true.
  !
  if (flag .and. .not.mes_gbl_rules) then
     call gsys_message(seve%d,"GMESSAGE","Turned ON global filtering rules")
  elseif (.not.flag .and. mes_gbl_rules) then
     call gsys_message(seve%d,"GMESSAGE","Turned OFF global filtering rules")
  endif
  !
  mes_gbl_rules = flag
  !
end subroutine gmessage_use_gbl_rules
!
subroutine gmessage_log_date(flag)
  use gsys_interfaces, except_this=>gmessage_log_date
  use gbl_message_private
  !---------------------------------------------------------------------
  ! @ public
  ! Activates or deactivates printing date-time in message file.
  !---------------------------------------------------------------------
  logical, intent(in) :: flag  ! Activate if .true.
  !
  if (flag .and. .not.mes_log_date) then
     call gsys_message(seve%d,"GMESSAGE","Turned ON printing date-time in logfile")
  elseif (.not.flag .and. mes_log_date) then
     call gsys_message(seve%d,"GMESSAGE","Turned OFF printing date-time in logfile")
  endif
  !
  mes_log_date = flag
  !
end subroutine gmessage_log_date
!
subroutine gmessage_gbl_filters_on(rule)
  use gsys_interfaces, except_this=>gmessage_gbl_filters_on
  use gbl_message_private
  !---------------------------------------------------------------------
  ! @ private
  ! Set Global filters and activate its use.
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rule  ! Optional rule to alter filters
  ! Local
  logical :: error
  !
  if (rule.ne.' ') then
     error = .false.
     call gmessage_parse_and_set(gpack_global_id,rule,error)
  endif
  !
  mes_gbl_rules = .true.
  !
end subroutine gmessage_gbl_filters_on
!
subroutine gmessage_gbl_filters_off
  use gbl_message_private
  !---------------------------------------------------------------------
  ! @ private
  ! Deactivate use of Global filters
  !---------------------------------------------------------------------
  !
  mes_gbl_rules = .false.
  !
end subroutine gmessage_gbl_filters_off
!
subroutine gmessage_quiet
  use gsys_interfaces, except_this=>gmessage_quiet
  !---------------------------------------------------------------------
  ! @ public
  ! Ensure almost-quiet messaging mode to Screen.
  ! This is done by setting Global onscreen filter to FE------, and
  ! using Global filters.
  !---------------------------------------------------------------------
  !
  call gmessage_gbl_filters_on('s=fe')
  !
end subroutine gmessage_quiet
!
subroutine gmessage_standard
  use gsys_interfaces, except_this=>gmessage_standard
  !---------------------------------------------------------------------
  ! @ public
  ! Restore normal verbosity.
  ! This is done by stopping using Global filters.
  !---------------------------------------------------------------------
  !
  call gmessage_gbl_filters_off()
  !
end subroutine gmessage_standard
!
subroutine gmessage_verbose
  use gsys_interfaces, except_this=>gmessage_verbose
  use gbl_message_private
  !---------------------------------------------------------------------
  ! @ public
  ! Provide a maximal verbose messaging mode for Screen and Message
  ! file.
  ! This is done by turning on all the kind of messages, to both Screen
  ! and Message file.
  !---------------------------------------------------------------------
  !
  call gmessage_gbl_filters_on('a='//seve_allflags)
  !
end subroutine gmessage_verbose
!
#if defined(CYGWIN) || defined(MINGW)
! trick to deal between Windows and Cygwin in win-gsys.def
subroutine gbl_message_mp_seve
end subroutine gbl_message_mp_seve
#endif
!
subroutine gmessage_debug_swap
  use gsys_interfaces, except_this=>gmessage_debug_swap
  use gbl_message
  use gbl_message_private
  !---------------------------------------------------------------------
  ! @ public
  ! Provide a maximal verbose messaging mode for Screen and Message
  ! file.
  ! This is done by turning on all the kind of messages, to both Screen
  ! and Message file.
  !---------------------------------------------------------------------
  ! Local
  character(len=*), parameter :: rname='MESSAGE'
  !
  mes_use_debug = .not.mes_use_debug
  if (mes_use_debug) then
    call gsys_message(seve%r,rname,"Turning ON messages debug mode")
    call gmessage_verbose
  else
    call gsys_message(seve%r,rname,"Turning OFF messages debug mode")
    call gmessage_standard
  endif
  !
end subroutine gmessage_debug_swap
!
subroutine gmessage_print_colors(error)
  use gbl_message_private
  !---------------------------------------------------------------------
  ! @ public
  ! Show the current status of message colors
  !---------------------------------------------------------------------
  logical, intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='SIC MESSAGE'
  integer(kind=4) :: iseve,icolor
  !
  if (mes_gbl_colors) then
    do iseve=1,nseve
      if (message_colors%enabled(iseve)) then
        write(*,'(2X,A1,A,A)')  seve_levels(iseve),  &
                                ' messages coloring is active using ',  &
                                message_colors%name(iseve)
      else
        write(*,'(2X,A1,A,A)')  seve_levels(iseve),  &
                                ' messages coloring is inactive'
      endif
    enddo
  else
    call gsys_message(seve%i,rname,'Coloring is disabled for all messages')
  endif
  !
  call gsys_message(seve%r,rname,'')
  call gsys_message(seve%i,rname,'Possible colors are:')
  do icolor=1,ncolors
    write(*,'(2X,A,T10,4A)')  colors%name(icolor),': ',            &
                              trim(colors%code(icolor)),           &
                              'abcd efgh ijkl mnop qrst uvwx yz',  &
                              c_clear
  enddo
  !
end subroutine gmessage_print_colors
!
subroutine gmessage_colors_swap(flag)
  use gbl_message_private
  !---------------------------------------------------------------------
  ! @ public
  ! Enable or disable the message coloring
  !---------------------------------------------------------------------
  logical, intent(in) :: flag
  mes_gbl_colors = flag
end subroutine gmessage_colors_swap
!
subroutine gmessage_colors_parse(argum,error)
  use gbl_message_private
  !---------------------------------------------------------------------
  ! @ public
  ! Parse argument for changing a message kind color
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: argum
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='SIC MESSAGE'
  integer(kind=4) :: iseve,kseve,ikey
  character(len=7) :: key
  logical :: found
  !
  found = .false.
  do iseve=1,nseve
    if (argum(1:1).eq.seve_levels(iseve)) then
      found = .true.
      kseve = iseve
    endif
  enddo
  if (.not.found)  goto 10
  !
  if (argum(2:2).ne.'=')  goto 10
  !
  call sic_ambigs(rname,argum(3:),key,ikey,colors%name,ncolors,error)
  if (error)  return
  !
  message_colors%enabled(kseve) = key.ne.'NONE'
  message_colors%name(kseve)    = key
  message_colors%code(kseve)    = colors%code(ikey)
  message_colors%lcode(kseve)   = len_trim(colors%code(ikey))
  !
  return  ! Success
  !
10 continue
  call gsys_message(seve%e,rname,'Malformed argument '//argum)
  error = .true.
  return
  !
end subroutine gmessage_colors_parse
