!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_flag_types
  use gkernel_interfaces
  use gmath_dicho_types
  use cubetools_parameters
  use cubelist_types
  use cubeheader_messaging
  !---------------------------------------------------------------------
  ! Support module for flags and list of flags
  !---------------------------------------------------------------------
  !
  ! Flag related symbols
  public :: flag_t
  public :: flag_k,dag_flagl
  public :: code_flag_technical,code_flag_action,code_flag_product,code_flag_user
  public :: flag_unknown
  public :: cubetools_flag_ptr,cubetools_flag_init,cubetools_flag_register_user
  public :: operator(.eq.),operator(.ne.)
  ! Flaglist related symbols
  public :: flag_list_t
  public :: cubetools_flaglist_sort
  public :: cubetools_flaglist_tostr,cubetools_flaglist_list_all,cubetools_flag_debug
  public :: cubetools_string_toflaglist
  private
  !
  ! Kinds
  integer(kind=code_k), parameter :: nkinds = 4
  character(len=*), parameter :: kinds(nkinds) = ['technic','action ','product','user   ']
  integer(kind=code_k), parameter :: code_flag_technical = 1
  integer(kind=code_k), parameter :: code_flag_action    = 2
  integer(kind=code_k), parameter :: code_flag_product   = 3
  integer(kind=code_k), parameter :: code_flag_user      = 4
  !
  integer(kind=4), parameter :: flag_k=list_k
  integer(kind=4), parameter :: dag_flagl=24
  character(len=1), parameter :: flagsep_strg=','
  integer(kind=4), parameter :: dag_mflags=10   ! [integer] Maximum number of flags associated to a node
  !
  type, extends(list_object_t) :: flag_t
     character(len=dag_flagl), private :: name
     character(len=dag_flagl), private :: key
     integer(kind=code_k),     private :: kind
     integer(kind=flag_k),     private :: id
   contains
     procedure, public :: register   => cubetools_flag_register_program  ! For program-defined flags only
     procedure, public :: list       => cubetools_flag_list
     procedure, public :: get_id     => cubetools_flag_get_id
     procedure, public :: get_name   => cubetools_flag_get_name
     procedure, public :: get_key    => cubetools_flag_get_key
     procedure, public :: get_kind   => cubetools_flag_get_kind
     procedure, public :: get_suffix => cubetools_flag_get_suffix
     procedure, public :: final      => cubetools_flag_final
  end type flag_t
  !
  interface operator(.eq.)  ! Offers syntax e.g. "myflag.eq.flag_any" to programmers
    module procedure cubetools_flag_eq
  end interface
  !
  interface operator(.ne.)  ! Offers syntax e.g. "myflag.ne.flag_any" to programmers
    module procedure cubetools_flag_ne
  end interface
  !
  ! One technical flag
  type(flag_t), target :: flag_unknown
  !
  type, extends(list_t) :: flag_list_t
  contains
    procedure, private :: insert   => cubetools_flaglist_insert
    procedure, public  :: create   => cubetools_flaglist_create
    procedure, public  :: remove   => cubetools_flaglist_remove
    procedure, public  :: prepend  => cubetools_flaglist_prepend
    procedure, public  :: append   => cubetools_flaglist_append
    procedure, public  :: contains => cubetools_flaglist_contains
    procedure, public  :: repr     => cubetools_flaglist_repr
    procedure, public  :: write    => cubetools_flaglist_write
    procedure, public  :: read     => cubetools_flaglist_read
    procedure, public  :: export   => cubetools_flaglist_export
  end type flag_list_t
  !
  ! Type for searching the global flag list
  type, extends(gi8_dicho_t) :: flag_list_dicho_t
    character(len=dag_flagl) :: searched_name = ''
  contains
    procedure, public :: compare       => flag_list_compare
    procedure, public :: compare_value => flag_list_compare_value
  end type flag_list_dicho_t
  !
  integer(kind=4), parameter :: key_l=24  ! Note the T26 tab below
  character(len=*), parameter :: form_na ='(A,T26,I11,(20(1X,A)))'  ! String array
  character(len=*), parameter :: form_nac='(A,T26,I11,A)'           ! String array (decoding)
  !
  ! The global list of flags
  type(list_t) :: flag_list
  integer(kind=flag_k), allocatable :: flag_list_sort(:)
  !
contains
  !
  !---------------------------------------------------------------------
  ! Support for scalar flags
  !---------------------------------------------------------------------
  !
  subroutine cubetools_flag_init(error)
    !-------------------------------------------------------------------
    ! Register the technical flags
    !-------------------------------------------------------------------
    logical, intent(inout) :: error
    !
    call flag_unknown%register('unknown',code_flag_technical,error)
    if (error) return
    !
    call cubetools_flaglist_sort(error)  ! Compute the sorting array
    if (error)  return
  end subroutine cubetools_flag_init
  !
  subroutine cubetools_flag_list(flag,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(flag_t), target, intent(inout) :: flag
    logical,               intent(inout) :: error
    !
    character(mess_l) :: mess
    !
    write(mess,'(2x,a,i4,2x,3(2a,2x))')  &
      'id=',  flag%id, &
      'name=',flag%name, &
      'key=', flag%key, &
      'kind=',kinds(flag%kind)
    call cubeheader_message(seve%r,'FLAG>LIST',mess)
  end subroutine cubetools_flag_list
  !
  function cubetools_flag_get_id(flag) result(id)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(flag_t), intent(in) :: flag
    integer(kind=flag_k)      :: id
    !
    id = flag%id
  end function cubetools_flag_get_id
  !
  function cubetools_flag_get_name(flag) result(name)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(flag_t), intent(in) :: flag
    character(len=dag_flagl)  :: name
    !
    name = flag%name
  end function cubetools_flag_get_name
  !
  function cubetools_flag_get_key(flag) result(key)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(flag_t), intent(in) :: flag
    character(len=dag_flagl)  :: key
    !
    key = flag%key
  end function cubetools_flag_get_key
  !
  function cubetools_flag_get_kind(flag) result(kind)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(flag_t), intent(in) :: flag
    integer(kind=code_k)      :: kind
    !
    kind = flag%kind
  end function cubetools_flag_get_kind
  !
  function cubetools_flag_get_suffix(flag) result(suffix)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(flag_t), intent(in)  :: flag
    character(len=dag_flagl+1) :: suffix
    !
    suffix = '-'//flag%name
  end function cubetools_flag_get_suffix
  !
  function cubetools_flag_eq(flag1,flag2)
    logical :: cubetools_flag_eq
    type(flag_t), intent(in) :: flag1,flag2
    cubetools_flag_eq = flag1%id.eq.flag2%id
  end function cubetools_flag_eq
  !
  function cubetools_flag_ne(flag1,flag2)
    logical :: cubetools_flag_ne
    type(flag_t), intent(in) :: flag1,flag2
    cubetools_flag_ne = flag1%id.ne.flag2%id
  end function cubetools_flag_ne
  !
  function cubetools_flag_ptr(tot,error)
    !-------------------------------------------------------------------
    ! Check if the input class is of type(flag_t), and return a
    ! pointer to it if relevant.
    !-------------------------------------------------------------------
    type(flag_t), pointer :: cubetools_flag_ptr
    class(list_object_t), pointer       :: tot
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='FLAG>PTR'
    !
    select type(tot)
    type is (flag_t)
      cubetools_flag_ptr => tot
    class default
      cubetools_flag_ptr => null()
      call cubeheader_message(seve%e,rname,  &
        'Internal error: object is not a flag_t type')
      error = .true.
      return
    end select
  end function cubetools_flag_ptr
  !
  function flag_list_compare(self,m,l)
    !-------------------------------------------------------------------
    ! Compare the names of the m-th and l-th flags
    !-------------------------------------------------------------------
    integer(kind=4) :: flag_list_compare
    class(flag_list_dicho_t), intent(in) :: self
    integer(kind=flag_k),     intent(in) :: m,l
    ! Local
    logical :: error
    type(flag_t), pointer :: flagm,flagl
    !
    flag_list_compare = 0
    error = .false.
    flagm => cubetools_flag_ptr(flag_list%list(m)%p,error)
    if (error)  return
    flagl => cubetools_flag_ptr(flag_list%list(l)%p,error)
    if (error)  return
    if (flagm%name.eq.flagl%name) then
      flag_list_compare = 0
    elseif (flag_name_gt(flagm%name,flagl%name)) then
      flag_list_compare = 1
    else
      flag_list_compare = -1
    endif
  end function flag_list_compare
  !
  function flag_list_compare_value(self,m)
    !-------------------------------------------------------------------
    ! Compare the name of the m-th flag to the searched name
    !-------------------------------------------------------------------
    integer(kind=4) :: flag_list_compare_value
    class(flag_list_dicho_t), intent(in) :: self
    integer(kind=flag_k),     intent(in) :: m
    ! Local
    logical :: error
    type(flag_t), pointer :: flag
    !
    flag_list_compare_value = 0
    error = .false.
    flag => cubetools_flag_ptr(flag_list%list(m)%p,error)
    if (error)  return
    if (flag%name.eq.self%searched_name) then
      flag_list_compare_value = 0
    elseif (flag_name_gt(flag%name,self%searched_name)) then
      flag_list_compare_value = 1
    else
      flag_list_compare_value = -1
    endif
  end function flag_list_compare_value
  !
  subroutine cubetools_flag_name2flag(name,found,flag)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Resolve the flag given its name. Raising an error or not is the
    ! responsibility of the caller.
    !-------------------------------------------------------------------
    character(len=*), intent(in)  :: name
    logical,          intent(out) :: found
    type(flag_t),     intent(out) :: flag
    ! Local
    character(len=dag_flagl) :: lname
    integer(kind=flag_k) :: iflag
    type(flag_t), pointer :: lflag
    logical :: error
    type(flag_list_dicho_t) :: dicho
    !
    lname = name
    call sic_lower(lname)
    found = .false.
    flag = flag_unknown
    !
    dicho%searched_name = lname
    call dicho%dicho(flag_list_sort,flag_list%n,.true.,iflag)
    if (iflag.eq.0)  return  ! Name not found
    ! In return jflag is the flag lower or equal to the request
    ! in the sorted array (flag_list_sort)
    !
    error = .false.
    lflag => cubetools_flag_ptr(flag_list%list(flag_list_sort(iflag))%p,error)
    if (error)  return
    if (lflag%name.eq.lname) then
      found = .true.
      flag = lflag
    endif
    !
  end subroutine cubetools_flag_name2flag
  !
  function flag_name_gt(name1,name2)
    !-------------------------------------------------------------------
    ! Compare 2 flag names, i.e. if name1 > name2
    ! Typically used for lexicographical sorting
    !-------------------------------------------------------------------
    logical :: flag_name_gt
    character(len=*), intent(in) :: name1
    character(len=*), intent(in) :: name2
    ! Local
    integer(kind=4) :: len1,len2
    !
    if (isnumeric(name1(1:1)) .and. isnumeric(name2(1:1))) then
      ! Compare numerics as character strings, ensuring "2" < "10".
      ! NB: this won't work if mixing numerics and letters e.g. "123ABC",
      ! but what do we want in this case?
      len1 = len_trim(name1)
      len2 = len_trim(name2)
      if (len1.gt.len2) then
        flag_name_gt = .true.
      elseif (len1.lt.len2) then
        flag_name_gt = .false.
      else
        flag_name_gt = lgt(name1,name2)
      endif
    else
      flag_name_gt = lgt(name1,name2)
    endif
  end function flag_name_gt
  !
  function flag_name_lt(name1,name2)
    !-------------------------------------------------------------------
    ! Compare 2 flag names, i.e. if name1 < name2
    ! Typically used for lexicographical sorting
    !-------------------------------------------------------------------
    logical :: flag_name_lt
    character(len=*), intent(in) :: name1
    character(len=*), intent(in) :: name2
    ! Local
    integer(kind=4) :: len1,len2
    !
    if (isnumeric(name1(1:1)) .and. isnumeric(name2(1:1))) then
      ! Compare numerics as character strings, ensuring "2" < "10".
      ! NB: this won't work if mixing numerics and letters e.g. "123ABC",
      ! but what do we want in this case?
      len1 = len_trim(name1)
      len2 = len_trim(name2)
      if (len1.gt.len2) then
        flag_name_lt = .false.
      elseif (len1.lt.len2) then
        flag_name_lt = .true.
      else
        flag_name_lt = llt(name1,name2)
      endif
    else
      flag_name_lt = llt(name1,name2)
    endif
  end function flag_name_lt
  !
  function flag_name_ge(name1,name2)
    !-------------------------------------------------------------------
    ! Compare 2 flag names, i.e. if name1 >= name2
    ! Typically used for lexicographical sorting
    !-------------------------------------------------------------------
    logical :: flag_name_ge
    character(len=*), intent(in) :: name1
    character(len=*), intent(in) :: name2
    !
    flag_name_ge = .not.flag_name_lt(name1,name2)
  end function flag_name_ge
  !
  function isnumeric(c1)
    !-------------------------------------------------------------------
    ! Return .true. if the given character is an ASCII character in the
    ! range [0-9]
    !-------------------------------------------------------------------
    logical :: isnumeric
    character(len=1), intent(in) :: c1
    ! Local
    integer(kind=4) :: ichara
    !
    ichara = ichar(c1)-ichar('0')
    isnumeric = ichara.ge.0 .and. ichara.le.9
  end function isnumeric
  !
  subroutine cubetools_flag_final(obj,error)
    !-------------------------------------------------------------------
    !-------------------------------------------------------------------
    class(flag_t), intent(inout) :: obj
    logical,       intent(inout) :: error
    !
  end subroutine cubetools_flag_final
  !
  !---------------------------------------------------------------------
  ! Support for list of flags
  !---------------------------------------------------------------------
  !
  subroutine cubetools_flag_register_program(flag,name,kind,error)
    !----------------------------------------------------------------------
    ! Register a program-defined flag in the global flag list
    !----------------------------------------------------------------------
    class(flag_t), target, intent(inout) :: flag
    character(len=*),      intent(in)    :: name
    integer(kind=code_k),  intent(in)    :: kind
    logical,               intent(inout) :: error
    !
    call cubetools_flag_register(flag,name,kind,error)
    if (error)  return
    ! Sorting is done once by caller
  end subroutine cubetools_flag_register_program
  !
  subroutine cubetools_flag_register_user(name,error)
    !----------------------------------------------------------------------
    ! Create and register a user-defined flag in the global flag list
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: name
    logical,          intent(inout) :: error
    !
    type(flag_t) :: otherflag
    logical :: found
    type(flag_t), pointer :: flag
    character(len=*), parameter :: rname='FLAG>REGISTER>USER'
    !
    ! Sanity (only checked for user inputs)
    if (len_trim(name).gt.dag_flagl) then
      call cubeheader_message(seve%e,rname,'Flag name is too long')
      error = .true.
      return
    endif
    call cubetools_flag_name2flag(name,found,otherflag)
    if (found) then
      call cubeheader_message(seve%w,rname,'Flag named '''//trim(name)//''' already exists')
      return
    endif
    !
    allocate(flag)
    call cubetools_flag_register(flag,name,code_flag_user,error)
    if (error) then
      deallocate(flag)
      return
    endif
    call cubetools_flaglist_sort(error)  ! Compute the sorting array
    if (error)  return
  end subroutine cubetools_flag_register_user
  !
  subroutine cubetools_flag_register(flag,name,kind,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Register a flag in the global flag list
    !----------------------------------------------------------------------
    class(flag_t), target, intent(inout) :: flag
    character(len=*),      intent(in)    :: name
    integer(kind=code_k),  intent(in)    :: kind
    logical,               intent(inout) :: error
    !
    ! Attributes
    flag%name = name
    call sic_lower(flag%name)
    flag%key = name
    call sic_upper(flag%key)
    flag%kind = kind
    flag%id = flag_list%n+1
    !
    ! Insert in global flag list
    call flag_list%associate(flag,error)
    if (error)  return
  end subroutine cubetools_flag_register
  !
  subroutine cubetools_flaglist_insert(list,flags,start,error)
    !-------------------------------------------------------------------
    ! Copy an array of flag_t to a tools_list_t, starting at given
    ! position.
    ! This subroutine DOES NOT CARE for list allocation or list%n.
    ! Because of this, it should not be used out of this module.
    !-------------------------------------------------------------------
    class(flag_list_t),   intent(inout) :: list
    type(flag_t),         intent(in)    :: flags(:)
    integer(kind=flag_k), intent(in)    :: start
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='FLAGLIST>INSERT'
    integer(kind=flag_k) :: iflag,oflag
    type(flag_t), pointer :: flag
    type(flag_t) :: template
    !
    do iflag=1,size(flags)
      oflag = start+iflag-1  ! Position in list
      call list%list(oflag)%allocate(template,error)
      if (error)  return
      flag => cubetools_flag_ptr(list%list(oflag)%p,error)
      if (error)  return
      flag = flags(iflag)
    enddo
  end subroutine cubetools_flaglist_insert
  !
  subroutine cubetools_flaglist_create(list,flags,error)
    !-------------------------------------------------------------------
    ! Create a tools_list_t of flag_t from an array of flag_t
    ! This creates copies of the flags. The list MUST be cleaned with
    ! the list%free() method.
    !-------------------------------------------------------------------
    class(flag_list_t), intent(inout) :: list
    type(flag_t),       intent(in)    :: flags(:)
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='FLAGLIST>CREATE'
    integer(kind=flag_k) :: nflag
    !
    nflag = size(flags)
    call list%reallocate(nflag,error)
    if (error)  return
    !
    call list%insert(flags,1_flag_k,error)
    if (error)  return
    !
    list%n = nflag
  end subroutine cubetools_flaglist_create
  !
  subroutine cubetools_flaglist_remove(list,flags,error)
    !-------------------------------------------------------------------
    ! Free and pop the matching flags from a flag_list_t
    !-------------------------------------------------------------------
    class(flag_list_t), intent(inout) :: list
    type(flag_t),       intent(in)    :: flags(:)
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='FLAGLIST>REMOVE'
    integer(kind=flag_k) :: iflag,jflag
    type(flag_t), pointer :: flag
    !
    ! Start from the end because list%pop() compresses the list from the
    ! right and changes list%n
    iflag = list%n
    do while (iflag.ge.1)
      flag => cubetools_flag_ptr(list%list(iflag)%p,error)
      if (error)  return
      do jflag=1,size(flags)  ! This is a N^2 loop... on small numbers (<10 or so).
        if (flag.eq.flags(jflag)) then
          call list%pop(iflag,error)
          if (error)  return
          exit  ! Matched and removed from the list, go to next iflag in the list
        endif
      enddo
      iflag = iflag-1
    enddo
  end subroutine cubetools_flaglist_remove
  !
  subroutine cubetools_flaglist_prepend(list,flags,error)
    !-------------------------------------------------------------------
    ! Prepend a list of flags to a flag_list_t. Note that duplicates
    ! are allowed.
    !-------------------------------------------------------------------
    class(flag_list_t), intent(inout) :: list
    type(flag_t),       intent(in)    :: flags(:)
    logical,            intent(inout) :: error
    !
    ! Enlarge list to the left
    call list%enlarge(size(flags,kind=flag_k),1_flag_k,error)
    if (error)  return
    !
    ! Insert new ones in front
    call list%insert(flags,1_flag_k,error)
    if (error)  return
    !
    ! Finally update the size
    list%n = list%n+size(flags)
  end subroutine cubetools_flaglist_prepend
  !
  subroutine cubetools_flaglist_append(list,flags,error)
    !-------------------------------------------------------------------
    ! Append a list of flags to a flag_list_t. Note that duplicates are
    ! allowed.
    !-------------------------------------------------------------------
    class(flag_list_t), intent(inout) :: list
    type(flag_t),       intent(in)    :: flags(:)
    logical,            intent(inout) :: error
    !
    ! Enlarge list to the right
    call list%enlarge(size(flags,kind=flag_k),list%n+1,error)
    if (error)  return
    !
    ! Insert new ones to the end
    call list%insert(flags,list%n+1,error)
    if (error)  return
    !
    ! Finally update the size
    list%n = list%n+size(flags)
  end subroutine cubetools_flaglist_append
  !
  function cubetools_flaglist_contains(list,flag)
    !-------------------------------------------------------------------
    ! Return .true. if the flag_list_t contains the named flag.
    !-------------------------------------------------------------------
    logical :: cubetools_flaglist_contains
    class(flag_list_t), intent(in) :: list
    type(flag_t),       intent(in) :: flag
    ! Local
    logical :: error
    integer(kind=4) :: iflag
    type(flag_t), pointer :: pflag
    !
    error = .false.
    cubetools_flaglist_contains = .false.
    do iflag=1,list%n
      pflag => cubetools_flag_ptr(list%list(iflag)%p,error)
      if (error)  return
      if (pflag.eq.flag) then
        cubetools_flaglist_contains = .true.
        return
      endif
    enddo
  end function cubetools_flaglist_contains
  !
  subroutine cubetools_flaglist_tostr(flags,nflag,strflag,lstrflag,error)
    !-------------------------------------------------------------------
    ! Concatenate the flags list into a string.
    ! ---
    ! This version with a flat 'flag_t' array as argument
    !-------------------------------------------------------------------
    type(flag_t),               intent(in)    :: flags(:)
    integer(kind=flag_k),       intent(in)    :: nflag
    character(len=*), optional, intent(out)   :: strflag
    integer(kind=4),  optional, intent(out)   :: lstrflag
    logical,                    intent(inout) :: error
    ! Local
    type(flag_list_t) :: tmp
    !
    call tmp%create(flags(1:nflag),error)
    if (error)  return
    call tmp%repr(strflag=strflag,lstrflag=lstrflag,error=error)
    if (error)  return
    call tmp%final(error)
    if (error)  return
  end subroutine cubetools_flaglist_tostr
  !
  subroutine cubetools_flaglist_repr(list,strflag,lstrflag,error)
    !-------------------------------------------------------------------
    ! Concatenate the flags list into a string. This subroutine can be
    ! used to:
    !   1) concatenate the flags into an output list
    ! AND/OR
    !   2) return the length of the concatenatation
    ! ---
    ! This version with a tools_list_t as argument
    !-------------------------------------------------------------------
    class(flag_list_t),         intent(in)    :: list
    character(len=*), optional, intent(out)   :: strflag
    integer(kind=4),  optional, intent(out)   :: lstrflag
    logical,          optional, intent(inout) :: error
    ! Local
    integer(kind=4) :: iflag,nc,mc
    type(flag_t), pointer :: flag
    !
    if (list%n.le.0) then
      if (present(strflag))   strflag = ''
      if (present(lstrflag))  lstrflag = 0
      return
    endif
    !
    nc = 0
    if (present(strflag)) then
      mc = len(strflag)
    else
      mc = huge(mc)
    endif
    do iflag=1,list%n
      if (nc.gt.0) then
        nc = nc+1
        if (present(strflag)) strflag(nc:nc) = flagsep_strg
      endif
      flag => cubetools_flag_ptr(list%list(iflag)%p,error)
      if (error)  return
      ! ZZZ There used to be a specific support for flag_any
      if (present(strflag)) strflag(nc+1:mc) = flag%name
      nc = nc+len_trim(flag%name)
      if (nc.gt.mc) then
        if (present(strflag)) strflag(mc-1:mc) = '..'
        nc = mc
        exit
      endif
    enddo
    !
    if (present(lstrflag))  lstrflag = nc
    !
  end subroutine cubetools_flaglist_repr
  !
  subroutine cubetools_string_toflaglist(string,allownew,flags,error,sep)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Parse a string (e.g. "flag1,flag2,flag3") into a list of flags
    !----------------------------------------------------------------------
    character(len=*),           intent(in)    :: string
    logical,                    intent(in)    :: allownew  ! Allow creation of new (user-defined) flags?
    type(flag_t), allocatable,  intent(out)   :: flags(:)
    logical,                    intent(inout) :: error
    character(len=*), optional, intent(in)    :: sep       ! Override default separator
    !
    integer(kind=flag_k) :: nflag,iflag
    integer(kind=4) :: ichar,seppos(20),ierr
    character(len=1) :: lsep
    character(len=argu_l) :: oneflag
    character(len=mess_l) :: mess
    logical :: found,lerror
    character(len=*), parameter :: rname='STRING>TOFLAGLIST'
    !
    ! call cubeheader_message(dagseve%trace,rname,'Welcome')
    !
    if (len_trim(string).eq.0) then ! No flags given return
      return
    endif
    !
    if (present(sep)) then
      lsep = sep
    else
      lsep = flagsep_strg
    endif
    !
    nflag = 0
    seppos(:) = -1
    seppos(1) = 0
    do ichar=1,len_trim(string)
      if (string(ichar:ichar).eq.lsep) then
        nflag = nflag+1
        seppos(nflag+1) = ichar
      endif
    enddo
    nflag = nflag+1
    seppos(nflag+1) = len_trim(string)+1
    !
    lerror = .false.
    allocate(flags(nflag),stat=ierr)
    if (failed_allocate(rname,'flags',ierr,error)) return
    do iflag=1,nflag
      oneflag = string(seppos(iflag)+1:seppos(iflag+1)-1)
      if (oneflag.eq.'') then
        write(mess,'(3(a,i0))') 'Flag ',iflag,'/',nflag,' is empty'
        call cubeheader_message(seve%e,rname,mess)
        lerror = .true.
        cycle
      endif
      call cubetools_flag_name2flag(oneflag,found,flags(iflag))
      if (.not.found) then
        if (allownew) then
          call cubetools_flag_register_user(oneflag,error)
          if (error)  return
          call cubetools_flag_name2flag(oneflag,found,flags(iflag))
        else
          write(mess,'(3a)') 'Flag "',trim(oneflag),'" not recognized'
          call cubeheader_message(seve%e,rname,mess)
          lerror = .true.
          cycle
        endif
      endif
    enddo
    if (lerror) then
      call cubeheader_message(seve%e,rname,'Undecipherable flag list: "'//trim(string)//'"')
      error = .true.
      return
    endif
  end subroutine cubetools_string_toflaglist
  !
  subroutine cubetools_flag_debug(error)
    !-------------------------------------------------------------------
    ! Display the full list of flags registered
    !-------------------------------------------------------------------
    logical, intent(inout) :: error
    ! Local
    integer(kind=flag_k) :: iflag,jflag
    type(flag_t), pointer :: flag
    !
    do iflag=1,flag_list%n
      jflag = flag_list_sort(iflag)
      flag => cubetools_flag_ptr(flag_list%list(jflag)%p,error)
      if (error) return
      call flag%list(error)
      if (error) return
    enddo
  end subroutine cubetools_flag_debug
  !
  subroutine cubetools_flaglist_sort(error)
    !-------------------------------------------------------------------
    ! Compute the sorting array of the flag list (by alphabetical order
    ! of names)
    !-------------------------------------------------------------------
    logical, intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='FLAGLIST>SORT'
    integer(kind=flag_k) :: iflag
    integer(kind=4) :: ier
    type(flag_list_dicho_t) :: sorter
    !
    if (allocated(flag_list_sort))  deallocate(flag_list_sort)
    allocate(flag_list_sort(flag_list%n),stat=ier)
    if (failed_allocate(rname,'flag_list_sort',ier,error)) return
    do iflag=1,flag_list%n
      flag_list_sort(iflag) = iflag
    enddo
    !
    call sorter%sort(flag_list_sort,flag_list%n,error)
    if (error)  return
  end subroutine cubetools_flaglist_sort
  !
  subroutine cubetools_flaglist_list_all(error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    logical, intent(inout) :: error
    !
    integer(kind=flag_k) :: iflag
    integer(kind=4) :: nlp,nla,nlu
    type(flag_t), pointer :: pflag
    character(len=2048) :: products,actions,users
    !
    character(len=*), parameter :: rname='FLAGLIST>LIST>ALL'
    !
    ! call cubeheader_message(dagseve%trace,rname,'Welcome')
    !
    products = ''
    actions  = ''
    users    = ''
    nlp = 0
    nla = 0
    nlu = 0
    do iflag=1,flag_list%n
       pflag => cubetools_flag_ptr(flag_list%list(flag_list_sort(iflag))%p,error)
       if (error) return
       select case(pflag%kind)
       case(code_flag_product)
          call format_line_break(pflag%key,products,nlp)
       case(code_flag_action)
          call format_line_break(pflag%key,actions,nla)
       case(code_flag_user)
          call format_line_break(pflag%key,users,nlu)
       case default
          ! Do nothing
       end select
    enddo
    call cubeheader_message(seve%r,rname,'Product flags:')
    call cubeheader_message(seve%r,rname,products(1:len_trim(products)-1))
    call cubeheader_message(seve%r,rname,blankstr)
    call cubeheader_message(seve%r,rname,'Action flags:')    
    call cubeheader_message(seve%r,rname,actions(1:len_trim(actions)-1))
    call cubeheader_message(seve%r,rname,blankstr)
    call cubeheader_message(seve%r,rname,'User flags:')
    call cubeheader_message(seve%r,rname,users(1:len_trim(users)-1))
  contains
    subroutine format_line_break(key,line,nl)
      use cubetools_terminal_tool
      !----------------------------------------------------------------------
      !
      !----------------------------------------------------------------------
      character(len=*), intent(in)    :: key
      character(len=*), intent(inout) :: line
      integer(kind=4),  intent(inout) :: nl
      !
      integer(kind=4) :: nc
      character(len=*), parameter :: sep = ','
      !
      nc = len_trim(key)
      if (nl+nc+2.gt.terminal%width()) then
         write(line,'(2a)') trim(line),strg_cr
         nl = 0
      endif
      write(line,'(a,x,2a)') trim(line),trim(key),sep
      nl = nl+nc+2
    end subroutine format_line_break
  end subroutine cubetools_flaglist_list_all

  subroutine cubetools_flaglist_write(fl,lun,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(flag_list_t), intent(in)    :: fl
    integer(kind=4),    intent(in)    :: lun
    logical,            intent(inout) :: error
    !
    integer(kind=4) :: iflag,nc
    character(len=dag_flagl), allocatable :: lflags(:)
    character(len=*), parameter :: rname='FLAGLIST>WRITE'
    !
    ! Flags
    call fl%export(lflags,error)
    if (error)  return
    ! Cosmetics: find the smallest length needed
    nc = 0
    do iflag=1,fl%n
      nc = max(nc,len_trim(lflags(iflag)))
    enddo
    write(lun,form_na) 'FLAG',fl%n,(/ (lflags(iflag)(1:nc),iflag=1,fl%n) /)
  end subroutine cubetools_flaglist_write

  subroutine cubetools_flaglist_export(fl,flags,error)
    !-------------------------------------------------------------------
    ! Export the flag list to character array
    !-------------------------------------------------------------------
    class(flag_list_t), intent(in)    :: fl
    character(len=*),   allocatable   :: flags(:)
    logical,            intent(inout) :: error
    !
    integer(kind=4) :: iflag,ier
    type(flag_t), pointer :: flag
    character(len=*), parameter :: rname='FLAGLIST>EXPORT'
    !
    allocate(flags(fl%n),stat=ier)
    if (failed_allocate(rname,'flags',ier,error)) return
    do iflag=1,fl%n
      flag => cubetools_flag_ptr(fl%list(iflag)%p,error)
      if (error)  return
      flags(iflag) = flag%get_name()
    enddo
  end subroutine cubetools_flaglist_export

  subroutine cubetools_flaglist_read(fl,lun,error)
    class(flag_list_t), intent(inout) :: fl
    integer(kind=4),   intent(in)    :: lun
    logical,           intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='FLAGLIST>READ'
    character(len=dag_flagl) :: chflags(dag_mflags)
    integer(kind=4) :: nflag,iflag
    type(flag_t), pointer :: flag
    class(list_object_t), pointer :: lot
    type(flag_t) :: template
    logical :: found
    !
    call cubetools_read_nch(lun,nflag,chflags,error)
    if (error)  return
    call fl%reallocate(nflag,error)
    if (error)  return
    ! Resolving codes from names below is inefficient. Solutions:
    !  1) Sort the main list, and use dichotomic search, OR
    !  2) Get rid of the integer codes (as we want flexibility
    !     e.g. user-defined flags)
    do iflag=1,nflag
      call fl%allocate(template,lot,error)
      if (error)  return
      flag => cubetools_flag_ptr(lot,error)
      if (error)  return
      call cubetools_flag_name2flag(chflags(iflag),found,flag)
      if (.not.found) then
        ! Implicitly recreate a user-defined flag in the main list
        call cubetools_flag_register_user(chflags(iflag),error)
        if (error)  return
        ! And search for it again. Not efficient but robust.
        call cubetools_flag_name2flag(chflags(iflag),found,flag)
      endif
    enddo
    fl%n = nflag
  end subroutine cubetools_flaglist_read

  subroutine cubetools_read_nch(lun,nch,ch,error)
    !-------------------------------------------------------------------
    !-------------------------------------------------------------------
    integer(kind=4),  intent(in)    :: lun
    integer(kind=4),  intent(out)   :: nch
    character(len=*), intent(out)   :: ch(:)
    logical,          intent(inout) :: error
    ! Local
    character(len=key_l) :: key
    character(len=128) :: tmp
    !
    read(lun,form_nac) key,nch,tmp
    if (nch.gt.0) then
      read(tmp,*)  ch(1:nch)
    endif
  end subroutine cubetools_read_nch

end module cubetools_flag_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
