!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeadm_identifier
  use cubedag_flag
  use cubetools_structure
  use cubeadm_messaging
  !
  public :: identifier_opt_t, identifier_user_t, identifier_prog_t
  public :: changeflags
  private
  !
  logical, parameter :: changeflags = .true.
  !
  type identifier_opt_t
     logical                 :: doflags
     type(option_t), pointer :: opt
   contains
     procedure, public :: register => cubeadm_identifier_register
     procedure, public :: parse    => cubeadm_identifier_parse
  end type identifier_opt_t
  !
  type identifier_user_t
     logical               :: doflags
     logical               :: do
     character(len=base_l) :: identifier
   contains
     procedure, public :: toprog => cubeadm_identifier_user_toprog
  end type identifier_user_t
  !
  type identifier_prog_t
     logical                   :: doflags
     character(len=base_l)     :: family
     type(flag_t), allocatable :: flags(:)
   contains
     procedure, public :: apply => cubeadm_identifier_prog_apply
  end type identifier_prog_t
  !
contains
  !
  subroutine cubeadm_identifier_register(option,abstract,doflags,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(identifier_opt_t), intent(inout) :: option
    character(len=*),        intent(in)    :: abstract
    logical,                 intent(in)    :: doflags
    logical,                 intent(inout) :: error
    !
    type(standard_arg_t) :: stdarg
    character(len=*), parameter :: rname='IDENTIFIER>REGISTER'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    option%doflags = doflags
    if (option%doflags) then
       call cubetools_register_option(&
            'AS','family[:flag1,...,flagn]',&
            abstract,&
            'Set the family name and optionally the flags of the output&
            & cube. To consult the list of all available flags consult&
            & ADM\FLAGLIST',&
            option%opt,error)
       if (error) return
    else
       call cubetools_register_option(&
            'FAMILY','name',&
            abstract,&
            strg_id,&
            option%opt,error)
       if (error) return
    endif
    call stdarg%register(&
         'identifier', &
         'New identifier', &
         strg_id,&
         code_arg_mandatory, error)
    if (error) return
  end subroutine cubeadm_identifier_register
  !
  subroutine cubeadm_identifier_parse(option,line,user,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(identifier_opt_t), intent(in)    :: option
    character(len=*),        intent(in)    :: line
    type(identifier_user_t), intent(out)   :: user
    logical,                 intent(inout) :: error
    !
    character(len=*), parameter :: rname='IDENTIFIER>PARSE'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    user%doflags = option%doflags
    call option%opt%present(line,user%do,error)
    if (error) return
    if (user%do) then
       call cubetools_getarg(line,option%opt,1,user%identifier,mandatory,error)
       if (error) return
    endif
  end subroutine cubeadm_identifier_parse
  !
  !----------------------------------------------------------------------
  !
  subroutine cubeadm_identifier_user_toprog(user,cube,prog,error)
    use cube_types
    use cubeadm_cubeid_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(identifier_user_t), intent(in)    :: user
    type(cube_t),             intent(in)    :: cube
    type(identifier_prog_t),  intent(out)   :: prog
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='IDENTIFIER>USER>TOPROG'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    prog%doflags = user%doflags
    if (user%do) then
       call cubeadm_cubeid_string2familyflags(user%identifier,prog%family,prog%flags,error)
       if (error) return
       if (allocated(prog%flags).and..not.user%doflags) &
            call cubeadm_message(seve%w,rname,'Changing flags not allowed in this context, flags ignored')
    else
       prog%family = cube%node%family
    endif
  end subroutine cubeadm_identifier_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubeadm_identifier_prog_apply(prog,cube,error)
    use cube_types
    use cubedag_node
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(identifier_prog_t), intent(in)    :: prog
    type(cube_t),             intent(inout) :: cube
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='IDENTIFIER>PROG>APPLY'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call cubedag_node_set_family(cube,prog%family,error)
    if (error) return
    if (allocated(prog%flags).and.prog%doflags) then
       call cubedag_node_set_flags(cube,prog%flags,error)
       if (error) return
    else
       ! Do nothing
    endif
  end subroutine cubeadm_identifier_prog_apply
end module cubeadm_identifier
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
