!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubedag_flag
  use gkernel_interfaces
  use cubetools_parameters
  use cubetools_list
  use cubedag_parameters
  use cubedag_messaging
  !---------------------------------------------------------------------
  ! Support module for flags and list of flags
  !---------------------------------------------------------------------
  !
  ! Flag related symbols
  public :: flag_t
  public :: dag_flagl,kinds
  public :: code_kind_action,code_kind_product,code_kind_user
  public :: flag_unknown,flag_any
  public :: cubedag_flag_ptr,cubedag_flag_init,cubedag_flag_register_user
  public :: operator(.eq.),operator(.ne.)
  ! Flaglist related symbols
  public :: flag_list_t
  public :: cubedag_flaglist_create,cubedag_flaglist_sort
  public :: cubedag_flaglist_tostr,cubedag_flaglist_list_all,cubedag_flag_debug
  public :: cubedag_string_toflaglist
  private
  !
  ! Kinds
  integer(kind=code_k), parameter :: nkinds = 4
  character(len=*), parameter :: kinds(nkinds) = ['any    ','action ','product','user   ']
  integer(kind=code_k), parameter :: code_kind_any     = 1
  integer(kind=code_k), parameter :: code_kind_action  = 2
  integer(kind=code_k), parameter :: code_kind_product = 3
  integer(kind=code_k), parameter :: code_kind_user    = 4
  !
  integer(kind=4), parameter :: dag_flagl=11
  character(len=1), parameter :: flagsep_strg=','
  !
  type, extends(tools_object_t) :: flag_t
     character(len=dag_flagl), private :: name
     character(len=dag_flagl), private :: key
     integer(kind=code_k),     private :: kind
     integer(kind=list_k),     private :: id
   contains
     procedure, public :: register   => cubedag_flag_register_program  ! For program-defined flags only
     procedure, public :: list       => cubedag_flag_list
     procedure, public :: get_id     => cubedag_flag_get_id
     procedure, public :: get_name   => cubedag_flag_get_name
     procedure, public :: get_key    => cubedag_flag_get_key
     procedure, public :: get_kind   => cubedag_flag_get_kind
     procedure, public :: get_suffix => cubedag_flag_get_suffix
  end type flag_t
  !
  interface operator(.eq.)  ! Offers syntax e.g. "myflag.eq.flag_any" to programmers
    module procedure cubedag_flag_eq
  end interface
  !
  interface operator(.ne.)  ! Offers syntax e.g. "myflag.ne.flag_any" to programmers
    module procedure cubedag_flag_ne
  end interface
  !
  ! Some technical flags
  type(flag_t), target :: flag_unknown
  type(flag_t), target :: flag_any
  !
  type, extends(tools_list_t) :: flag_list_t
  contains
    procedure, public :: repr  => cubedag_flaglist_repr
    procedure, public :: write => cubedag_flaglist_write
    procedure, public :: read  => cubedag_flaglist_read
  end type flag_list_t
  !
  integer(kind=4), parameter :: key_l=24  ! Note the T26 tab below
  character(len=*), parameter :: form_na ='(A,T26,I11,(20(1X,A12)))'  ! String array
  character(len=*), parameter :: form_nac='(A,T26,I11,A)'             ! String array (decoding)
  !
  ! The global list of flags
  type(tools_list_t) :: flag_list
  integer(kind=list_k), allocatable :: flag_list_sort(:)
  !
contains
  !
  !---------------------------------------------------------------------
  ! Support for scalar flags
  !---------------------------------------------------------------------
  !
  subroutine cubedag_flag_init(error)
    !-------------------------------------------------------------------
    ! Register the technical flags
    !-------------------------------------------------------------------
    logical, intent(inout) :: error
    !
    call flag_unknown%register('unknown',code_kind_any,error)
    call flag_any%register    ('*',      code_kind_any,error)
    if (error) return
    !
    call cubedag_flaglist_sort(error)  ! Compute the sorting array
    if (error)  return
  end subroutine cubedag_flag_init
  !
  subroutine cubedag_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 cubedag_message(seve%r,'FLAG>LIST',mess)
  end subroutine cubedag_flag_list
  !
  function cubedag_flag_get_id(flag) result(id)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(flag_t), intent(in) :: flag
    integer(kind=list_k)      :: id
    !
    id = flag%id
  end function cubedag_flag_get_id
  !
  function cubedag_flag_get_name(flag) result(name)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(flag_t), intent(in) :: flag
    character(len=dag_flagl)  :: name
    !
    name = flag%name
  end function cubedag_flag_get_name
  !
  function cubedag_flag_get_key(flag) result(key)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(flag_t), intent(in) :: flag
    character(len=dag_flagl)  :: key
    !
    key = flag%key
  end function cubedag_flag_get_key
  !
  function cubedag_flag_get_kind(flag) result(kind)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(flag_t), intent(in) :: flag
    integer(kind=code_k)      :: kind
    !
    kind = flag%kind
  end function cubedag_flag_get_kind
  !
  function cubedag_flag_get_suffix(flag) result(suffix)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(flag_t), intent(in)  :: flag
    character(len=dag_flagl+1) :: suffix
    !
    suffix = '-'//flag%name
  end function cubedag_flag_get_suffix
  !
  function cubedag_flag_eq(flag1,flag2)
    logical :: cubedag_flag_eq
    type(flag_t), intent(in) :: flag1,flag2
    cubedag_flag_eq = flag1%id.eq.flag2%id
  end function cubedag_flag_eq
  !
  function cubedag_flag_ne(flag1,flag2)
    logical :: cubedag_flag_ne
    type(flag_t), intent(in) :: flag1,flag2
    cubedag_flag_ne = flag1%id.ne.flag2%id
  end function cubedag_flag_ne
  !
  function cubedag_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 :: cubedag_flag_ptr
    class(tools_object_t), pointer       :: tot
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='FLAG>PTR'
    !
    select type(tot)
    type is (flag_t)
      cubedag_flag_ptr => tot
    class default
      cubedag_flag_ptr => null()
      call cubedag_message(seve%e,rname,  &
        'Internal error: object is not a flag_t type')
      error = .true.
      return
    end select
  end function cubedag_flag_ptr
  !
  subroutine cubedag_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=list_k) :: iflag
    type(flag_t), pointer :: lflag
    logical :: error
    !
    lname = name
    call sic_lower(lname)
    found = .false.
    flag = flag_unknown
    error = .false.
    !
    call gi0_dicho_with_user_ltgt(flag_list%n,.true.,iflag,  &
      flag_list_lt,flag_list_gt,error)
    if (error)  return
    ! In return jflag is the flag lower or equal to the request
    ! in the sorted array (flag_list_sort)
    !
    lflag => cubedag_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
    !
  contains
    function flag_list_lt(m)
      logical :: flag_list_lt
      integer(kind=list_k), intent(in) :: m
      ! 'lname', 'flag', and 'error' shared with main routine
      lflag => cubedag_flag_ptr(flag_list%list(flag_list_sort(m))%p,error)
      if (error)  return
      flag_list_lt = flag_name_lt(lflag%name,lname)
    end function flag_list_lt
    function flag_list_gt(m)
      logical :: flag_list_gt
      integer(kind=list_k), intent(in) :: m
      ! 'lname', 'flag', and 'error' shared with main routine
      lflag => cubedag_flag_ptr(flag_list%list(flag_list_sort(m))%p,error)
      if (error)  return
      flag_list_gt = flag_name_gt(lflag%name,lname)
    end function flag_list_gt
  end subroutine cubedag_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
  !
  !---------------------------------------------------------------------
  ! Support for list of flags
  !---------------------------------------------------------------------
  !
  subroutine cubedag_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 cubedag_flag_register(flag,name,kind,error)
    if (error)  return
    ! Sorting is done once by caller
  end subroutine cubedag_flag_register_program
  !
  subroutine cubedag_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 cubedag_message(seve%e,rname,'Flag name is too long')
      error = .true.
      return
    endif
    call cubedag_flag_name2flag(name,found,otherflag)
    if (found) then
      call cubedag_message(seve%e,rname,'Flag named '''//trim(name)//''' already exists')
      error = .true.
      return
    endif
    !
    allocate(flag)
    call cubedag_flag_register(flag,name,code_kind_user,error)
    if (error) then
      deallocate(flag)
      return
    endif
    call cubedag_flaglist_sort(error)  ! Compute the sorting array
    if (error)  return
  end subroutine cubedag_flag_register_user
  !
  subroutine cubedag_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
    !
    ! Inser in global flag list
    call flag_list%realloc(flag%id,error)
    if (error)  return
    call flag_list%list(flag%id)%associate(flag,error)
    if (error)  return
    flag_list%n = flag%id  ! Only when everything ok
  end subroutine cubedag_flag_register
  !
  subroutine cubedag_flaglist_create(flags,list,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.
    !-------------------------------------------------------------------
    type(flag_t), target, intent(in)    :: flags(:)
    type(flag_list_t),    intent(inout) :: list
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='FLAGLIST>CREATE'
    integer(kind=list_k) :: iflag,nflag
    type(flag_t), pointer :: flag
    type(flag_t) :: template
    !
    nflag = size(flags)
    call list%realloc(nflag,error)
    if (error)  return
    !
    do iflag=1,nflag
      call list%list(iflag)%allocate(template,error)
      if (error)  return
      flag => cubedag_flag_ptr(list%list(iflag)%p,error)
      if (error)  return
      flag = flags(iflag)
    enddo
    list%n = nflag
  end subroutine cubedag_flaglist_create
  !
  subroutine cubedag_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=4),            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 cubedag_flaglist_create(flags(1:nflag),tmp,error)
    if (error)  return
    call tmp%repr(strflag=strflag,lstrflag=lstrflag,error=error)
    if (error)  return
    call tmp%free(error)
    if (error)  return
  end subroutine cubedag_flaglist_tostr
  !
  subroutine cubedag_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 => cubedag_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 cubedag_flaglist_repr
  !
  subroutine cubedag_string_toflaglist(string,flags,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Parse a string into a list of flags
    !----------------------------------------------------------------------
    character(len=*),          intent(in)    :: string
    type(flag_t), allocatable, intent(out)   :: flags(:)
    logical,                   intent(inout) :: error
    !
    integer(kind=list_k) :: nflag,iflag
    integer(kind=4) :: ichar,seppos(20),ierr
    character(len=argu_l) :: oneflag
    character(len=mess_l) :: mess
    logical :: found
    character(len=*), parameter :: rname='CUBEID>STRING2FLAGS'
    !
    ! call cubedag_message(dagseve%trace,rname,'Welcome')
    !
    if (len_trim(string).eq.0) then ! No flags given return
      return
    else
      nflag = 0
      seppos(:) = -1
      seppos(1) = 0
      do ichar=1,len_trim(string)
        if (string(ichar:ichar).eq.flagsep_strg) then
          nflag = nflag+1
          seppos(nflag+1) = ichar
        endif
      enddo
      nflag = nflag+1
      seppos(nflag+1) = len_trim(string)+1
      !
      ierr = 0
      mess = ''
      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)
        call cubedag_flag_name2flag(oneflag,found,flags(iflag))
        if (.not.found) then
          ierr = ierr +1
          if (ierr.ne.1) mess = trim(mess)//', '
          mess = trim(mess)//trim(oneflag)
          error = .true.
        endif
      enddo
      if (error) then
        call cubedag_message(seve%e,rname,'Unrecognized flags: '//mess)
        return
      endif
    endif
  end subroutine cubedag_string_toflaglist
  !
  subroutine cubedag_flag_debug(error)
    !-------------------------------------------------------------------
    ! Display the full list of flags registered
    !-------------------------------------------------------------------
    logical, intent(inout) :: error
    ! Local
    integer(kind=list_k) :: iflag
    type(flag_t), pointer :: flag
    !
    do iflag=1,flag_list%n
      flag => cubedag_flag_ptr(flag_list%list(iflag)%p,error)
      if (error) return
      call flag%list(error)
      if (error) return
    enddo
  end subroutine cubedag_flag_debug
  !
  subroutine cubedag_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=list_k) :: iflag
    integer(kind=4) :: ier
    !
    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 gi0_quicksort_index_with_user_gtge(flag_list_sort,flag_list%n,  &
      flag_list_sort_gt,flag_list_sort_ge,error)
    if (error)  return
  end subroutine cubedag_flaglist_sort
  !
  function flag_list_sort_gt(m,l)
    logical :: flag_list_sort_gt
    integer(kind=list_k), intent(in) :: m,l
    ! Local
    logical :: error
    type(flag_t), pointer :: flagm,flagl
    !
    error = .false.
    flagm => cubedag_flag_ptr(flag_list%list(m)%p,error)
    if (error)  return
    flagl => cubedag_flag_ptr(flag_list%list(l)%p,error)
    if (error)  return
    flag_list_sort_gt = flag_name_gt(flagm%name,flagl%name)
  end function flag_list_sort_gt
  !
  function flag_list_sort_ge(m,l)
    logical :: flag_list_sort_ge
    integer(kind=list_k), intent(in) :: m,l
    ! Local
    logical :: error
    type(flag_t), pointer :: flagm,flagl
    !
    error = .false.
    flagm => cubedag_flag_ptr(flag_list%list(m)%p,error)
    if (error)  return
    flagl => cubedag_flag_ptr(flag_list%list(l)%p,error)
    if (error)  return
    flag_list_sort_ge = flag_name_ge(flagm%name,flagl%name)
  end function flag_list_sort_ge
  !
  subroutine cubedag_flaglist_list_all(error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    logical, intent(inout) :: error
    !
    integer(kind=list_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 cubedag_message(dagseve%trace,rname,'Welcome')
    !
    products = ''
    actions  = ''
    users    = ''
    nlp = 0
    nla = 0
    nlu = 0
    do iflag=1,flag_list%n
       pflag => cubedag_flag_ptr(flag_list%list(flag_list_sort(iflag))%p,error)
       if (error) return
       select case(pflag%kind)
       case(code_kind_product)
          call format_line_break(pflag%key,products,nlp)
       case(code_kind_action)
          call format_line_break(pflag%key,actions,nla)
       case(code_kind_user)
          call format_line_break(pflag%key,users,nlu)
       case default
          ! Do nothing
       end select
    enddo
    call cubedag_message(seve%r,rname,'Product flags:')
    call cubedag_message(seve%r,rname,products(1:len_trim(products)-1))
    call cubedag_message(seve%r,rname,blankstr)
    call cubedag_message(seve%r,rname,'Action flags:')    
    call cubedag_message(seve%r,rname,actions(1:len_trim(actions)-1))
    call cubedag_message(seve%r,rname,blankstr)
    call cubedag_message(seve%r,rname,'User flags:')
    call cubedag_message(seve%r,rname,users(1:len_trim(users)-1))
  contains
    subroutine format_line_break(key,line,nl)
      use cubetools_help
      !----------------------------------------------------------------------
      !
      !----------------------------------------------------------------------
      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.help_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 cubedag_flaglist_list_all

  subroutine cubedag_flaglist_write(fl,lun,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(flag_list_t), intent(in)    :: fl
    integer(kind=4),   intent(in)    :: lun
    logical,           intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='FLAGLIST>WRITE'
    integer(kind=4) :: iflag,ier
    character(len=dag_flagl), allocatable :: lflags(:)
    type(flag_t), pointer :: flag
    !
    ! Flags
    allocate(lflags(fl%n),stat=ier)
    if (failed_allocate(rname,'flags',ier,error)) return
    do iflag=1,fl%n
      flag => cubedag_flag_ptr(fl%list(iflag)%p,error)
      if (error)  return
      lflags(iflag) = flag%get_name()
    enddo
    ! ZZZ flag names elements have length < 12: they are right justified
    !     in their 12-char space... See patch at read time
    write(lun,form_na) 'FLAG',fl%n,(/ (lflags(iflag),iflag=1,fl%n) /)
  end subroutine cubedag_flaglist_write

  subroutine cubedag_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=12) :: chflags(dag_mflags)
    integer(kind=4) :: nflag,iflag
    type(flag_t), pointer :: flag
    type(flag_t) :: template
    logical :: found
    !
    call cubedag_read_nch(lun,nflag,chflags,error)
    if (error)  return
    call fl%realloc(nflag,error)
    if (error)  return
    ! Resolving codes from names below is unefficient. 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%list(iflag)%allocate(template,error)
      if (error)  return
      flag => cubedag_flag_ptr(fl%list(iflag)%p,error)
      if (error)  return
      call cubedag_flag_name2flag(chflags(iflag),found,flag)
      if (.not.found) then
        ! Implicitly recreate a user-defined flag in the main list
        call cubedag_flag_register_user(chflags(iflag),error)
        if (error)  return
        ! And search for it again. Not efficient but robust.
        call cubedag_flag_name2flag(chflags(iflag),found,flag)
      endif
    enddo
    fl%n = nflag
  end subroutine cubedag_flaglist_read

  subroutine cubedag_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
    integer(kind=4) :: ich
    !
    read(lun,form_nac) key,nch,tmp
    if (nch.gt.0) then
      read(tmp,'(20(1X,A12))')  ch(1:nch)
      do ich=1,nch
        ! ZZZ Elements might have been right-justified in their 12-char
        !     space: force left-justification
        ch(ich) = adjustl(ch(ich))
      enddo
    endif
  end subroutine cubedag_read_nch

end module cubedag_flag
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
