!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeset_units_option
  use cubetools_parameters
  use cubetools_structure
  use cubetools_unit_arg
  use cubetools_unit
  use cubeset_messaging
  !
  public :: units_opt_option_t,units_opt_user_t
  private
  !
  type :: units_opt_option_t
    type(option_t),   pointer :: opt
    type(unit_arg_t), pointer :: arg
  contains
    procedure, public :: register => cubeset_units_opt_register
    procedure, public :: parse    => cubeset_units_opt_parse
  end type units_opt_option_t
  !
  type :: units_opt_user_t
    logical               :: present = .false.
    character(len=unit_l) :: name = strg_unk
  end type units_opt_user_t
  !
contains
  !
  subroutine cubeset_units_opt_register(option,kind,error)
    use cubetools_unit_setup
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(units_opt_option_t), intent(inout) :: option
    integer(kind=code_k),      intent(in)    :: kind
    logical,                   intent(inout) :: error
    !
    type(unit_arg_t)  :: unitarg
    character(len=*), parameter :: rname='UNITS>OPTION>REGISTER'
    !
    call cubeset_message(setseve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         unitkinds(kind),'name',&
         'Set current unit for '//trim(unitkinds(kind))//' units',&
         strg_id,&
         option%opt,error)
    if (error) return
    call unitarg%register(&
         'name',&
         'New current unit name',&
         strg_id,&
         code_arg_mandatory,&
         kind,&
         option%arg,&
         error)
    if (error) return
  end subroutine cubeset_units_opt_register
  !
  subroutine cubeset_units_opt_parse(option,line,user,error)
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    class(units_opt_option_t), intent(inout) :: option
    character(len=*),          intent(in)    :: line
    type(units_opt_user_t),    intent(out)   :: user
    logical,                   intent(inout) :: error
    !
    character(len=*), parameter :: rname='UNITS>OPTION>PARSE'
    !
    call cubeset_message(setseve%trace,rname,'Welcome')
    !
    call option%opt%present(line,user%present,error)
    if (error) return
    if (user%present) then
       call cubetools_getarg(line,option%opt,1,user%name,mandatory,error)
       if (error) return
    endif
  end subroutine cubeset_units_opt_parse
end module cubeset_units_option
!
module cubeset_units
  use cubetools_structure
  use cubetools_unit_setup
  use cubetools_unit
  use cubeset_units_option
  use cubeset_messaging
  !
  public :: units
  private
  !
  type :: units_comm_t
     type(option_t), pointer  :: comm
     type(units_opt_option_t) :: kind(nunitkinds)
     type(option_t), pointer  :: def
   contains
     procedure, public  :: register => cubeset_units_register
     procedure, private :: parse    => cubeset_units_parse
     procedure, private :: main     => cubeset_units_main
  end type units_comm_t
  type(units_comm_t) :: units
  !
  type :: units_user_t
    type(units_opt_user_t) :: kind(nunitkinds)
    logical                :: dodef
  end type units_user_t
  !
contains
  !
  subroutine cubeset_units_command(line,error)
    !---------------------------------------------------------------------
    ! Support routine for command
    ! UNITS
    !---------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(units_user_t) :: user
    character(len=*), parameter :: rname='UNIT>COMMAND'
    !
    call cubeset_message(setseve%trace,rname,'Welcome')
    !
    call units%parse(line,user,error)
    if (error) return
    call units%main(user,error)
    if (error) return
  end subroutine cubeset_units_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubeset_units_register(units,error)
    use cubetools_parameters
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    class(units_comm_t), intent(inout) :: units
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: comm_abstract = &
         'Set user current units'
    character(len=*), parameter :: comm_help = &
         'Current units are the units used to display information to&
         & the user and the expected units for user input. If called&
         & without options, UNITS display the current units and its&
         & convertion factor to internal units'
    character(len=*), parameter :: rname='UNIT>REGISTER'
    !
    call cubeset_message(setseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'UNITS','',&
         comm_abstract,&
         comm_help,&
         cubeset_units_command,&
         units%comm,error)
    if (error) return
    !
    call units%kind(code_unit_uv)%register(code_unit_uv,error)
    if (error) return
    call units%kind(code_unit_fov)%register(code_unit_fov,error)
    if (error) return
    call units%kind(code_unit_pang)%register(code_unit_pang,error)
    if (error) return
    call units%kind(code_unit_beam)%register(code_unit_beam,error)
    if (error) return
    call units%kind(code_unit_freq)%register(code_unit_freq,error)
    if (error) return
    call units%kind(code_unit_velo)%register(code_unit_velo,error)
    if (error) return
    call units%kind(code_unit_wave)%register(code_unit_wave,error)
    if (error) return
    call units%kind(code_unit_chan)%register(code_unit_chan,error)
    if (error) return
    call units%kind(code_unit_pixe)%register(code_unit_pixe,error)
    if (error) return
    call units%kind(code_unit_dist)%register(code_unit_dist,error)
    if (error) return
    call units%kind(code_unit_unk)%register(code_unit_unk,error)
    if (error) return
    !
    call cubetools_register_option(&
         'DEFAULTS','',&
         'Restore current units to defaults',&
         strg_id,&
         units%def,error)
    if (error) return
  end subroutine cubeset_units_register
  !
  subroutine cubeset_units_parse(units,line,user,error)
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    class(units_comm_t), intent(inout) :: units
    character(len=*),    intent(in)    :: line
    type(units_user_t),  intent(out)   :: user
    logical,             intent(inout) :: error
    !
    integer(kind=4) :: ikind
    character(len=*), parameter :: rname='UNIT>PARSE'
    !
    call cubeset_message(setseve%trace,rname,'Welcome')
    !
    call units%def%present(line,user%dodef,error)
    if (error) return
    !
    do ikind=1,nunitkinds
       call units%kind(ikind)%parse(line,user%kind(ikind),error)
       if (error) return
    enddo
  end subroutine cubeset_units_parse
  !
  subroutine cubeset_units_main(units,user,error)
    use cubetools_unit_setup
    use cubetools_unit
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    class(units_comm_t), intent(in)    :: units
    type(units_user_t),  intent(in)    :: user
    logical,             intent(inout) :: error
    !
    integer(kind=4) :: ikind
    character(len=*), parameter :: rname='UNIT>MAIN'
    !
    call cubeset_message(setseve%trace,rname,'Welcome')
    !
    if (user%dodef) then
       call unitbuffer%defaults(error)
       if (error) return
    endif
    !
    do ikind=1,nunitkinds
       if (user%kind(ikind)%present) then
          call cubetools_unit_set(user%kind(ikind)%name,ikind,error)
          if (error) return
       endif
    enddo
    !
    if (cubetools_nopt().eq.0) then
       call unitbuffer%list(error)
       if (error) return
    endif
  end subroutine cubeset_units_main
end module cubeset_units
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
