!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! *** JP: The notion of beam should here be generalized to the response of
! *** JP: the correlator
!
module cubetools_spectral_types
  use cubetools_parameters
  use cubetools_messaging
  use cubetools_axis_types
  use cubetools_speelt_types
  use cubetools_consistency_types
  use cubetools_header_interface
  use cubetools_structure
  use cubetools_keyword_arg
  !
  public :: spectral_t,spectral_cons_t
  public :: cubetools_spectral_init,cubetools_spectral_put_and_derive,cubetools_spectral_rederive
  public :: cubetools_spectral_final,cubetools_spectral_get
  public :: cubetools_spectral_list
  public :: cubetools_spectral_sicdef,cubetools_spectral_copy
  public :: cubetools_spectral_consistency_init,cubetools_spectral_consistency_final
  public :: cubetools_spectral_consistency_check,cubetools_spectral_consistency_print
  public :: cubetools_spectral_consistency_set_tol
  public :: cubetools_spectral_update_from_freqaxis,cubetools_spectral_update_from_veloaxis
  public :: cubetools_spectral_modify_rest_frequency,cubetools_spectral_modify_frame_velocity
  !
  ! Velocity like information, type
  public :: spectral_velo_user_t,spectral_velo_opt_t
  public :: cubetools_spectral_velo2userstruct,cubetools_spectral_reds2userstruct
  ! Line information, type
  public :: spectral_line_user_t,spectral_line_opt_t
  public :: cubetools_spectral_line2uservar
  ! Frequency like information, type
  public :: spectral_freq_user_t,spectral_freq_opt_t
  public :: cubetools_spectral_freq2userstruct,cubetools_spectral_wave2userstruct
  ! spectral frame, type
  public :: spectral_frame_user_t,spectral_frame_opt_t
  public :: cubetools_spectral_frame2uservar
  private
  !
  !---------------------------------------------------------------------
  !
  type spectral_t
     logical               :: genuine = .false. !
     integer(kind=chan_k)  :: nc = 0            ! Number of channels 
     integer(kind=code_k)  :: frame = code_speframe_unknown  ! Frame of reference
     integer(kind=code_k)  :: conv  = code_systemic_unknown  ! Convention for velocity or redshift
     character(len=line_l) :: line  = strg_unk  ! Name of the line
     type(speelt_t)        :: ref               ! Value     at reference pixel
     type(speelt_t)        :: inc               ! Increment at reference pixel
     type(axis_t)          :: c                 ! [----] Channel
     type(axis_t)          :: f                 ! [ MHz] Signal frequency
     type(axis_t)          :: i                 ! [ MHz] Image  frequency
     type(axis_t)          :: l                 ! [ mum] Wavelength
     type(axis_t)          :: v                 ! [km/s] Velocity
     type(axis_t)          :: z                 ! [----] Redshift
  end type spectral_t
  !
  !---------------------------------------------------------------------
  !
  type spectral_velo_opt_t
     type(option_t),      pointer :: opt
     type(keyword_arg_t), pointer :: unit_arg
     type(keyword_arg_t), pointer :: conv_arg
     procedure(cubetools_spectral_velo_user2prog), pointer :: user2prog => null()
   contains
     procedure :: register  => cubetools_spectral_velo_register
     procedure :: parse     => cubetools_spectral_velo_parse
  end type spectral_velo_opt_t
  !
  type spectral_velo_user_t
     character(len=argu_l) :: val         = strg_unk ! Value at reference pixel
     character(len=argu_l) :: unit        = strg_unk ! unit
     character(len=argu_l) :: convention  = strg_unk ! Convention (Optical|Radio)
     logical               :: do          = .false.  ! Option was present
  end type spectral_velo_user_t
  !
  !---------------------------------------------------------------------
  !
  type spectral_line_opt_t
     type(option_t), pointer :: opt
   contains
     procedure :: register  => cubetools_spectral_line_register
     procedure :: parse     => cubetools_spectral_line_parse
     procedure :: user2prog => cubetools_spectral_line_user2prog
  end type spectral_line_opt_t
  !
  type spectral_line_user_t
     character(len=argu_l) :: line = strg_unk ! Line name
     logical               :: do   = .false.  ! Option was present
  end type spectral_line_user_t
  !
  !---------------------------------------------------------------------
  !
  type spectral_freq_opt_t
     type(option_t),      pointer :: opt
     type(keyword_arg_t), pointer :: unit_arg
     procedure(cubetools_spectral_freq_user2prog), pointer :: user2prog => null()
   contains
     procedure :: register  => cubetools_spectral_freq_register
     procedure :: parse     => cubetools_spectral_freq_parse
  end type spectral_freq_opt_t
  !
  type spectral_freq_user_t
     character(len=argu_l) :: valsig      = strg_unk ! rest frequency|wavelength
     character(len=argu_l) :: valima      = strg_unk ! Image frequency|wavelength
     character(len=argu_l) :: unit        = strg_unk ! unit
     logical               :: do          = .false.  ! Option was present
  end type spectral_freq_user_t
  !
  !---------------------------------------------------------------------
  !
  type spectral_frame_opt_t
     type(option_t),      pointer :: opt
     type(keyword_arg_t), pointer :: type_arg
   contains
     procedure :: register  => cubetools_spectral_frame_register
     procedure :: parse     => cubetools_spectral_frame_parse
     procedure :: user2prog => cubetools_spectral_frame_user2prog
  end type spectral_frame_opt_t
  !
  type spectral_frame_user_t
     character(len=argu_l) :: type        = strg_unk ! Spectral frame type
     logical               :: do          = .false.  ! Option was present
  end type spectral_frame_user_t
  !
  !---------------------------------------------------------------------
  !
  type spectral_cons_t
     ! *** JP genuine et nc should be added here
     logical                    :: check = .true.  ! Check the section
     logical                    :: prob  = .false. ! Is there a problem
     logical                    :: mess  = .true.  ! Output message for this section?
     type(consistency_desc_t)   :: frame           ! frame Consistency
     type(consistency_desc_t)   :: conv            ! Convention Consistency
     type(consistency_desc_t)   :: line            ! line Consistency
     type(speelt_cons_t)        :: ref             ! Reference Consistency
     type(axis_cons_t)          :: c               ! channel axis consistency
     type(axis_cons_t)          :: f               ! frequency axis consistency
     type(axis_cons_t)          :: i               ! image axis consistency
     type(axis_cons_t)          :: l               ! wavelength axis consistency
     type(axis_cons_t)          :: v               ! velocity axis consistency
     type(axis_cons_t)          :: z               ! redshift axis consistency
  end type spectral_cons_t
  !
contains
  !
  subroutine cubetools_spectral_init(spe,error)
    !-------------------------------------------------------------------
    ! Just initialize the type, ie, set it to intent(out)
    !-------------------------------------------------------------------
    type(spectral_t), intent(out)   :: spe
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>INIT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_speelt_init(spe%ref,error)
    if (error) return
    call cubetools_speelt_init(spe%inc,error)
    if (error) return
    call cubetools_axis_init(spe%c,error)
    if (error) return
    call cubetools_axis_init(spe%f,error)
    if (error) return
    call cubetools_axis_init(spe%i,error)
    if (error) return
    call cubetools_axis_init(spe%l,error)
    if (error) return
    call cubetools_axis_init(spe%v,error)
    if (error) return
    call cubetools_axis_init(spe%z,error)
    if (error) return
  end subroutine cubetools_spectral_init
  !
  subroutine cubetools_spectral_put_and_derive(genuine,&
       frame_code,convention_code,line,nc,channel,&
       spectral_code,increment,signal,image,&
       systemic_code,systemic_value,&
       spe,error)
    use phys_const
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    logical,               intent(in)    :: genuine
    integer(kind=code_k),  intent(in)    :: frame_code
    integer(kind=code_k),  intent(in)    :: convention_code
    character(len=*),      intent(in)    :: line
    integer(kind=chan_k),  intent(in)    :: nc
    real(kind=coor_k),     intent(in)    :: channel
    integer(kind=code_k),  intent(in)    :: spectral_code
    real(kind=coor_k),     intent(in)    :: increment
    real(kind=coor_k),     intent(in)    :: signal
    real(kind=coor_k),     intent(in)    :: image
    integer(kind=code_k),  intent(in)    :: systemic_code
    real(kind=coor_k),     intent(in)    :: systemic_value
    type(spectral_t),      intent(inout) :: spe
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>PUT>AND>DERIVE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    !
    spe%line = line
    spe%frame = frame_code
    !
    spe%ref%c = channel
    spe%inc%c = 1d0
    !
    if (spectral_code.eq.code_spectral_frequency) then
       spe%ref%f = signal
       spe%ref%i = image
       spe%ref%l = clight/spe%ref%f
       !
       spe%inc%f = increment
       spe%inc%i = -spe%inc%f
       spe%inc%l = -spe%ref%l*(spe%inc%f/spe%ref%f)
    else if (spectral_code.eq.code_spectral_wavelength) then
       call cubetools_message(seve%w,rname,'Experimental support wavelengths => Things might still be incorrect')
       spe%ref%l = signal
       spe%ref%i = image
       spe%ref%f = clight/spe%ref%l
       !
       spe%inc%l = increment
       spe%inc%i = -spe%inc%l
       spe%inc%f = -spe%ref%f*(spe%inc%l/spe%ref%l)
    else if (spectral_code.eq.code_spectral_unknown) then
       spe%ref%f = 0
       spe%ref%i = 0
       spe%ref%l = 0
       !
       spe%inc%f = 0
       spe%inc%i = 0
       spe%inc%l = 0
    else
       call cubetools_message(seve%e,rname,'CUBE only handles frequencies or wavelengths')
       error = .true.
       return
    endif
    !
    spe%conv = convention_code
    if (systemic_code.eq.code_systemic_velocity) then
       spe%ref%v = systemic_value
       if (convention_code.eq.code_speconv_radio) then
          spe%ref%z = spe%ref%v/clight_kms
          !
          spe%inc%v = -clight_kms*spe%inc%f/spe%ref%f
          spe%inc%z = spe%inc%v/clight_kms
       else
          call cubetools_message(seve%e,rname,'CUBE format can only handle the radio convention')
          error = .true.
          return
       endif
    else if (systemic_code.eq.code_systemic_redshift) then
       call cubetools_message(seve%e,rname,'CUBE format can only handle the source frame velocity, not yet its redshift')
       error = .true.
       return
    else if (systemic_code.eq.code_systemic_unknown) then
       spe%conv = code_speconv_unknown
       spe%ref%z = 0
       !
       spe%inc%v = 0
       spe%inc%z = 0
    else
       call cubetools_message(seve%e,rname,'CUBE only handles velocity or redshift')
       error = .true.
       return
    endif
    !
    call cubetools_spectral_derive_axes(genuine,nc,spe,error)
    if (error) return
  end subroutine cubetools_spectral_put_and_derive
  !
  subroutine cubetools_spectral_get(spe,&
       frame,convention,line,spectral_code,increment,signal,image,&
       systemic_code,systemic_value,&
       error)
    use cubetools_header_interface
    !-------------------------------------------------------------------
    ! Parameters that are redundant elsewhere in the header type are not
    ! accessible through this method
    !-------------------------------------------------------------------
    type(spectral_t),      intent(in)    :: spe
    integer(kind=code_k),  intent(out)   :: frame
    integer(kind=code_k),  intent(out)   :: convention
    character(len=*),      intent(out)   :: line
    integer(kind=code_k),  intent(out)   :: spectral_code
    real(kind=coor_k),     intent(out)   :: increment
    real(kind=coor_k),     intent(out)   :: signal
    real(kind=coor_k),     intent(out)   :: image
    integer(kind=code_k),  intent(out)   :: systemic_code
    real(kind=coor_k),     intent(out)   :: systemic_value
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>GET'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    frame = spe%frame
    convention = spe%conv
    line = spe%line
    spectral_code = code_spectral_frequency
    increment = spe%inc%f
    signal = spe%ref%f
    image = spe%ref%i
    systemic_code = code_systemic_velocity
    systemic_value = spe%ref%v
  end subroutine cubetools_spectral_get
  !
  subroutine cubetools_spectral_rederive(spe,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(spectral_t), intent(inout) :: spe
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>REDERIVE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_spectral_derive_axes(spe%genuine,spe%nc,spe,error)
    if (error) return
  end subroutine cubetools_spectral_rederive
  !
  subroutine cubetools_spectral_final(spe,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(spectral_t), intent(inout) :: spe
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>FINAL'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    spe%frame = code_speframe_unknown
    spe%conv  = code_speconv_unknown
    spe%line  = strg_unk
    call cubetools_speelt_final(spe%ref,error)
    if (error) return
    call cubetools_speelt_final(spe%inc,error)
    if (error) return
    call cubetools_axis_final(spe%c,error)
    call cubetools_axis_final(spe%f,error)
    call cubetools_axis_final(spe%i,error)
    call cubetools_axis_final(spe%l,error)
    call cubetools_axis_final(spe%v,error)
    call cubetools_axis_final(spe%z,error)
  end subroutine cubetools_spectral_final
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_spectral_list(spe,error)
    use cubetools_format
    use cubetools_header_interface
    use cubetools_unit
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(spectral_t), intent(in)    :: spe
    logical,          intent(inout) :: error
    !
    integer(kind=code_k) :: iframe,iconv
    type(unit_user_t) :: unitvelo, unitfreq
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='SPECTRAL>LIST'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    iframe = spe%frame
    if ((iframe.lt.1).or.(iframe.gt.nspeframes)) iframe = code_speframe_unknown
    iconv  = spe%conv
    if ((iconv.lt.1).or.(iconv.gt.nspeconv)) iframe = code_speconv_unknown
    mess = cubetools_format_stdkey_boldval('','',22)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Frame',speframes(iframe),22)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Convention',speconvnames(iconv),22)
    call cubetools_message(seve%r,rname,mess)
    !
    call cubetools_unit_get(strg_star,code_unit_freq,unitfreq,error)
    if (error) return
    call cubetools_unit_get(strg_star,code_unit_velo,unitvelo,error)
    if (error) return
    mess = cubetools_format_stdkey_boldval('Line',spe%line,22)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Rest',spe%ref%f*unitfreq%user_per_prog,'f15.6',22)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Vsys',spe%ref%v*unitvelo%user_per_prog,'f10.2',22)
    call cubetools_message(seve%r,rname,mess)
    !
    mess = cubetools_format_stdkey_boldval('','',22)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Image',spe%ref%i*unitfreq%user_per_prog,'f15.6',22)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Redshift',spe%ref%z,'f10.7',22)
    call cubetools_message(seve%r,rname,mess)
    call cubetools_message(seve%r,rname,' ')
  end subroutine cubetools_spectral_list
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_spectral_velo_register(velo,name,abstract,error)
    use cubetools_unit
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Register a /VELOCITY|REDSHIFT option under a given name and
    ! abstract
    !----------------------------------------------------------------------
    class(spectral_velo_opt_t), intent(out)   :: velo
    character(len=*),           intent(in)    :: name
    character(len=*),           intent(in)    :: abstract
    logical,                    intent(inout) :: error
    !
    character(len=128) :: helpstr
    type(standard_arg_t) :: stdarg
    type(keyword_arg_t)  :: keyarg
    integer(kind=4) :: ier
    character(len=unit_l), allocatable :: unitlist(:)
    !
    character(len=*), parameter :: rname='SPECTRAL>REGISTER>VELO'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    select case(name)
    case('VELOCITY')
       helpstr = 'Systemic redshift is updated accordingly'
       velo%user2prog => cubetools_spectral_velo_user2prog
       allocate(unitlist(size(unit_velo_name)),stat=ier)
       if (failed_allocate(rname,'Velocity unit list',ier,error)) return
       unitlist(:) = unit_velo_name(:)
    case('REDSHIFT')
       helpstr = 'Systemic velocity is updated accordingly'
       velo%user2prog => cubetools_spectral_reds_user2prog
       allocate(unitlist(size(unit_unk_name)),stat=ier)
       if (failed_allocate(rname,'Unknown unit list',ier,error)) return
       unitlist(:) = unit_unk_name(:)
    case default
       call cubetools_message(seve%e,rname,"Can only register&
            & VELOCITY or REDSHIFT options")
       error = .true.
       return
    end select
    !
    call cubetools_register_option(&
         name,'value [unit [convention]]',&
         abstract,&
         helpstr,&
         velo%opt,error)
    if (error) return
    call stdarg%register( &
         'value',  &
         'Reference value', &
         '"*" or "=" mean previous value is kept',&
         code_arg_mandatory, &
         error)
    if (error) return   
    call keyarg%register( &
         'unit',  &
         'Unit', &
         '"=" or "*" mean current unit',&
         code_arg_optional,&
         unitlist, &
         .not.flexible, &
         velo%unit_arg, &
         error)
    if (error) return
    call keyarg%register( &
         'convention',  &
         'Convention type', &
         '"=" mean previous value is kept, * means RADIO. Currently&
         & only RADIO is properly supported',&
         code_arg_optional,&
         speconvnames, &
         .not.flexible, &
         velo%conv_arg, &
         error)
    if (error) return
  end subroutine cubetools_spectral_velo_register
  !
  subroutine cubetools_spectral_velo_parse(velo,line,user,error)
    !----------------------------------------------------------------------
    ! Parse velocity like information 
    ! /VELO|REDS val [convention]
    ! ----------------------------------------------------------------------
    class(spectral_velo_opt_t), intent(in)    :: velo
    character(len=*),           intent(in)    :: line
    type(spectral_velo_user_t), intent(out)   :: user
    logical,                    intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>VELO>PARSE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Convention should not be changed if user has not given a value
    user%val        = strg_star
    user%unit       = strg_equal
    user%convention = strg_equal
    !
    call velo%opt%present(line,user%do,error)
    if (error) return
    if (user%do) then
       call cubetools_getarg(line,velo%opt,1,user%val,mandatory,error)
       if (error)  return
       call cubetools_getarg(line,velo%opt,2,user%unit,.not.mandatory,error)
       if (error)  return
       call cubetools_getarg(line,velo%opt,3,user%convention,.not.mandatory,error)
       if (error)  return
    endif
  end subroutine cubetools_spectral_velo_parse
  !
  subroutine cubetools_spectral_velo_user2prog(velo,user,prog,error)    
    use phys_const
    use cubetools_unit
    use cubetools_user2prog
    !----------------------------------------------------------------------
    ! user2prog a spectral_user_t
    !----------------------------------------------------------------------
    class(spectral_velo_opt_t), intent(in)    :: velo
    type(spectral_velo_user_t), intent(in)    :: user
    type(spectral_t),           intent(inout) :: prog
    logical,                    intent(inout) :: error
    !
    type(unit_user_t) :: unit
    integer(kind=code_k) :: prev, def
    real(kind=coor_k) :: default, previous
    character(len=*), parameter :: rname='SPECTRAL>VELO>USER2PROG'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (user%do) then
       call cubetools_unit_get(user%unit,code_unit_velo,unit,error)
       if (error) return
       default = prog%ref%v
       previous = prog%ref%v
       call cubetools_user2prog_resolve_all(user%val,unit,default,previous,prog%ref%v,error)
       if (error) return
       prog%ref%z = prog%ref%v/clight_kms
       !
       def = code_speconv_radio
       prev = prog%conv
       call cubetools_user2prog_resolve_code(velo%conv_arg,user%convention,def,prev,prog%conv,error)
       if (error) return
    endif
  end subroutine cubetools_spectral_velo_user2prog
  !
  subroutine cubetools_spectral_reds_user2prog(velo,user,prog,error)
    use phys_const
    use cubetools_user2prog
    use cubetools_unit
    !----------------------------------------------------------------------
    ! user2prog a spectral_user_t
    !----------------------------------------------------------------------
    class(spectral_velo_opt_t), intent(in)    :: velo
    type(spectral_velo_user_t), intent(in)    :: user
    type(spectral_t),           intent(inout) :: prog
    logical,                    intent(inout) :: error
    !
    type(unit_user_t) :: nounit
    integer(kind=code_k) :: prev, def
    real(kind=coor_k) :: default, previous
    character(len=*), parameter :: rname='SPECTRAL>REDS>USER2PROG'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (user%do) then
       call cubetools_unit_get(user%unit,code_unit_unk,nounit,error)
       if (error) return
       default = prog%ref%z
       previous = prog%ref%z
       call cubetools_user2prog_resolve_all(user%val,nounit,default,previous,prog%ref%z,error)
       if (error) return
       prog%ref%v = prog%ref%z*clight_kms
       !
       def = code_speconv_radio
       prev = prog%conv
       call cubetools_user2prog_resolve_code(velo%conv_arg,user%convention,def,prev,prog%conv,error)
       if (error) return
    endif
  end subroutine cubetools_spectral_reds_user2prog
  !
  subroutine cubetools_spectral_velo_prog2user(prog,user,error)
    use cubetools_unit
    !------------------------------------------------------------------------
    ! Fills a spectral_velo_user_t with a user friendly version of the
    ! systemic velocity
    !------------------------------------------------------------------------
    type(spectral_t),           intent(in)    :: prog
    type(spectral_velo_user_t), intent(out)   :: user
    logical,                    intent(inout) :: error
    !
    type(unit_user_t) :: unit
    character(len=*), parameter :: rname='SPECTRAL>VELO>PROG2USER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_unit_get(strg_star,code_unit_velo,unit,error)
    if (error) return
    write(user%val,'(1pg14.7)') prog%ref%v*unit%user_per_prog
    user%unit = unit%name
    user%convention = speconvnames(prog%conv)
  end subroutine cubetools_spectral_velo_prog2user
  !
  subroutine cubetools_spectral_reds_prog2user(prog,user,error)
    use cubetools_unit
    !------------------------------------------------------------------------
    ! Fills a spectral_velo_user_t with a user friendly version of the
    ! systemic redshift
    !------------------------------------------------------------------------
    type(spectral_t),           intent(in)    :: prog
    type(spectral_velo_user_t), intent(out)   :: user
    logical,                    intent(inout) :: error
    !
    type(unit_user_t) :: unit
    character(len=*), parameter :: rname='SPECTRAL>REDS>PROG2USER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_unit_get(strg_star,code_unit_unk,unit,error)
    if (error) return
    write(user%val,'(1pg14.7)') prog%ref%z*unit%user_per_prog
    user%unit = unit%name
    user%convention = speconvnames(prog%conv)
  end subroutine cubetools_spectral_reds_prog2user
  !
  subroutine cubetools_spectral_velo_sicdef_user(name,user,readonly,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*),           intent(in)    :: name
    type(spectral_velo_user_t), intent(in)    :: user
    logical,                    intent(in)    :: readonly
    logical,                    intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>VELO>SICDEF>USER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_defstructure(name,global,error)
    if (error) return
    call sic_def_charn(trim(name)//'%value',user%val,0,0,readonly,error)
    if (error)  return
    call sic_def_charn(trim(name)//'%unit',user%unit,0,0,readonly,error)
    if (error)  return
    call sic_def_charn(trim(name)//'%convention',user%convention,0,0,readonly,error)
    if (error)  return
  end subroutine cubetools_spectral_velo_sicdef_user
  !
  subroutine cubetools_spectral_velo2userstruct(prog,userstruct,error)
    use cubetools_userspace
    use cubetools_userstruct
    !------------------------------------------------------------------------
    ! Loads systemic velocity onto a userstructure
    !------------------------------------------------------------------------
    type(spectral_t),   intent(in)    :: prog
    class(userspace_t), intent(inout) :: userstruct
    logical,            intent(inout) :: error
    !
    type(spectral_velo_user_t) :: user
    character(len=*), parameter :: rname='SPECTRAL>VELO2USERSTRUCT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    select type(userstruct)
    type is (userstruct_t)
       call cubetools_spectral_velo_prog2user(prog,user,error)
       if (error) return
       call cubetools_spectral_velo2userstruct_sub(user,userstruct,error)
       if (error) return
    class default
       call cubetools_message(seve%e,rname,'Internal error: object has wrong type')
       error = .true.
       return
    end select
  end subroutine cubetools_spectral_velo2userstruct
  !
  subroutine cubetools_spectral_reds2userstruct(prog,userstruct,error)
    use cubetools_userspace
    use cubetools_userstruct
    !------------------------------------------------------------------------
    ! Loads systemic redshift onto a userstructure
    !------------------------------------------------------------------------
    type(spectral_t),   intent(in)    :: prog
    class(userspace_t), intent(inout) :: userstruct
    logical,            intent(inout) :: error
    !
    type(spectral_velo_user_t) :: user
    character(len=*), parameter :: rname='SPECTRAL>REDS2USERSTRUCT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    select type(userstruct)
    type is (userstruct_t)
       call cubetools_spectral_reds_prog2user(prog,user,error)
       if (error) return
       call cubetools_spectral_velo2userstruct_sub(user,userstruct,error)
       if (error) return
    class default
       call cubetools_message(seve%e,rname,'Internal error: object has wrong type')
       error = .true.
       return
    end select
  end subroutine cubetools_spectral_reds2userstruct
  !
  subroutine cubetools_spectral_velo2userstruct_sub(user,userstruct,error)
    use cubetools_userstruct
    !------------------------------------------------------------------------
    ! Loads a spectral_velo_user_t onto a userstructure
    !------------------------------------------------------------------------
    type(spectral_velo_user_t), intent(in)    :: user
    type(userstruct_t),         intent(inout) :: userstruct
    logical,                    intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>VELO2USERSTRUCT>SUB'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call userstruct%def(error)
    if (error) return
    !
    call userstruct%set_member('value',user%val,error)
    if (error) return
    call userstruct%set_member('unit',user%unit,error)
    if (error) return
    call userstruct%set_member('convention',user%convention,error)
    if (error) return
  end subroutine cubetools_spectral_velo2userstruct_sub
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_spectral_line_register(line,abstract,error)
    use cubetools_unit
    !----------------------------------------------------------------------
    ! Register the /LINE option
    !----------------------------------------------------------------------
    class(spectral_line_opt_t), intent(out)   :: line
    character(len=*),           intent(in)    :: abstract
    logical,                    intent(inout) :: error
    !
    type(standard_arg_t) :: stdarg
    character(len=*), parameter :: rname='SPECTRAL>REGISTER>LINE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         'LINE','name',&
         abstract,&
         strg_id,&
         line%opt,error)
    if (error) return
    call stdarg%register( &
         'line',  &
         'Line name', &
         '"*" or "=" mean previous value is kept',&
         code_arg_mandatory, &
         error)
    if (error) return
  end subroutine cubetools_spectral_line_register
  !
  subroutine cubetools_spectral_line_parse(line,cline,user,error)
    !----------------------------------------------------------------------
    ! Parse line information
    ! /LINE Name
    ! ----------------------------------------------------------------------
    class(spectral_line_opt_t), intent(in)    :: line   ! /LINE option
    character(len=*),           intent(in)    :: cline  ! Command line
    type(spectral_line_user_t), intent(out)   :: user
    logical,                    intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>LINE>PARSE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    user%line = strg_star
    !
    call line%opt%present(cline,user%do,error)
    if (error) return
    if (user%do) then
       call cubetools_getarg(cline,line%opt,1,user%line,mandatory,error)
       if (error)  return
    endif
  end subroutine cubetools_spectral_line_parse
  !
  subroutine cubetools_spectral_line_user2prog(line,user,prog,error)
    use cubetools_user2prog
    !----------------------------------------------------------------------
    ! user2prog a spectral_line_user_t
    !----------------------------------------------------------------------
    class(spectral_line_opt_t), intent(in)    :: line
    type(spectral_line_user_t), intent(in)    :: user
    type(spectral_t),           intent(inout) :: prog
    logical,                    intent(inout) :: error
    !
    character(len=line_l) :: default,previous
    character(len=*), parameter :: rname='SPECTRAL>LINE>USER2PROG'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (user%do) then
       if (len_trim(user%line).gt.line_l) call cubetools_message(seve%w,rname,&
            'Line name will be truncated at 12 characters')
       default = prog%line
       previous = prog%line
       call cubetools_user2prog_resolve_all(user%line,default,previous,prog%line,error)
       if (error) return
    endif
  end subroutine cubetools_spectral_line_user2prog
  !
  subroutine cubetools_spectral_line_prog2user(prog,user,error)
    !------------------------------------------------------------------------
    ! Fills a spectral_line_user_t with contents from spectral_t
    ! according to line name
    ! ------------------------------------------------------------------------
    type(spectral_t),           intent(in)    :: prog
    type(spectral_line_user_t), intent(out)   :: user
    logical,                    intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>LINE>PROG2USER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    user%line = prog%line
  end subroutine cubetools_spectral_line_prog2user
  !
  subroutine cubetools_spectral_line2uservar(prog,uservar,error)
    use cubetools_userspace
    use cubetools_uservar
    !------------------------------------------------------------------------
    ! Loads spectral line onto a user space variable
    !------------------------------------------------------------------------
    type(spectral_t),   intent(in)    :: prog
    class(userspace_t), intent(inout) :: uservar
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname = 'SPECTRAL>LINE2USERVAR'
    !
    call cubetools_message(toolseve%trace,rname,'welcome')
    !
    select type(uservar)
    type is (uservar_t)
       call uservar%set(prog%line,error)
       if (error) return
    class default
       call cubetools_message(seve%e,rname,'Internal error: object has wrong type')
       error = .true.
       return
    end select
  end subroutine cubetools_spectral_line2uservar
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_spectral_freq_register(freq,name,abstract,error)
    use cubetools_unit
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Register a /FREQUENCY|WAVELENGTH option under a given name and
    ! abstract
    !----------------------------------------------------------------------
    class(spectral_freq_opt_t), intent(out)   :: freq
    character(len=*),           intent(in)    :: name
    character(len=*),           intent(in)    :: abstract
    logical,                    intent(inout) :: error
    !
    type(standard_arg_t) :: stdarg
    type(keyword_arg_t) :: keyarg
    character(len=128) :: helpstr
    integer(kind=4) :: ier
    character(len=unit_l),allocatable :: unitlist(:)
    !
    character(len=*), parameter :: rname='SPECTRAL>REGISTER>FREQ'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    select case(name)
    case('FREQUENCY')
       helpstr = 'Spectral increments and wavelengths updated&
            & accordingly, values in current frequency unit'
       freq%user2prog => cubetools_spectral_freq_user2prog
       allocate(unitlist(size(unit_freq_name)),stat=ier)
       if (failed_allocate(rname,'Frequency unit list',ier,error)) return
       unitlist(:) = unit_freq_name(:)
    case('WAVELENGTH')
       helpstr = 'Spectral increments and frequencies updated&
            & accordingly, values in mm'
       freq%user2prog => cubetools_spectral_wave_user2prog
       allocate(unitlist(size(unit_wave_name)),stat=ier)
       if (failed_allocate(rname,'Wavelength unit list',ier,error)) return
       unitlist(:) = unit_wave_name(:)
    case default
       call cubetools_message(seve%e,rname,"Can only register&
            & WAVELENGTH or FREQUENCY options")
       error = .true.
       return
    end select
    !
    call cubetools_register_option(&
         name,'rest [image [unit]]',&
         abstract,&
         helpstr,&
         freq%opt,error)
    if (error) return
    call stdarg%register( &
         'rest',  &
         'Rest frame value', &
         '"*" or "=" mean previous value is kept',&
         code_arg_mandatory, &
         error)
    if (error) return
    call stdarg%register( &
         'image',  &
         'Image frame value', &
         '"*" or "=" mean previous value is kept',&
         code_arg_optional, &
         error)
    if (error) return
    call keyarg%register( &
         'unit',  &
         'Unit', &
         '"=" or "*" mean current unit',&
         code_arg_optional,&
         unitlist, &
         .not.flexible, &
         freq%unit_arg, &
         error)
    if (error) return
  end subroutine cubetools_spectral_freq_register
  !
  subroutine cubetools_spectral_freq_parse(freq,line,user,error)
    !----------------------------------------------------------------------
    ! Parse frequency like information
    ! /FREQ|WAVE line valsig [valima]
    ! ----------------------------------------------------------------------
    class(spectral_freq_opt_t), intent(in)    :: freq
    character(len=*),           intent(in)    :: line
    type(spectral_freq_user_t), intent(out)   :: user
    logical,                    intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>FREQ>PARSE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    user%valsig = strg_star
    user%valima = strg_star
    user%unit   = strg_equal
    !
    call freq%opt%present(line,user%do,error)
    if (error) return
    if (user%do) then
       call cubetools_getarg(line,freq%opt,1,user%valsig,mandatory,error)
       if (error)  return
       call cubetools_getarg(line,freq%opt,2,user%valima,.not.mandatory,error)
       if (error)  return
       call cubetools_getarg(line,freq%opt,3,user%unit,.not.mandatory,error)
       if (error)  return
    endif
  end subroutine cubetools_spectral_freq_parse
  !
  subroutine cubetools_spectral_freq_user2prog(freq,user,prog,error)
    use phys_const
    use cubetools_unit
    use cubetools_user2prog
    !----------------------------------------------------------------------
    ! user2prog a spectral_user_t
    !----------------------------------------------------------------------
    class(spectral_freq_opt_t), intent(in)    :: freq
    type(spectral_freq_user_t), intent(in)    :: user
    type(spectral_t),           intent(inout) :: prog
    logical,                    intent(inout) :: error
    !
    type(unit_user_t) :: unit
    real(kind=coor_k) :: default, previous
    character(len=*), parameter :: rname='SPECTRAL>FREQ>USER2PROG'
    !
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (user%do) then
       call cubetools_unit_get(user%unit,code_unit_freq,unit,error)
       if (error) return
       default = prog%ref%f
       previous = prog%ref%f
       call cubetools_user2prog_resolve_all(user%valsig,unit,default,previous,prog%ref%f,error)
       if (error) return
       prog%ref%l = clight/prog%ref%f
       prog%inc%l = -prog%ref%l*(prog%inc%f/prog%ref%f)
       prog%inc%v = -clight_kms*prog%inc%f/prog%ref%f
       !
       default = prog%ref%i
       previous = prog%ref%i
       call cubetools_user2prog_resolve_all(user%valima,unit,default,previous,prog%ref%i,error)
       if (error) return
    endif
  end subroutine cubetools_spectral_freq_user2prog
  !
  subroutine cubetools_spectral_wave_user2prog(freq,user,prog,error)
    use phys_const
    use cubetools_unit
    use cubetools_user2prog
    !----------------------------------------------------------------------
    ! user2prog a spectral_user_t
    !----------------------------------------------------------------------
    class(spectral_freq_opt_t), intent(in)    :: freq
    type(spectral_freq_user_t), intent(in)    :: user
    type(spectral_t),           intent(inout) :: prog
    logical,                    intent(inout) :: error
    !
    real(kind=coor_k) :: imagl
    type(unit_user_t) :: unit
    real(kind=coor_k) :: default, previous
    character(len=*), parameter :: rname='SPECTRAL>WAVE>USER2PROG'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (user%do) then
       call cubetools_unit_get(user%unit,code_unit_wave,unit,error)
       if (error) return
       default = prog%ref%l
       previous = prog%ref%l
       call cubetools_user2prog_resolve_all(user%valsig,unit,default,previous,prog%ref%l,error)
       if (error) return
       prog%ref%f = clight/prog%ref%l
       prog%inc%f = -prog%ref%f*(prog%inc%l/prog%ref%l)
       prog%inc%v = -clight_kms*prog%inc%f/prog%ref%f
       !
       imagl = clight/prog%ref%i
       default = imagl
       previous = imagl
       call cubetools_user2prog_resolve_all(user%valima,unit,default,previous,imagl,error)
       if (error) return
       prog%ref%i = clight/imagl
    endif
  end subroutine cubetools_spectral_wave_user2prog
  !
  subroutine cubetools_spectral_freq_prog2user(prog,user,error)
    use cubetools_unit
    !------------------------------------------------------------------------
    ! Fills a spectral_freq_user_t with contents from spectral_t
    ! according to frequency references
    ! ------------------------------------------------------------------------
    type(spectral_t),           intent(in)    :: prog
    type(spectral_freq_user_t), intent(out)   :: user
    logical,                    intent(inout) :: error
    !
    type(unit_user_t) :: unit
    character(len=*), parameter :: rname='SPECTRAL>FREQ>PROG2USER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_unit_get(strg_star,code_unit_freq,unit,error)
    if (error) return
    write(user%valsig,'(1pg14.7)') prog%ref%f*unit%user_per_prog
    write(user%valima,'(1pg14.7)') prog%ref%i*unit%user_per_prog
    user%unit = unit%name
  end subroutine cubetools_spectral_freq_prog2user
  !
  subroutine cubetools_spectral_wave_prog2user(prog,user,error)
    use phys_const
    use cubetools_unit
    !------------------------------------------------------------------------
    ! Fills a spectral_freq_user_t with contents from spectral_t
    ! according to wavelength references
    !------------------------------------------------------------------------
    type(spectral_t),           intent(in)    :: prog
    type(spectral_freq_user_t), intent(out)   :: user
    logical,                    intent(inout) :: error
    !
    type(unit_user_t) :: unit
    character(len=*), parameter :: rname='SPECTRAL>WAVE>PROG2USER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_unit_get(strg_star,code_unit_wave,unit,error)
    if (error) return
    write(user%valsig,'(1pg14.7)') prog%ref%l*unit%user_per_prog
    write(user%valima,'(1pg14.7)') clight/prog%ref%i*unit%user_per_prog
    user%unit = unit%name
  end subroutine cubetools_spectral_wave_prog2user
  !
  subroutine cubetools_spectral_freq_sicdef_user(name,user,readonly,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*),           intent(in)    :: name
    type(spectral_freq_user_t), intent(in)    :: user
    logical,                    intent(in)    :: readonly
    logical,                    intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>FREQ>SICDEF>USER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_defstructure(name,global,error)
    if (error) return
    call sic_def_charn(trim(name)//'%rest',user%valsig,0,0,readonly,error)
    if (error)  return
    call sic_def_charn(trim(name)//'%image',user%valima,0,0,readonly,error)
    if (error)  return    
    call sic_def_charn(trim(name)//'%unit',user%unit,0,0,readonly,error)
    if (error)  return
  end subroutine cubetools_spectral_freq_sicdef_user
  !
  subroutine cubetools_spectral_freq2userstruct(prog,userstruct,error)
    use cubetools_userspace
    use cubetools_userstruct
    !------------------------------------------------------------------------
    ! Loads rest frequency information onto a userstructure
    ! ------------------------------------------------------------------------
    type(spectral_t),           intent(in)    :: prog
    class(userspace_t),         intent(inout) :: userstruct
    logical,                    intent(inout) :: error
    !
    type(spectral_freq_user_t) :: user
    character(len=*), parameter :: rname='SPECTRAL>FREQ2USERSTRUCT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    select type(userstruct)
    type is (userstruct_t)
       call cubetools_spectral_freq_prog2user(prog,user,error)
       if (error) return
       call cubetools_spectral_freq2userstruct_sub(user,userstruct,error)
       if (error) return
    class default
       call cubetools_message(seve%e,rname,'Internal error: object has wrong type')
       error = .true.
       return
    end select
  end subroutine cubetools_spectral_freq2userstruct
  !
  subroutine cubetools_spectral_wave2userstruct(prog,userstruct,error)
    use cubetools_userspace
    use cubetools_userstruct
    !------------------------------------------------------------------------
    ! Loads rest wavelength information onto a userstructure
    ! ------------------------------------------------------------------------
    type(spectral_t),           intent(in)    :: prog
    class(userspace_t),         intent(inout) :: userstruct
    logical,                    intent(inout) :: error
    !
    type(spectral_freq_user_t) :: user
    character(len=*), parameter :: rname='SPECTRAL>WAVE2USERSTRUCT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    select type(userstruct)
    type is (userstruct_t)
       call cubetools_spectral_wave_prog2user(prog,user,error)
       if (error) return
       call cubetools_spectral_freq2userstruct_sub(user,userstruct,error)
       if (error) return
    class default
       call cubetools_message(seve%e,rname,'Internal error: object has wrong type')
       error = .true.
       return
    end select
  end subroutine cubetools_spectral_wave2userstruct
  !
  subroutine cubetools_spectral_freq2userstruct_sub(user,userstruct,error)
    use cubetools_userstruct
    !------------------------------------------------------------------------
    ! Loads a spectral_freq_user_t onto a userstructure
    ! ------------------------------------------------------------------------
    type(spectral_freq_user_t), intent(in)    :: user
    type(userstruct_t),         intent(inout) :: userstruct
    logical,                    intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>FREQ2USERSTRUCT>SUB'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call userstruct%def(error)
    if (error) return
    !
    call userstruct%set_member('rest',user%valsig,error)
    if (error) return
    call userstruct%set_member('image',user%valima,error)
    if (error) return
    call userstruct%set_member('unit',user%unit,error)
    if (error) return
  end subroutine cubetools_spectral_freq2userstruct_sub
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_spectral_frame_register(frame,abstract,error)
    use cubetools_header_interface
    !----------------------------------------------------------------------
    ! Register a /SPECTRALFRAME option under a given name, abstract and help
    ! into the option
    !----------------------------------------------------------------------
    class(spectral_frame_opt_t), intent(out)   :: frame
    character(len=*),            intent(in)    :: abstract
    logical,                     intent(inout) :: error
    !
    type(keyword_arg_t) :: keyarg
    !
    character(len=*), parameter :: rname='SPECTRAL>FRAME>REGISTER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         "SPECTRALFRAME",'type',&
         abstract,&
         'WARNING: Systemic velocity and redshift are not updated&
         & accordingly when the spectral frame is changed',&
         frame%opt,error)
    if (error) return
    call keyarg%register( &
         'type',  &
         'Spectral frame type', &
         strg_id,&
         code_arg_mandatory,&
         speframes,&
         .not.flexible, &
         frame%type_arg, &
         error)
    if (error) return
  end subroutine cubetools_spectral_frame_register
  !
  subroutine cubetools_spectral_frame_parse(frame,line,user,error)
    !----------------------------------------------------------------------
    ! Parse spectral frame information when the option number is set to
    ! a non absent value
    ! /SPECTRALFRAME type
    ! ----------------------------------------------------------------------
    class(spectral_frame_opt_t), intent(in)    :: frame
    character(len=*),            intent(in)    :: line
    type(spectral_frame_user_t), intent(out)   :: user
    logical,                     intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>FRAME>PARSE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    user%type = strg_equal
    !
    call frame%opt%present(line,user%do,error)
    if (error) return
    if (user%do) then
       call cubetools_getarg(line,frame%opt,1,user%type,mandatory,error)
       if (error)  return
    endif
  end subroutine cubetools_spectral_frame_parse
  !
  subroutine cubetools_spectral_frame_user2prog(frame,user,prog,error)
    use cubetools_header_interface
    use cubetools_user2prog
    !----------------------------------------------------------------------
    ! user2prog a spectral_user_t
    !----------------------------------------------------------------------
    class(spectral_frame_opt_t), intent(in)    :: frame
    type(spectral_frame_user_t), intent(in)    :: user
    integer(kind=code_k),        intent(inout) :: prog
    logical,                     intent(inout) :: error
    !
    integer(kind=code_k) :: prev,def
    character(len=*), parameter :: rname='SPECTRAL>FRAME>USER2PROG'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (user%do) then
       def = code_speframe_lsrk
       prev = prog
       call cubetools_user2prog_resolve_code(frame%type_arg,user%type,def,prev,prog,error)
       if (error) return
    endif
  end subroutine cubetools_spectral_frame_user2prog
  !
  subroutine cubetools_spectral_frame_prog2user(prog,user,error)
    use cubetools_header_interface
    !----------------------------------------------------------------------
    ! Fills a spectral_frame_user_t with information from spectral_t
    !----------------------------------------------------------------------
    type(spectral_t),            intent(in)    :: prog
    type(spectral_frame_user_t), intent(out)   :: user
    logical,                     intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>FRAME>PROG2USER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    user%type = speframes(prog%frame)
  end subroutine cubetools_spectral_frame_prog2user
  !
  subroutine cubetools_spectral_frame_sicdef_user(name,user,readonly,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*),            intent(in)    :: name
    type(spectral_frame_user_t), intent(in)    :: user
    logical,                     intent(in)    :: readonly
    logical,                     intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>FRAME>SICDEF>USER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_def_charn(trim(name),user%type,0,0,readonly,error)
    if (error)  return
  end subroutine cubetools_spectral_frame_sicdef_user
  !
  subroutine cubetools_spectral_frame2uservar(prog,uservar,error)
    use cubetools_userspace
    use cubetools_uservar
    !------------------------------------------------------------------------
    ! Loads spectral frame info onto a user variable
    !------------------------------------------------------------------------
    type(spectral_t),   intent(in)    :: prog
    class(userspace_t), intent(inout) :: uservar
    logical,            intent(inout) :: error
    !
    type(spectral_frame_user_t) :: user
    character(len=*), parameter :: rname='SPECTRAL>FRAME2USERVAR'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    select type(uservar)
    type is (uservar_t)
       call cubetools_spectral_frame_prog2user(prog,user,error)
       if (error) return
       call uservar%set(user%type,error)
       if (error) return
    class default
       call cubetools_message(seve%e,rname,'Internal error: object has wrong type')
       error = .true.
       return
    end select
  end subroutine cubetools_spectral_frame2uservar
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_spectral_sicdef(name,spe,readonly,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: name
    type(spectral_t), intent(in)    :: spe
    logical,          intent(in)    :: readonly
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>SICDEF'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_defstructure(name,global,error)
    if (error) return
    call sic_def_inte(trim(name)//'%frame',spe%frame,0,0,readonly,error)
    if (error)  return
    call sic_def_inte(trim(name)//'%conv',spe%conv,0,0,readonly,error)
    if (error)  return
    call sic_def_charn(trim(name)//'%line',spe%line,0,0,readonly,error)
    if (error)  return
    call cubetools_speelt_sicdef(trim(name)//'%ref',spe%ref,readonly,error)
    if (error) return
    call cubetools_speelt_sicdef(trim(name)//'%inc',spe%inc,readonly,error)
    if (error) return
    call cubetools_axis_sicdef(trim(name)//'%C',spe%c,readonly,error)
    if (error) return
    call cubetools_axis_sicdef(trim(name)//'%F',spe%f,readonly,error)
    if (error) return
    call cubetools_axis_sicdef(trim(name)//'%I',spe%i,readonly,error)
    if (error) return
    call cubetools_axis_sicdef(trim(name)//'%L',spe%l,readonly,error)
    if (error) return
    call cubetools_axis_sicdef(trim(name)//'%V',spe%v,readonly,error)
    if (error) return
    call cubetools_axis_sicdef(trim(name)//'%Z',spe%z,readonly,error)
    if (error) return
  end subroutine cubetools_spectral_sicdef
  !
  subroutine cubetools_spectral_copy(in,ou,error)
    !-------------------------------------------------------------------
    ! Copy spectral section from one cube to another
    !-------------------------------------------------------------------
    type(spectral_t), intent(in)    :: in
    type(spectral_t), intent(inout) :: ou
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>COPY'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ou%genuine = in%genuine
    ou%nc = in%nc
    ou%frame = in%frame
    ou%conv = in%conv
    ou%line = in%line 
    call cubetools_speelt_copy(in%ref,ou%ref,error)
    if (error) return
    call cubetools_speelt_copy(in%inc,ou%inc,error)
    if (error) return
    call cubetools_axis_copy(in%c,ou%c,error)
    if (error) return
    call cubetools_axis_copy(in%f,ou%f,error)
    if (error) return
    call cubetools_axis_copy(in%i,ou%i,error)
    if (error) return
    call cubetools_axis_copy(in%l,ou%l,error)
    if (error) return
    call cubetools_axis_copy(in%v,ou%v,error)
    if (error) return
    call cubetools_axis_copy(in%z,ou%z,error)
    if (error) return
  end subroutine cubetools_spectral_copy
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_spectral_consistency_init(cons,error)
    !-------------------------------------------------------------------
    ! Init the consistency between two spectral sections
    !-------------------------------------------------------------------
    type(spectral_cons_t), intent(out)   :: cons
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>CONSISTENCY>INIT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_init(notol,check,mess,cons%frame,error)
    if (error) return
    call cubetools_consistency_init(notol,check,mess,cons%conv,error)
    if (error) return
    call cubetools_consistency_init(notol,check,mess,cons%line,error)
    if (error) return
    call cubetools_speelt_consistency_init(cons%ref,error)
    if (error) return
    call cubetools_axis_consistency_init(cons%c,error)
    if (error) return
    call cubetools_axis_consistency_init(cons%f,error)
    if (error) return
    call cubetools_axis_consistency_init(cons%v,error)
    if (error) return
    call cubetools_axis_consistency_init(cons%i,error)
    if (error) return
    call cubetools_axis_consistency_init(cons%l,error)
    if (error) return
    call cubetools_axis_consistency_init(cons%z,error)
    if (error) return
  end subroutine cubetools_spectral_consistency_init
  !
  subroutine cubetools_spectral_consistency_set_tol(spetol,cons,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    real(kind=tole_k),     intent(in)    :: spetol
    type(spectral_cons_t), intent(inout) :: cons
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>CONSISTENCY>SET>TOL'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_speelt_consistency_set_tol(spetol,cons%ref,error)
    if (error) return
    call cubetools_axis_consistency_set_tol(spetol,cons%c,error)
    if (error) return
    call cubetools_axis_consistency_set_tol(spetol,cons%f,error)
    if (error) return
    call cubetools_axis_consistency_set_tol(spetol,cons%v,error)
    if (error) return
    call cubetools_axis_consistency_set_tol(spetol,cons%i,error)
    if (error) return
    call cubetools_axis_consistency_set_tol(spetol,cons%l,error)
    if (error) return
    call cubetools_axis_consistency_set_tol(spetol,cons%z,error)
    if (error) return  
  end subroutine cubetools_spectral_consistency_set_tol
  !
  subroutine cubetools_spectral_consistency_check(cons,spe1,spe2,error)
    !-------------------------------------------------------------------
    ! Check the consistency between two spectral sections
    !-------------------------------------------------------------------
    type(spectral_cons_t), intent(inout) :: cons
    type(spectral_t),      intent(in)    :: spe1
    type(spectral_t),      intent(in)    :: spe2
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>CONSISTENCY>CHECK'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    call cubetools_consistency_integer_check(cons%frame,spe1%frame,spe2%frame,error)
    if (error) return
    call cubetools_consistency_integer_check(cons%conv,spe1%conv,spe2%conv,error)
    if (error) return
    call cubetools_consistency_string_check(cons%line,spe1%line,spe2%line,error)
    if (error) return
    call cubetools_speelt_consistency_check(cons%ref,spe1%inc,spe1%ref,spe2%inc,spe2%ref,error)
    if (error) return
    call cubetools_axis_consistency_check(cons%c,spe1%c,spe2%c,error)
    if (error) return
    call cubetools_axis_consistency_check(cons%f,spe1%f,spe2%f,error)
    if (error) return
    call cubetools_axis_consistency_check(cons%v,spe1%v,spe2%v,error)
    if (error) return
    call cubetools_axis_consistency_check(cons%i,spe1%i,spe2%i,error)
    if (error) return
    call cubetools_axis_consistency_check(cons%l,spe1%l,spe2%l,error)
    if (error) return
    call cubetools_axis_consistency_check(cons%z,spe1%z,spe2%z,error)
    if (error) return
    !
    cons%prob = cons%frame%prob.or.cons%conv%prob.or.cons%line%prob&
         .or.cons%ref%prob.or.cons%c%prob.or.cons%f%prob&
         .or.cons%v%prob.or.cons%i%prob.or.cons%l%prob.or.cons%z%prob
    !   
  end subroutine cubetools_spectral_consistency_check
  !
  subroutine cubetools_spectral_consistency_print(cons,spe1,spe2,error)
    !-------------------------------------------------------------------
    ! Print the consistency between two spectral sections
    !-------------------------------------------------------------------
    type(spectral_cons_t), intent(in)    :: cons
    type(spectral_t),      intent(in)    :: spe1
    type(spectral_t),      intent(in)    :: spe2
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>CONSISTENCY>CHECK>PRINT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (.not.cons%mess) return
    !
    call cubetools_consistency_title('spectral sections',2,cons%check,cons%prob,error)
    if(error) return
    if (cons%check.and.cons%prob) then
       call cubetools_spectral_frame_consistency_print(cons%frame,spe1%frame,spe2%frame,error)
       if (error) return
       call cubetools_spectral_convention_consistency_print(cons%conv,spe1%conv,spe2%conv,error)
       if (error) return
       call cubetools_spectral_line_consistency_print(cons%line,spe1%line,spe2%line,error)
       if (error) return
       call cubetools_speelt_consistency_print(cons%ref,spe1%ref,spe2%ref,error)
       if (error) return
       call cubetools_axis_consistency_print('Channel',cons%c,spe1%c,spe2%c,error)
       if (error) return
       call cubetools_axis_consistency_print('Frequency',cons%f,spe1%f,spe2%f,error)
       if (error) return
       call cubetools_axis_consistency_print('Image frequency',cons%i,spe1%i,spe2%i,error)
       if (error) return
       call cubetools_axis_consistency_print('Wavelength',cons%l,spe1%l,spe2%l,error)
       if (error) return
       call cubetools_axis_consistency_print('Velocity',cons%v,spe1%v,spe2%v,error)
       if (error) return
       call cubetools_axis_consistency_print('Redshift',cons%z,spe1%z,spe2%z,error)
       if (error) return
    endif
    call cubetools_message(seve%r,rname,'')
    !
  end subroutine cubetools_spectral_consistency_print
  !
  subroutine cubetools_spectral_frame_consistency_print(cons,frame1,frame2,error)
    use cubetools_header_interface
    !-------------------------------------------------------------------
    ! Print the consistency between two frames
    !-------------------------------------------------------------------
    type(consistency_desc_t), intent(in)    :: cons
    integer(kind=code_k),     intent(in)    :: frame1
    integer(kind=code_k),     intent(in)    :: frame2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>FRAME>CONSISTENCY>PRINT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (.not.cons%mess) return
    !
    call cubetools_consistency_title('spectral frames',3,cons%check,cons%prob,error)
    if(error) return
    if (cons%check.and.cons%prob) then
       call cubetools_consistency_string_print('Frames',cons,speframes(frame1),speframes(frame2),error)
       if (error) return
    endif
    call cubetools_message(seve%r,rname,'')
  end subroutine cubetools_spectral_frame_consistency_print
  !
  subroutine cubetools_spectral_convention_consistency_print(cons,conv1,conv2,error)
    use cubetools_header_interface
    !-------------------------------------------------------------------
    ! Print the consistency between two conventions
    !-------------------------------------------------------------------
    type(consistency_desc_t), intent(in)    :: cons
    integer(kind=code_k),     intent(in)    :: conv1
    integer(kind=code_k),     intent(in)    :: conv2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>CONVENTION>CONSISTENCY>PRINT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (.not.cons%mess) return
    !
    call cubetools_consistency_title('velocity conventions',3,cons%check,cons%prob,error)
    if(error) return
    if (cons%check.and.cons%prob) then
       call cubetools_consistency_string_print('Conventions',cons,speconvnames(conv1),speconvnames(conv2),error)
       if (error) return
    endif
    call cubetools_message(seve%r,rname,'')
  end subroutine cubetools_spectral_convention_consistency_print
  !
  subroutine cubetools_spectral_line_consistency_print(cons,line1,line2,error)
    !-------------------------------------------------------------------
    ! Print the consistency between two lines
    !-------------------------------------------------------------------
    type(consistency_desc_t), intent(in)    :: cons
    character(len=*),         intent(in)    :: line1
    character(len=*),         intent(in)    :: line2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>LINE>CONSISTENCY>PRINT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (.not.cons%mess) return
    !
    call cubetools_consistency_title('spectral lines',3,cons%check,cons%prob,error)
    if(error) return
    if (cons%check.and.cons%prob) then
       call cubetools_consistency_string_print('Lines',cons,line1,line2,error)
       if (error) return
    endif
    call cubetools_message(seve%r,rname,'')
  end subroutine cubetools_spectral_line_consistency_print
  !
  subroutine cubetools_spectral_consistency_final(cons,error)
    !-------------------------------------------------------------------
    ! Final the consistency between two spectral sections
    !-------------------------------------------------------------------
    type(spectral_cons_t), intent(out)   :: cons
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>CONSISTENCY>FINAL'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_final(cons%frame,error)
    if (error) return
    call cubetools_consistency_final(cons%conv,error)
    if (error) return
    call cubetools_consistency_final(cons%line,error)
    if (error) return
    call cubetools_speelt_consistency_final(cons%ref,error)
    if (error) return
    call cubetools_axis_consistency_final(cons%c,error)
    if (error) return
    call cubetools_axis_consistency_final(cons%f,error)
    if (error) return
    call cubetools_axis_consistency_final(cons%v,error)
    if (error) return
    call cubetools_axis_consistency_final(cons%i,error)
    if (error) return
    call cubetools_axis_consistency_final(cons%l,error)
    if (error) return
    call cubetools_axis_consistency_final(cons%z,error)
    if (error) return
  end subroutine cubetools_spectral_consistency_final
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_spectral_derive_axes(genuine,nc,spe,error)
    use cubetools_unit
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    logical,              intent(in)    :: genuine
    integer(kind=chan_k), intent(in)    :: nc
    type(spectral_t),     intent(inout) :: spe
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>DERIVE>AXES'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_axis_put_and_derive(&
         genuine,&
         'Channel','---',code_unit_unk,&
         nc,&
         spe%ref%c,&
         spe%ref%c,&
         spe%inc%c,&
         spe%c,error)
    call cubetools_axis_put_and_derive(&
         genuine,&
         'Frequency','MHz',code_unit_freq,&
         nc,&
         spe%ref%c,&
         spe%ref%f,&
         spe%inc%f,&
         spe%f,error)
    if (error) return
    call cubetools_axis_put_and_derive(&
         genuine,&
         'Image Freq.','MHz',code_unit_freq,&
         nc,&
         spe%ref%c,&
         spe%ref%i,&
         spe%inc%i,&
         spe%i,error)
    if (error) return
    call cubetools_axis_put_and_derive(&
         genuine,&
         'Wavelenght','um',code_unit_wave,&
         nc,&
         spe%ref%c,&
         spe%ref%l,&
         spe%inc%l,&
         spe%l,error)
    if (error) return
    call cubetools_axis_put_and_derive(&
         genuine,&
         'Velocity','km/s',code_unit_velo,&
         nc,&
         spe%ref%c,&
         spe%ref%v,&
         spe%inc%v,&
         spe%v,error)
    if (error) return
    call cubetools_axis_put_and_derive(&
         genuine,&
         'Redshift','---',code_unit_unk,&
         nc,&
         spe%ref%c,&
         spe%ref%z,&
         spe%inc%z,&
         spe%z,error)
    if (error) return
    ! Success => Fill genuinity and size
    spe%genuine = genuine
    spe%nc = nc
  end subroutine cubetools_spectral_derive_axes
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_spectral_update_from_freqaxis(axis,spe,error)
    use phys_const
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(axis_t),     intent(in)    :: axis
    type(spectral_t), intent(inout) :: spe
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>UPDATE>FROM>FREQAXIS'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    spe%genuine = .true.
    spe%nc = axis%n
    spe%ref%c = axis%ref
    spe%ref%f = axis%val
    spe%inc%f = axis%inc
    !
    ! spe%ref%i => *** JP unclear
    spe%ref%l = clight/spe%ref%f
    ! spe%ref%v => unchanged
    ! spe%ref%z => unchanged
    !
    spe%inc%i = -spe%inc%f
    spe%inc%l = -spe%ref%l*(spe%inc%f/spe%ref%f)
    spe%inc%v = -clight_kms*spe%inc%f/spe%ref%f
    spe%inc%z = spe%inc%v/clight_kms    
  end subroutine cubetools_spectral_update_from_freqaxis
  !
  subroutine cubetools_spectral_update_from_veloaxis(axis,spe,error)
    use phys_const
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(axis_t),     intent(in)    :: axis
    type(spectral_t), intent(inout) :: spe
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>UPDATE>FROM>VELOAXIS'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    spe%genuine = .true.
    spe%nc = axis%n
    spe%ref%c = axis%ref
    spe%ref%v = axis%val
    spe%inc%v = axis%inc
    !
    ! spe%ref%f => unchanged
    ! spe%ref%i => unchanged
    ! spe%ref%l => unchanged
    spe%ref%z = spe%ref%v/clight_kms
    !
    spe%inc%f = -spe%ref%f*spe%inc%v/clight_kms
    spe%inc%i = -spe%inc%f
    spe%inc%l = -spe%ref%l*(spe%inc%f/spe%ref%f)
    spe%inc%z = spe%inc%v/clight_kms    
  end subroutine cubetools_spectral_update_from_veloaxis
  !
  subroutine cubetools_spectral_modify_rest_frequency(freq,spe,error)
    use phys_const
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    real(kind=coor_k), intent(in)    :: freq
    type(spectral_t),  intent(inout) :: spe
    logical,           intent(inout) :: error
    !
    real(kind=4) :: newvelinc
    character(len=*), parameter :: rname='SPECTRAL>MODIFY>REST>FREQUENCY'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (freq.eq.spe%ref%f) return
    !
    call modify_rest_frequency(&
         freq,&      ! desired freqref
         spe%ref%c,& ! chanref
         spe%ref%f,& ! freqref
         spe%ref%i,& ! imaref
         spe%inc%f,& ! freqinc 
         newvelinc,& ! veloinc => not used because only real*4
         error)
    if (error) return    
    !
    spe%ref%l = clight/spe%ref%f
    ! spe%ref%v => unmodified
    spe%ref%z = spe%ref%v/clight_kms
    !
    spe%inc%i = -spe%inc%f
    spe%inc%l = -spe%ref%l*(spe%inc%f/spe%ref%f)
    spe%inc%v = -clight_kms*spe%inc%f/spe%ref%f
    spe%inc%z = spe%inc%v/clight_kms
    !
    call cubetools_spectral_rederive(spe,error)
    if (error) return
  end subroutine cubetools_spectral_modify_rest_frequency
  !
  subroutine cubetools_spectral_modify_frame_velocity(velo,spe,error)
    use phys_const
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    real(kind=coor_k), intent(in)    :: velo
    type(spectral_t),  intent(inout) :: spe
    logical,           intent(inout) :: error
    !
    real(kind=4) :: newvelref,newvelinc
    character(len=*), parameter :: rname='SPECTRAL>MODIFY>FRAME>VELOCITY'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (velo.eq.spe%ref%v) return
    !
    newvelref = real(spe%ref%v,kind=4)
    call modify_frame_velocity(&
         real(velo,kind=4),& ! desired veloref
         spe%ref%c,&         ! chanref
         spe%ref%f,&         ! freqref
         spe%inc%f,&         ! freqinc
         newvelref,&         ! veloref => not used because only real*4
         newvelinc,&         ! veloinc => not used because only real*4
         error)
    if (error) return
    spe%ref%v = real(velo,kind=8)
    !
    ! spe%ref%i => unchanged
    spe%ref%l = clight/spe%ref%f
    spe%ref%z = spe%ref%v/clight_kms
    !
    spe%inc%i = -spe%inc%f
    spe%inc%l = -spe%ref%l*(spe%inc%f/spe%ref%f)
    spe%inc%v = -clight_kms*spe%inc%f/spe%ref%f
    spe%inc%z = spe%inc%v/clight_kms
    !
    call cubetools_spectral_rederive(spe,error)
    if (error) return
  end subroutine cubetools_spectral_modify_frame_velocity
end module cubetools_spectral_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
