!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_unit_magnitude
  public :: unit_magnitude_t
  public :: cubetools_unit_magnitude_parse
  public :: exa,peta,tera,giga,mega,kilo,unity,centi,milli,micro,nano,pico,femto
  private
  !
  type :: unit_magnitude_t
    character(len=1), public  :: prefix     ! Standard prefix
    character(len=1), private :: alternate  ! Case insensitive alternate prefix
    real(kind=8),     public  :: factor     ! Multiplicative factor
  end type unit_magnitude_t
  !
  ! NB: in case of case-sensitive prefix, the alternate prefix is set identical
  !     to the standard prefix for simplicity of declaration and parsing.
  type(unit_magnitude_t), parameter :: exa   = unit_magnitude_t( 'E','e',1d18  )  ! Case-insensitive
  type(unit_magnitude_t), parameter :: peta  = unit_magnitude_t( 'P','P',1d15  )  ! Case-sensitive (conflict)
  type(unit_magnitude_t), parameter :: tera  = unit_magnitude_t( 'T','t',1d12  )  ! Case-insensitive
  type(unit_magnitude_t), parameter :: giga  = unit_magnitude_t( 'G','g',1d9   )  ! Case-insensitive
  type(unit_magnitude_t), parameter :: mega  = unit_magnitude_t( 'M','M',1d6   )  ! Case-sensitive (conflict)
  type(unit_magnitude_t), parameter :: kilo  = unit_magnitude_t( 'k','K',1d3   )  ! Case-insensitive
  type(unit_magnitude_t), parameter :: unity = unit_magnitude_t( ' ',' ',1d0   )  !
  type(unit_magnitude_t), parameter :: centi = unit_magnitude_t( 'c','C',1d-2  )  ! Case-insensitive
  type(unit_magnitude_t), parameter :: milli = unit_magnitude_t( 'm','m',1d-3  )  ! Case-sensitive (conflict)
  type(unit_magnitude_t), parameter :: micro = unit_magnitude_t( 'u','U',1d-6  )  ! Case-insensitive
  type(unit_magnitude_t), parameter :: nano  = unit_magnitude_t( 'n','N',1d-9  )  ! Case-insensitive
  type(unit_magnitude_t), parameter :: pico  = unit_magnitude_t( 'p','p',1d-12 )  ! Case-sensitive (conflict)
  type(unit_magnitude_t), parameter :: femto = unit_magnitude_t( 'f','F',1d-15 )  ! Case-insensitive
  !
  integer(kind=4), parameter :: nmagnitude=13
  type(unit_magnitude_t), parameter :: magnitudes(nmagnitude) =  &
    [ exa,peta,tera,giga,mega,kilo,unity,centi,milli,micro,nano,pico,femto ]
  !
contains
  !
  function cubetools_unit_magnitude_parse(prefix,magnitude)
    !-------------------------------------------------------------------
    ! Check if prefix is a known magnitude letter, and return this
    ! magnitude. Function evaluates as .true. or .false. if a matching
    ! magnitude is found.
    ! Case-sensitive search. Note that blank (or null-size) string
    ! matches unity.
    !-------------------------------------------------------------------
    logical :: cubetools_unit_magnitude_parse
    character(len=*),       intent(in)  :: prefix
    type(unit_magnitude_t), intent(out) :: magnitude
    !
    integer(kind=4) :: imagnitude
    !
    cubetools_unit_magnitude_parse = .false.
    do imagnitude=1,nmagnitude
      if (prefix.eq.magnitudes(imagnitude)%prefix .or. &
          prefix.eq.magnitudes(imagnitude)%alternate) then
        magnitude = magnitudes(imagnitude)
        cubetools_unit_magnitude_parse = .true.
        return
      endif
    enddo
  end function cubetools_unit_magnitude_parse
end module cubetools_unit_magnitude
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_unit_setup
  use cubetools_parameters
  use cubesyntax_messaging
  use cubetools_unit_magnitude
  !
  ! Constants
  public :: unitkinds,nunitkinds
  public :: code_unit_uv,unit_uv
  public :: code_unit_fov,unit_fov
  public :: code_unit_pang,unit_pang
  public :: code_unit_beam,unit_beam
  public :: code_unit_velo,unit_velo
  public :: code_unit_freq,unit_freq
  public :: code_unit_wave,unit_wave
  public :: code_unit_dist,unit_dist
  public :: code_unit_chan,unit_chan
  public :: code_unit_pixe,unit_pixe
  public :: code_unit_unk,unit_unk
  public :: code_unit_brig,code_unit_flux
  ! Types
  public :: unit_desc_t,unit_kind_t
  ! Methods
  public :: cubetools_unit_name,cubetools_unit_pperu
  public :: cubetools_unit_get_code,cubetools_unit_get_list_for_code
  public :: cubetools_unit_parse
  public :: operator(.eq.)
  ! Global variables
  public :: unitbuffer
  !
  private
  !
  ! *** JP: Should unit_l also be defined here?
  integer(kind=4), parameter :: unit_k = 4
  integer(kind=4), parameter :: keys_l = 10*unit_l  ! Store several variants of the same unit
  !
  ! Description of a unit default
  type :: unit_desc_t
     integer(kind=code_k),   public :: dimension  ! Backpointer to the list of associated units (e.g. to Hz)
     type(unit_magnitude_t), public :: magnitude  ! Possible extra factor (e.g. mega)
  end type unit_desc_t
  !
  ! Description of variants for a given unit
  type :: unit_variant_t
     integer(kind=unit_k),  private              :: n        ! Number of keys
     character(len=unit_l), private, allocatable :: keys(:)  ! List of keys
  end type unit_variant_t
  !
  ! Description of a unit kind
  type :: unit_kind_t
     integer(kind=code_k),  public               :: code     ! Unit code
     integer(kind=unit_k),  private              :: n        ! Number of different units supported
     character(len=unit_l), private, allocatable :: name(:)  ! Unit name for output
     character(len=keys_l), private, allocatable :: keys(:)  ! Blank-separated list of allowed input name for each unit
     type(unit_variant_t),  public,  allocatable :: vars(:)  ! Keys processed to list of variants
     real(kind=coor_k),     private, allocatable :: conv(:)  ! Relative conversion factor between supported units
     type(unit_desc_t),     private              :: prog     ! Program internal unit description
     type(unit_desc_t),     private              :: user     ! User default unit
   contains
     procedure, private :: alloc     => cubetools_unit_kind_alloc
     procedure, private :: init      => cubetools_unit_kind_init
     procedure, private :: debug     => cubetools_unit_kind_debug
     procedure, public  :: prog_name => cubetools_unit_kind_prog_name
  end type unit_kind_t
  !
  interface operator(.eq.)  ! Offers syntax e.g. "myunit.eq.unit_unk" to programmers
    module procedure cubetools_unit_kind_eq
  end interface
  !
  integer(kind=unit_k),  parameter :: nunitkinds = 11
  !
  ! Brightness and Flux units codes are included here as negative
  ! indexes because they are treated in a separate module
  ! (cubetools_brightness). Hence All loops from 1 to nunitkinds will
  ! treat only statical units, i.e. units whose convertions do not
  ! depend on cube information.
  !
  character(len=unit_l), parameter :: unitkinds(-1:nunitkinds) = [&
       'FLUX      ','BRIGHTNESS','UV        ','FOV       ','POSANGLE  ',&
       'BEAM      ','FREQUENCY ','VELOCITY  ','WAVELENGTH','CHANNEL   ',&
       'PIXEL     ','DISTANCE  ','UNKNOWN   ']
  !
  integer(kind=code_k), parameter :: code_unit_flux = -1
  integer(kind=code_k), parameter :: code_unit_brig = 0
  integer(kind=code_k), parameter :: code_unit_uv=1
  integer(kind=code_k), parameter :: code_unit_fov=2
  integer(kind=code_k), parameter :: code_unit_pang=3
  integer(kind=code_k), parameter :: code_unit_beam=4
  integer(kind=code_k), parameter :: code_unit_freq=5
  integer(kind=code_k), parameter :: code_unit_velo=6
  integer(kind=code_k), parameter :: code_unit_wave=7
  integer(kind=code_k), parameter :: code_unit_chan=8
  integer(kind=code_k), parameter :: code_unit_pixe=9
  integer(kind=code_k), parameter :: code_unit_dist=10
  integer(kind=code_k), parameter :: code_unit_unk=11
  !
  type(unit_kind_t), pointer :: unit_uv
  type(unit_kind_t), pointer :: unit_fov
  type(unit_kind_t), pointer :: unit_pang
  type(unit_kind_t), pointer :: unit_beam
  type(unit_kind_t), pointer :: unit_freq
  type(unit_kind_t), pointer :: unit_velo
  type(unit_kind_t), pointer :: unit_wave
  type(unit_kind_t), pointer :: unit_chan
  type(unit_kind_t), pointer :: unit_pixe
  type(unit_kind_t), pointer :: unit_dist
  type(unit_kind_t), pointer :: unit_unk
  !
  type unit_buffer_t
     type(unit_kind_t),     public  :: kind(nunitkinds)           !
     type(unit_desc_t),     private :: program(nunitkinds)        ! Internal program unit
     type(unit_desc_t),     private :: default(nunitkinds)        ! User default unit
     type(unit_desc_t),     public  :: current(nunitkinds)        ! User current unit
     character(len=unit_l), private :: prognames(nunitkinds)      ! Internal program unit names
     character(len=unit_l), public  :: usernames(nunitkinds)      ! User current unit names
     real(kind=coor_k),     public  :: prog_per_user(nunitkinds)  ! User current conversion (ppu)
     real(kind=coor_k),     public  :: user_per_prog(nunitkinds)  ! User current conversion (upp)
   contains
     procedure, public  :: init      => cubetools_unit_buffer_init
     procedure, public  :: defaults  => cubetools_unit_buffer_defaults
     procedure, private :: debug     => cubetools_unit_buffer_debug
     procedure, public  :: list      => cubetools_unit_buffer_list
     procedure, public  :: prog_name => cubetools_unit_buffer_prog_name
  end type unit_buffer_t
  !
  type(unit_buffer_t), target :: unitbuffer
  !
contains
  !
  subroutine cubetools_unit_buffer_init(buffer,error)
    use phys_const
    !---------------------------------------------------------------------
    ! Re(define) all individual units and user current units
    !---------------------------------------------------------------------
    class(unit_buffer_t), target, intent(inout) :: buffer
    logical,                      intent(inout) :: error
    !
    character(len=*), parameter :: rname='UNIT>BUFFER>INIT'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    unit_uv => buffer%kind(code_unit_uv)
    unit_uv%code = code_unit_uv
    call unit_uv%alloc(1,error)
    if (error)  return
    unit_uv%name(:) = ['meter']
    unit_uv%keys(:) = ['METER']
    unit_uv%conv(:) = [ 1.d0  ]
    unit_uv%prog%dimension = 1
    unit_uv%prog%magnitude = unity
    unit_uv%user%dimension = 1
    unit_uv%user%magnitude = unity
    call unit_uv%init(error)
    !
    unit_fov => buffer%kind(code_unit_fov)
    unit_fov%code = code_unit_fov
    call unit_fov%alloc(4,error)
    if (error)  return
    unit_fov%name(:) = ['radian',    'degree',    'arcmin',    'arcsec'    ]
    unit_fov%keys(:) = ['RADIAN;RAD','DEGREE;DEG','ARCMIN    ','ARCSEC    ']
    unit_fov%conv(:) = [ 1d0,        rad_per_deg, rad_per_min, rad_per_sec ]
    unit_fov%prog%dimension = 1
    unit_fov%prog%magnitude = unity
    unit_fov%user%dimension = 4
    unit_fov%user%magnitude = unity
    call unit_fov%init(error)
    !
    unit_pang => buffer%kind(code_unit_pang)
    unit_pang%code = code_unit_pang
    call unit_pang%alloc(2,error)
    if (error)  return
    unit_pang%name(:) = ['radian',   'degree']
    unit_pang%keys(:) = ['RADIAN',   'DEGREE']
    unit_pang%conv(:) = [     1d0,rad_per_deg]
    unit_pang%prog%dimension = 1
    unit_pang%prog%magnitude = unity
    unit_pang%user%dimension = 2
    unit_pang%user%magnitude = unity
    call unit_pang%init(error)
    !
    unit_beam => buffer%kind(code_unit_beam)
    unit_beam%code = code_unit_beam
    call unit_beam%alloc(4,error)
    if (error)  return
    unit_beam%name(:) = ['radian',    'degree',    'arcmin',    'arcsec'    ]
    unit_beam%keys(:) = ['RADIAN;RAD','DEGREE;DEG','ARCMIN    ','ARCSEC    ']
    unit_beam%conv(:) = [ 1d0,        rad_per_deg, rad_per_min, rad_per_sec ]
    unit_beam%prog%dimension = 1
    unit_beam%prog%magnitude = unity
    unit_beam%user%dimension = 4
    unit_beam%user%magnitude = unity
    call unit_beam%init(error)
    !
    unit_freq => buffer%kind(code_unit_freq)
    unit_freq%code = code_unit_freq
    call unit_freq%alloc(1,error)
    if (error)  return
    unit_freq%name(:) = ['Hz']
    unit_freq%keys(:) = ['HZ']
    unit_freq%conv(:) = [ 1d0]
    unit_freq%prog%dimension = 1
    unit_freq%prog%magnitude = mega
    unit_freq%user%dimension = 1
    unit_freq%user%magnitude = mega
    call unit_freq%init(error)
    !
    unit_velo => buffer%kind(code_unit_velo)
    unit_velo%code = code_unit_velo
    call unit_velo%alloc(1,error)
    if (error)  return
    unit_velo%name(:) = ['m/s']
    unit_velo%keys(:) = ['M/S']
    unit_velo%conv(:) = [  1d0]
    unit_velo%prog%dimension = 1
    unit_velo%prog%magnitude = kilo
    unit_velo%user%dimension = 1
    unit_velo%user%magnitude = kilo
    call unit_velo%init(error)
    !
    unit_wave => buffer%kind(code_unit_wave)
    unit_wave%code = code_unit_wave
    call unit_wave%alloc(2,error)
    if (error)  return
    unit_wave%name(:) = ['m  ','Ang']
    unit_wave%keys(:) = ['M  ','ANG']
    unit_wave%conv(:) = [  1d0,1d-10]
    unit_wave%prog%dimension = 1
    unit_wave%prog%magnitude = micro
    unit_wave%user%dimension = 1
    unit_wave%user%magnitude = milli
    call unit_wave%init(error)
    !
    unit_chan => buffer%kind(code_unit_chan)
    unit_chan%code = code_unit_chan
    call unit_chan%alloc(1,error)
    if (error)  return
    unit_chan%name(:) = ['channel']
    unit_chan%keys(:) = ['CHANNEL']
    unit_chan%conv(:) = [      1d0]
    unit_chan%prog%dimension = 1
    unit_chan%prog%magnitude = unity
    unit_chan%user%dimension = 1
    unit_chan%user%magnitude = unity
    call unit_chan%init(error)
    !
    unit_pixe => buffer%kind(code_unit_pixe)
    unit_pixe%code = code_unit_pixe
    call unit_pixe%alloc(1,error)
    if (error)  return
    unit_pixe%name(:) = ['pixel']
    unit_pixe%keys(:) = ['PIXEL']
    unit_pixe%conv(:) = [    1d0]
    unit_pixe%prog%dimension = 1
    unit_pixe%prog%magnitude = unity
    unit_pixe%user%dimension = 1
    unit_pixe%user%magnitude = unity
    call unit_pixe%init(error)
    !
    unit_dist => buffer%kind(code_unit_dist)
    unit_dist%code = code_unit_dist
    call unit_dist%alloc(1,error)
    if (error)  return
    unit_dist%name(:) = ['pc']
    unit_dist%keys(:) = ['PC']
    unit_dist%conv(:) = [ 1d0]
    unit_dist%prog%dimension = 1
    unit_dist%prog%magnitude = unity
    unit_dist%user%dimension = 1
    unit_dist%user%magnitude = unity
    call unit_dist%init(error)
    !
    unit_unk => buffer%kind(code_unit_unk)
    unit_unk%code = code_unit_unk
    call unit_unk%alloc(1,error)
    if (error)  return
    unit_unk%name(:) = [ strg_unk]
    unit_unk%keys(:) = ['UNKNOWN']
    unit_unk%conv(:) = [      1d0]
    unit_unk%prog%dimension = 1
    unit_unk%prog%magnitude = unity
    unit_unk%user%dimension = 1
    unit_unk%user%magnitude = unity
    call unit_unk%init(error)
    !
    call buffer%defaults(error)
    if (error)  return
    !
    ! call buffer%debug()  ! Debug
  end subroutine cubetools_unit_buffer_init
  !
  subroutine cubetools_unit_buffer_defaults(buffer,error)
    !---------------------------------------------------------------------
    ! Reset prog and user units to defaults
    !---------------------------------------------------------------------
    class(unit_buffer_t), intent(inout) :: buffer
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='UNIT>BUFFER>DEFAULTS'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    buffer%program(unit_uv%code)   = unit_uv%prog
    buffer%program(unit_fov%code)  = unit_fov%prog
    buffer%program(unit_pang%code) = unit_pang%prog
    buffer%program(unit_beam%code) = unit_beam%prog
    buffer%program(unit_freq%code) = unit_freq%prog
    buffer%program(unit_velo%code) = unit_velo%prog
    buffer%program(unit_wave%code) = unit_wave%prog
    buffer%program(unit_chan%code) = unit_chan%prog
    buffer%program(unit_pixe%code) = unit_pixe%prog
    buffer%program(unit_dist%code) = unit_dist%prog
    buffer%program(unit_unk%code)  = unit_unk%prog
    !
    buffer%default(unit_uv%code)   = unit_uv%user
    buffer%default(unit_fov%code)  = unit_fov%user
    buffer%default(unit_pang%code) = unit_pang%user
    buffer%default(unit_beam%code) = unit_beam%user
    buffer%default(unit_freq%code) = unit_freq%user
    buffer%default(unit_velo%code) = unit_velo%user
    buffer%default(unit_wave%code) = unit_wave%user
    buffer%default(unit_chan%code) = unit_chan%user
    buffer%default(unit_pixe%code) = unit_pixe%user
    buffer%default(unit_dist%code) = unit_dist%user
    buffer%default(unit_unk%code)  = unit_unk%user
    !
    buffer%current(unit_uv%code)   = unit_uv%user
    buffer%current(unit_fov%code)  = unit_fov%user
    buffer%current(unit_pang%code) = unit_pang%user
    buffer%current(unit_beam%code) = unit_beam%user
    buffer%current(unit_freq%code) = unit_freq%user
    buffer%current(unit_velo%code) = unit_velo%user
    buffer%current(unit_wave%code) = unit_wave%user
    buffer%current(unit_chan%code) = unit_chan%user
    buffer%current(unit_pixe%code) = unit_pixe%user
    buffer%current(unit_dist%code) = unit_dist%user
    buffer%current(unit_unk%code)  = unit_unk%user
    !
    buffer%prognames(unit_uv%code)   = cubetools_unit_name(unit_uv,unit_uv%prog)
    buffer%prognames(unit_fov%code)  = cubetools_unit_name(unit_fov,unit_fov%prog)
    buffer%prognames(unit_pang%code) = cubetools_unit_name(unit_pang,unit_pang%prog)
    buffer%prognames(unit_beam%code) = cubetools_unit_name(unit_beam,unit_beam%prog)
    buffer%prognames(unit_freq%code) = cubetools_unit_name(unit_freq,unit_freq%prog)
    buffer%prognames(unit_velo%code) = cubetools_unit_name(unit_velo,unit_velo%prog)
    buffer%prognames(unit_wave%code) = cubetools_unit_name(unit_wave,unit_wave%prog)
    buffer%prognames(unit_chan%code) = cubetools_unit_name(unit_chan,unit_chan%prog)
    buffer%prognames(unit_pixe%code) = cubetools_unit_name(unit_pixe,unit_pixe%prog)
    buffer%prognames(unit_dist%code) = cubetools_unit_name(unit_dist,unit_dist%prog)
    buffer%prognames(unit_unk%code)  = cubetools_unit_name(unit_unk,unit_unk%prog)
    !
    buffer%usernames(unit_uv%code)   = cubetools_unit_name(unit_uv,unit_uv%user)
    buffer%usernames(unit_fov%code)  = cubetools_unit_name(unit_fov,unit_fov%user)
    buffer%usernames(unit_pang%code) = cubetools_unit_name(unit_pang,unit_pang%user)
    buffer%usernames(unit_beam%code) = cubetools_unit_name(unit_beam,unit_beam%user)
    buffer%usernames(unit_freq%code) = cubetools_unit_name(unit_freq,unit_freq%user)
    buffer%usernames(unit_velo%code) = cubetools_unit_name(unit_velo,unit_velo%user)
    buffer%usernames(unit_wave%code) = cubetools_unit_name(unit_wave,unit_wave%user)
    buffer%usernames(unit_chan%code) = cubetools_unit_name(unit_chan,unit_chan%user)
    buffer%usernames(unit_pixe%code) = cubetools_unit_name(unit_pixe,unit_pixe%user)
    buffer%usernames(unit_dist%code) = cubetools_unit_name(unit_dist,unit_dist%user)
    buffer%usernames(unit_unk%code)  = cubetools_unit_name(unit_unk,unit_unk%user)
    !
    buffer%prog_per_user(unit_uv%code)   = cubetools_unit_pperu(unit_uv,unit_uv%user)
    buffer%prog_per_user(unit_fov%code)  = cubetools_unit_pperu(unit_fov,unit_fov%user)
    buffer%prog_per_user(unit_pang%code) = cubetools_unit_pperu(unit_pang,unit_pang%user)
    buffer%prog_per_user(unit_beam%code) = cubetools_unit_pperu(unit_beam,unit_beam%user)
    buffer%prog_per_user(unit_freq%code) = cubetools_unit_pperu(unit_freq,unit_freq%user)
    buffer%prog_per_user(unit_velo%code) = cubetools_unit_pperu(unit_velo,unit_velo%user)
    buffer%prog_per_user(unit_wave%code) = cubetools_unit_pperu(unit_wave,unit_wave%user)
    buffer%prog_per_user(unit_chan%code) = cubetools_unit_pperu(unit_chan,unit_chan%user)
    buffer%prog_per_user(unit_pixe%code) = cubetools_unit_pperu(unit_pixe,unit_pixe%user)
    buffer%prog_per_user(unit_dist%code) = cubetools_unit_pperu(unit_dist,unit_dist%user)
    buffer%prog_per_user(unit_unk%code)  = cubetools_unit_pperu(unit_unk,unit_unk%user)
    !
    buffer%user_per_prog(unit_uv%code)   = 1d0/buffer%prog_per_user(unit_uv%code)
    buffer%user_per_prog(unit_fov%code)  = 1d0/buffer%prog_per_user(unit_fov%code)
    buffer%user_per_prog(unit_pang%code) = 1d0/buffer%prog_per_user(unit_pang%code)
    buffer%user_per_prog(unit_beam%code) = 1d0/buffer%prog_per_user(unit_beam%code)
    buffer%user_per_prog(unit_freq%code) = 1d0/buffer%prog_per_user(unit_freq%code)
    buffer%user_per_prog(unit_velo%code) = 1d0/buffer%prog_per_user(unit_velo%code)
    buffer%user_per_prog(unit_wave%code) = 1d0/buffer%prog_per_user(unit_wave%code)
    buffer%user_per_prog(unit_chan%code) = 1d0/buffer%prog_per_user(unit_chan%code)
    buffer%user_per_prog(unit_pixe%code) = 1d0/buffer%prog_per_user(unit_pixe%code)
    buffer%user_per_prog(unit_dist%code) = 1d0/buffer%prog_per_user(unit_dist%code)
    buffer%user_per_prog(unit_unk%code)  = 1d0/buffer%prog_per_user(unit_unk%code)
  end subroutine cubetools_unit_buffer_defaults
  !
  subroutine cubetools_unit_buffer_debug(buffer)
    !---------------------------------------------------------------------
    ! For debugging purpose
    !---------------------------------------------------------------------
    class(unit_buffer_t), intent(inout) :: buffer
    !
    call unit_uv%debug()
    call unit_fov%debug()
    call unit_pang%debug()
    call unit_beam%debug()
    call unit_freq%debug()
    call unit_velo%debug()
    call unit_wave%debug()
    call unit_chan%debug()
    call unit_pixe%debug()
    call unit_dist%debug()
    call unit_unk%debug()
  end subroutine cubetools_unit_buffer_debug
  !
  subroutine cubetools_unit_buffer_list(buffer,error)
    !---------------------------------------------------------------------
    ! User feedback
    !---------------------------------------------------------------------
    class(unit_buffer_t), intent(inout) :: buffer
    logical,              intent(inout) :: error
    !
    character(len=message_length) :: mess
    integer(kind=unit_k) :: iunit
    character(len=*), parameter :: rname='UNIT>SETUP>LIST'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    write(mess,'(3x,a,10x,a,9x,a,5x,a)') 'KIND','USER','INTERNAL','CONVERSION'
    call cubesyntax_message(seve%r,rname,mess)
    call cubesyntax_message(seve%r,rname,'')
    do iunit=1,nunitkinds
       write(mess,'(3x,a,2x,2(a,1x),1pg23.16)') unitkinds(iunit),buffer%usernames(iunit),&
            buffer%prognames(iunit),buffer%prog_per_user(iunit)
       call cubesyntax_message(seve%r,rname,mess)
    enddo ! iunit
  end subroutine cubetools_unit_buffer_list
  !
  function cubetools_unit_name(unit,desc)
    !-------------------------------------------------------------------
    ! Build the unit name given its description (which base unit and which
    ! magnitude)
    ! -------------------------------------------------------------------
    character(len=unit_l) :: cubetools_unit_name
    type(unit_kind_t), intent(in) :: unit
    type(unit_desc_t), intent(in) :: desc
    cubetools_unit_name = trim(desc%magnitude%prefix)//unit%name(desc%dimension)
  end function cubetools_unit_name
  !
  function cubetools_unit_pperu(unit,desc)
    !-------------------------------------------------------------------
    ! Build the conversion factor from prog to user, given the description
    ! (which base unit and which magnitude in both) cases.
    ! -------------------------------------------------------------------
    real(kind=coor_k) :: cubetools_unit_pperu
    type(unit_kind_t), intent(in) :: unit
    type(unit_desc_t), intent(in) :: desc
    !
    cubetools_unit_pperu = (desc%magnitude%factor/unit%prog%magnitude%factor) *  &
                           (unit%conv(desc%dimension)/unit%conv(unit%prog%dimension))
  end function cubetools_unit_pperu
  !
  !-----------------------------------------------------------------------
  !
  subroutine cubetools_unit_kind_alloc(kind,n,error)
    !---------------------------------------------------------------------
    ! Allocate to requested size
    !---------------------------------------------------------------------
    class(unit_kind_t),   intent(inout) :: kind
    integer(kind=unit_k), intent(in)    :: n
    logical,              intent(inout) :: error
    !
    ! No test for reallocation as this type is expected to be allocated
    ! only once
    allocate(kind%name(n),kind%keys(n),kind%vars(n),kind%conv(n))
    kind%n = n
  end subroutine cubetools_unit_kind_alloc
  !
  subroutine cubetools_unit_kind_init(kind,error)
    use cubetools_string
    !---------------------------------------------------------------------
    ! Called once at startup
    !---------------------------------------------------------------------
    class(unit_kind_t), intent(inout) :: kind
    logical,            intent(inout) :: error
    !
    integer(kind=unit_k) :: ikey
    !
    do ikey=1,kind%n
      call cubetools_string_split(kind%keys(ikey),';',kind%vars(ikey)%keys,error)
      if (error)  return
      kind%vars(ikey)%n = size(kind%vars(ikey)%keys)
    enddo
  end subroutine cubetools_unit_kind_init
  !
  subroutine cubetools_unit_kind_debug(kind)
    !---------------------------------------------------------------------
    ! For debugging purpose
    !---------------------------------------------------------------------
    class(unit_kind_t), intent(in) :: kind
    !
    integer(kind=unit_k) :: ikey,ivar
    !
    write(*,'(t3,a,t10,i0)')  'Id:',kind%code
    write(*,'(t3,a,t10,i0)')  'N:', kind%n
    do ikey=1,kind%n
      write(*,'(t3,i0,a1,t10,a)')         ikey,':',kind%name(ikey)
      write(*,'(         t10,1pg23.16)')           kind%conv(ikey)
      write(*,'(         t10,a)')                  kind%keys(ikey)
      do ivar=1,kind%vars(ikey)%n
        write(*,'(t13,i0,a1,a)')          ivar,':',kind%vars(ikey)%keys(ivar)
      enddo ! ivar
    enddo ! ikey
    write(*,*)
  end subroutine cubetools_unit_kind_debug
  !
  function cubetools_unit_kind_eq(kind1,kind2) result(equal)
    type(unit_kind_t), intent(in) :: kind1,kind2
    logical                       :: equal
    equal = kind1%code.eq.kind2%code
  end function cubetools_unit_kind_eq
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_unit_get_code(name,code,error)
    use cubetools_disambiguate
    use cubetools_brightness
    !------------------------------------------------------------------------
    ! Guess unit code based on unit name, returns unknown for unrecognized
    ! units.
    ! ---
    ! This subroutine returns only the unit code. Most (all) the uses
    ! requires to parse again the name to get a user_unit_t. Consider using
    ! cubetools_unit_get with code = code_unit_auto.
    ! ---
    ! ***JP: This is is mostly used to handle intensity units.
    ! ***JP: Work on this remains to be done!
    !------------------------------------------------------------------------
    character(len=*),     intent(in)    :: name
    integer(kind=code_k), intent(out)   :: code
    logical,              intent(inout) :: error
    !
    integer(kind=4) :: ikey
    character(len=*), parameter :: rname='UNIT>GET>CODE'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    code = unit_unk%code  ! Default if not found
    !
    if (unit_found(unit_uv))    return
    ! Angular units except for msecond are going to be returned as a
    ! FOV unit. This is a choice maybe because all angular other units
    ! are fully ambiguous between POSANG, FOV and BEAM. The choice of
    ! FOV as the main angular unit in this case is dictated by the
    ! main use case. It is left to the calling routine to disambiguate
    ! between FOV,POSANGLE and BEAM based on their specific use case.
    if (unit_found(unit_fov))   return
    if (unit_found(unit_beam))  return
    if (unit_found(unit_freq))  return
    if (unit_found(unit_velo))  return
    if (unit_found(unit_wave))  return
    if (unit_found(unit_chan))  return
    if (unit_found(unit_pixe))  return
    if (unit_found(unit_dist))  return
    !
    ! BRIGHTNESS and FLUX here
    ikey = flux_get(name)
    if (unit_found2(code_unit_flux,ikey)) return
    ikey = brightness_get(name)
    if (unit_found2(code_unit_brig,ikey)) return
    !
  contains
    !
    function unit_found(unit) result(found)
      logical :: found  ! Function value on return
      type(unit_kind_t), intent(in) :: unit
      !
      type(unit_desc_t) :: user
      !
      call cubetools_unit_parse(name,unit%vars,user)
      found = user%dimension.ne.code_unresolved
      if (found) code = unit%code
    end function unit_found
    !
    function unit_found2(thiscode,ikey) result(found)
      logical :: found  ! Function value on return
      integer(kind=code_k), intent(in) :: thiscode
      integer(kind=4),      intent(in) :: ikey
      !
      found = ikey.ne.code_unresolved
      if (found) code = thiscode
    end function unit_found2
  end subroutine cubetools_unit_get_code
  !
  subroutine cubetools_unit_parse(name,variants,desc)
    !-------------------------------------------------------------------
    ! From a unit name and a list of authorized units, return which
    ! unit is matched and its magnitude.
    ! Match on the base unit name is case-insensitive.
    ! Return desc%dimension = code_unresolved if no match. It is the
    ! choice of the caller to raise an error/warning or not if relevant.
    !-------------------------------------------------------------------
    character(len=*),     intent(in)  :: name
    type(unit_variant_t), intent(in)  :: variants(:)
    type(unit_desc_t),    intent(out) :: desc
    !
    integer(kind=4) :: lname,lunit
    integer(kind=unit_k) :: iunit,ivar
    character(len=unit_l) :: uname
    character(len=*), parameter :: rname='UNIT>PARSE'
    !
    desc%magnitude = unity
    desc%dimension = code_unresolved
    !
    uname = name
    call sic_upper(uname)
    lname = len_trim(name)
    !
    do iunit=1,size(variants)  ! For all supported units
      do ivar=1,variants(iunit)%n
        lunit = len_trim(variants(iunit)%keys(ivar))
        !
        ! If input name is too short, it can not match this unit
        if (lunit.gt.lname)  cycle
        !
        ! Check if base unit matches (upper => case-insensitive!!!)
        if (uname(lname-lunit+1:lname).ne.variants(iunit)%keys(ivar)(1:lunit))  cycle
        !
        ! Check if a valid prefix matches (case-sensitive!!!)
        if (.not.cubetools_unit_magnitude_parse(name(1:lname-lunit),desc%magnitude))  cycle
        !
        ! Found it!
        desc%dimension = iunit
        return
      enddo ! ivar
    enddo ! iunit
  end subroutine cubetools_unit_parse
  !
  subroutine cubetools_unit_get_list_for_code(code,list,error)
    use cubetools_brightness
    !------------------------------------------------------------------------
    ! Returns the list of supported units for a given kind code
    !------------------------------------------------------------------------
    integer(kind=code_k), intent(in)    :: code
    character(len=*),     allocatable   :: list(:)
    logical,              intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='UNIT>GET>LIST>FOR>CODE'
    !
    select case (code)
    case (code_unit_uv)
      list = unit_uv%name
    case (code_unit_fov)
      list = unit_fov%name
    case (code_unit_pang)
      list = unit_pang%name
    case (code_unit_beam)
      list = unit_beam%name
    case (code_unit_freq)
      list = unit_freq%name
    case (code_unit_velo)
      list = unit_velo%name
    case (code_unit_wave)
      list = unit_wave%name
    case (code_unit_chan)
      list = unit_chan%name
    case (code_unit_pixe)
      list = unit_pixe%name
    case (code_unit_dist)
      list = unit_dist%name
    case (code_unit_unk)
      list = unit_unk%name
    case default
      write(mess,'(a,i0)') 'Unknown unit code ',code
      call cubesyntax_message(seve%e,rname,mess)
      error = .true.
      return
    end select
  end subroutine cubetools_unit_get_list_for_code
  !
  function cubetools_unit_kind_prog_name(unit)
    !-------------------------------------------------------------------
    ! Return the name of the program internal unit name
    !-------------------------------------------------------------------
    character(len=unit_l) :: cubetools_unit_kind_prog_name
    class(unit_kind_t), intent(in) :: unit
    cubetools_unit_kind_prog_name = unitbuffer%prognames(unit%code)  ! Pre-computed
  end function cubetools_unit_kind_prog_name
  !
  function cubetools_unit_buffer_prog_name(buffer,code)
    !-------------------------------------------------------------------
    ! Return the name of the program internal unit name
    !-------------------------------------------------------------------
    character(len=unit_l) :: cubetools_unit_buffer_prog_name
    class(unit_buffer_t), intent(in) :: buffer
    integer(kind=code_k), intent(in) :: code
    cubetools_unit_buffer_prog_name = buffer%prognames(code)  ! Pre-computed
  end function cubetools_unit_buffer_prog_name
end module cubetools_unit_setup
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_unit
  use cubetools_parameters
  use cubesyntax_messaging
  use cubetools_unit_magnitude
  use cubetools_unit_setup
  !
  ! Constants
  public :: code_unit_uv
  public :: code_unit_fov
  public :: code_unit_pang
  public :: code_unit_beam
  public :: code_unit_velo
  public :: code_unit_freq
  public :: code_unit_wave
  public :: code_unit_dist
  public :: code_unit_chan
  public :: code_unit_pixe
  public :: code_unit_unk
  public :: code_unit_brig
  public :: code_unit_flux
  ! Types
  public :: unit_user_t
  public :: cubetools_unit_set!,cubetools_unit_get_code
  !
  private
  !
  type unit_t
     type(unit_desc_t),          private :: desc                 ! Unit and magnitude description
     character(len=unit_l),      public  :: name = strg_unk      ! Unit name
     real(kind=coor_k),          public  :: user_per_prog = 1d0  ! Conversion factor
     real(kind=coor_k),          public  :: prog_per_user = 1d0  ! Reverse conversion factor
     type(unit_kind_t), pointer, public  :: kind => null()       ! Associated kind
   contains
     procedure, public  :: list               => cubetools_unit_list
     procedure, public  :: is_consistent_with => cubetools_unit_is_consistent_with
  end type unit_t
  !
  type, extends(unit_t) :: unit_user_t
   contains
     procedure, public :: get_from_name          => cubetools_unit_user_get_from_name
     procedure, public :: get_from_code          => cubetools_unit_user_get_from_code
     procedure, public :: get_from_name_for_code => cubetools_unit_user_get_from_name_for_code
  end type unit_user_t
  !
!!$  type, extends(unit_t) unit_prog_t
!!$   contains
!!$     procedure, public  :: get_from_code => cubetools_unit_prog_get_from_code
!!$  end type unit_prog_t
  !
contains
  !  
  subroutine cubetools_unit_list(user,error)
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    class(unit_t), intent(in)    :: user
    logical,       intent(inout) :: error
    !
    character(len=message_length) :: mess
    character(len=*), parameter :: rname='UNIT>LIST'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    write(mess,'(3x,a,2x,a,2x,2(1pg23.16,1x))') unitkinds(user%kind%code),user%name,user%user_per_prog,user%prog_per_user
    call cubesyntax_message(seve%r,rname,mess)
  end subroutine cubetools_unit_list
  !
  subroutine cubetools_unit_is_consistent_with(unit1,unit2,error)
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    class(unit_t), intent(in)    :: unit1
    class(unit_t), intent(in)    :: unit2
    logical,       intent(inout) :: error
    !
    character(len=message_length) :: mess
    character(len=*), parameter :: rname='UNIT>IS>CONSISTENT>WITH'
    !
    if (unit1%kind%code.ne.unit2%kind%code) then
       write(mess,'(a,x,a,2x,a)') 'Inconsistent unit kinds:',unit1%name,unit2%name
       call cubesyntax_message(seve%e,rname,mess)
       error = .true.
       return
    endif
  end subroutine cubetools_unit_is_consistent_with
  !
  !-----------------------------------------------------------------------
  !
  subroutine cubetools_unit_user_get_from_name(user,name,error)
    !------------------------------------------------------------------------
    ! Fill the output unit_user_t structure by parsing the given name
    !------------------------------------------------------------------------
    class(unit_user_t), intent(out)   :: user
    character(len=*),   intent(in)    :: name
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='UNIT>USER>GET>NAME'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    user%kind => unit_unk  ! Default if not found
    !
    if (unit_found(unit_uv))    return
    ! Angular units except for msecond are going to be returned as a
    ! FOV unit. This is a choice maybe because all angular other units
    ! are fully ambiguous between FOV, BEAM and POSANGLE. The choice of
    ! FOV as the main angular unit in this case is dictated by the
    ! main use case. It is left to the calling routine to disambiguate
    ! between FOV, BEAM, and POSANGLE based on their specific use case.
    if (unit_found(unit_fov))   return
    if (unit_found(unit_beam))  return
    if (unit_found(unit_freq))  return
    if (unit_found(unit_velo))  return
    if (unit_found(unit_wave))  return
    if (unit_found(unit_chan))  return
    if (unit_found(unit_pixe))  return
    if (unit_found(unit_dist))  return
    !
    ! BRIGHTNESS and FLUX not yet supported
    !
  contains
    !
    function unit_found(unit) result(found)
      logical :: found  ! Function value on return
      type(unit_kind_t), intent(in), target :: unit
      !
      call cubetools_unit_parse(name,unit%vars,user%desc)
      found = .false.
      if (user%desc%dimension.ne.code_unresolved) then
        found = .true.
        user%name          = cubetools_unit_name(unit,user%desc)
        user%prog_per_user = cubetools_unit_pperu(unit,user%desc)
        user%user_per_prog = 1d0/user%prog_per_user
        user%kind          => unit
      endif
    end function unit_found
  end subroutine cubetools_unit_user_get_from_name
  !
  subroutine cubetools_unit_user_get_from_code(user,code,error)
    !---------------------------------------------------------------------
    ! Fill the output unit_user_t structure according to current user
    ! unit.
    !---------------------------------------------------------------------
    class(unit_user_t),   intent(out)   :: user
    integer(kind=code_k), intent(in)    :: code
    logical,              intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='UNIT>USER>GET>FROM>CODE'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    if (code.lt.0 .or. code.gt.nunitkinds) then
       write(mess,'(a,i0)') 'Unknown unit code ',code
       call cubesyntax_message(seve%e,rname,mess)
       error = .true.
       return
    endif
    !
    user%desc = unitbuffer%current(code)
    user%name = unitbuffer%usernames(code)              ! From pre-computed
    user%user_per_prog = unitbuffer%user_per_prog(code) ! From pre-computed
    user%prog_per_user = unitbuffer%prog_per_user(code) ! From pre-computed
    user%kind => unitbuffer%kind(code)
  end subroutine cubetools_unit_user_get_from_code
  !
  subroutine cubetools_unit_user_get_from_name_for_code(user,name,code,error)
    !---------------------------------------------------------------------
    ! Parse the given unit name for given code (e.g. parse 'marcsec' for
    ! code_fov).
    ! This subroutine is useful when user gives an explicit unit which
    ! overrides the user current default.
    !---------------------------------------------------------------------
    class(unit_user_t),   intent(out)   :: user
    character(len=*),     intent(in)    :: name
    integer(kind=code_k), intent(in)    :: code
    logical,              intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='UNIT>USER>GET>FROM>NAME>OR>CODE'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    if (name.eq.strg_star .or. name.eq.strg_equal) then
      ! If user provides a * or a = (explicit or implicit), return its
      ! default current unit.
      call user%get_from_code(code,error)
      return
    endif
    !
    select case(code)
    case (code_unit_uv:code_unit_dist)
      call cubetools_unit_parse(name,unitbuffer%kind(code)%vars,user%desc)
      if (user%desc%dimension.ne.code_unresolved) then
        user%name          = cubetools_unit_name(unitbuffer%kind(code),user%desc)
        user%prog_per_user = cubetools_unit_pperu(unitbuffer%kind(code),user%desc)
        user%user_per_prog = 1d0/user%prog_per_user
        user%kind          => unitbuffer%kind(code)
      endif
   case (code_unit_unk)
      ! *** JP: user may know better the unit than the program
      ! call cubesyntax_message(seve%w,rname,'UNKNOWN unit code')
      user%desc%dimension = 1
      user%desc%magnitude = unity
      ! user%name           = cubetools_unit_name(unit_unk,user%desc)
      user%name           = name
      user%prog_per_user  = cubetools_unit_pperu(unit_unk,user%desc)
      user%user_per_prog  = 1d0/user%prog_per_user
      user%kind           => unit_unk
    case default
      write(mess,'(a,i0)') 'Unknown unit kind code ',code
      call cubesyntax_message(seve%e,rname,mess)
      error = .true.
      return
    end select
    !
    if (user%desc%dimension.eq.code_unresolved) then
      ! Nothing found
      call cubesyntax_message(seve%e,rname,trim(name)//' is not a valid unit')
      error = .true.
      return
    endif
  end subroutine cubetools_unit_user_get_from_name_for_code
  !
  subroutine cubetools_unit_set(name,code,error)
    use gkernel_interfaces
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    character(len=*),     intent(in)    :: name
    integer(kind=code_k), intent(in)    :: code
    logical,              intent(inout) :: error
    !
    type(unit_user_t) :: user
    character(len=*), parameter :: rname='UNIT>SET'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    call user%get_from_name_for_code(name,code,error)
    if (error) return
    !
    unitbuffer%current(code)       = user%desc
    unitbuffer%usernames(code)     = user%name
    unitbuffer%prog_per_user(code) = user%prog_per_user
    unitbuffer%user_per_prog(code) = user%user_per_prog
  end subroutine cubetools_unit_set
end module cubetools_unit
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
