!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeedit_putheader
  use cubetools_structure
  use cubetools_keyword_arg
  use cubetools_header_array_types
  use cubetools_spatial_types
  use cubetools_spectral_types
  use cubetools_axset_types
  use cubetools_observatory_types
  use cubeedit_messaging
  !
  public :: putheader_comm_t,putheader_user_t
  private
  !
  type :: putheader_comm_t
     type(spatial_source_opt_t)   :: source        
     type(spafra_opt_t)           :: spafra  
     type(spapro_type_opt_t)      :: ptype
     type(spapro_center_opt_t)    :: pcenter
     type(spapro_angle_opt_t)     :: pangle
     type(beam_opt_t)             :: beam          
     type(option_t),      pointer :: unit          
     type(option_t),      pointer :: axis
     type(keyword_arg_t), pointer :: ax_kind
     type(observatory_opt_t)      :: obs
     type(spectral_velo_opt_t)    :: velo
     type(spectral_velo_opt_t)    :: reds
     type(spectral_line_opt_t)    :: line
     type(spectral_freq_opt_t)    :: freq
     type(spectral_freq_opt_t)    :: wave
     type(spectral_frame_opt_t)   :: spefra
     type(option_t),      pointer :: axnames
   contains
     procedure, public :: register => cubeedit_putheader_register
     procedure, public :: parse    => cubeedit_putheader_parse
     procedure, public :: main     => cubeedit_putheader_main
  end type putheader_comm_t
  !
  type putheader_user_t
     type(spatial_source_user_t) :: source
     type(spafra_user_t)         :: spafra
     type(spapro_type_user_t)    :: ptype
     type(spapro_center_user_t)  :: pcenter
     type(spapro_angle_user_t)   :: pangle
     type(beam_user_t)           :: beam
     type(axset_axis_user_t)     :: axis
     type(array_unit_user_t)     :: unit
     type(axset_axnames_user_t)  :: axnames
     type(observatory_user_t)    :: obs
     type(spectral_velo_user_t)  :: velo
     type(spectral_velo_user_t)  :: reds
     type(spectral_line_user_t)  :: line
     type(spectral_freq_user_t)  :: freq
     type(spectral_freq_user_t)  :: wave
     type(spectral_frame_user_t) :: spefra
  end type putheader_user_t
  !
contains
  !
  subroutine cubeedit_putheader_register(putheader,error)
    !----------------------------------------------------------------------
    ! Register options related to header edition
    !----------------------------------------------------------------------
    class(putheader_comm_t), intent(inout) :: putheader
    logical,                 intent(inout) :: error
    !
    character(len=*), parameter :: rname='PUT>HEADER>REGISTER'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call putheader%source%register(&
         'Put a new source name',&
         error)
    if (error) return
    !
    call putheader%spafra%register(&
         'Put new Spatial frame information',&
         error)
    if (error) return
    !
    call putheader%ptype%register(&
         'PTYPE',&
         'Put a new projection type',&
         error)
    if (error) return
    call putheader%pcenter%register(&
         'PCENTER',&
         'Put a new projection center',&
         error)
    if (error) return
    call putheader%pangle%register(&
         'PANGLE',&
         'Put a new projection angle',&
         error)
    if (error) return
    !
    call putheader%beam%register(&
         'Put a new beam',&
         error)
    if (error) return
    !
    !----------------------------------------------------------------------
    !
    call cubetools_array_unit_register(&
         'UNIT',&
         'Put a new unit for the cube',&
         putheader%unit,error)
    if (error) return
    !
    call cubetools_axset_axis_register(&
         'AXIS',&
         'Put a new axis description for one of the current axes',&
         putheader%axis,putheader%ax_kind,error)
    if (error) return
    !
    call cubetools_axset_axnames_register(&
         'AXNAMES',&
         'Put new names on cube''s axes',&
         putheader%axnames,error)
    if (error) return
    !
    !----------------------------------------------------------------------
    !
    call putheader%obs%register(&
         'Put new observatory information',&
         error)
    if (error) return
    !
    !----------------------------------------------------------------------
    !
    call putheader%line%register(&
         'Put a new line name',&
         error)
    if (error) return
    !
    call putheader%velo%register(&
         'VELOCITY',&
         'Put new systemic velocity information',&
         error)
    if (error) return
    !
    call putheader%reds%register(&
         'REDSHIFT',&
         'Put new systemic redshift information',&
         error)
    if (error) return
    !
    call putheader%freq%register(&
         'FREQUENCY',&
         'Put new rest frequency information',&
         error)
    if (error) return
    call putheader%wave%register(&
         'WAVELENGTH',&
         'Put new rest wavelength information',&
         error)
    if (error) return
    !
    call putheader%spefra%register(&
         'Put new spectral frame information',&
         error)
    if (error) return
  end subroutine cubeedit_putheader_register
  !
  subroutine cubeedit_putheader_parse(putheader,line,user,error)
    !-------------------------------------------------------------------
    ! Parse routine for header part of command PUT
    !-------------------------------------------------------------------
    class(putheader_comm_t), intent(in)    :: putheader
    character(len=*),        intent(in)    :: line
    type(putheader_user_t),  intent(out)   :: user
    logical,                 intent(inout) :: error
    !
    logical :: dofreq,dovelo,dowave,doreds
    character(len=*), parameter :: rname='PUT>HEADER>PARSE'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call putheader%velo%opt%present(line,dovelo,error)
    if (error) return
    call putheader%reds%opt%present(line,doreds,error)
    if (error) return
    if (dovelo.and.doreds) then
       call cubeedit_message(seve%e,rname,'Cannot change systemic velocity and redshift at the same time')
       error = .true.
       return
    endif
    call putheader%freq%opt%present(line,dofreq,error)
    if (error) return
    call putheader%wave%opt%present(line,dowave,error)
    if (error) return
    if (dofreq.and.dowave) then
       call cubeedit_message(seve%e,rname,'Cannot change rest frequency and wavelength at the same time')
       error = .true.
       return
    endif
    !
    call putheader%source%parse(line,user%source,error)
    if (error) return
    call putheader%spafra%parse(line,user%spafra,error)
    if (error) return
    call putheader%ptype%parse(line,user%ptype,error)
    if (error) return
    call putheader%pcenter%parse(line,user%pcenter,error)
    if (error) return
    call putheader%pangle%parse(line,user%pangle,error)
    if (error) return
    call putheader%beam%parse(line,user%beam,error)
    !
    if (error) return
    call cubetools_array_unit_parse(line,putheader%unit,user%unit,error)
    if (error) return
    call cubetools_axset_axis_parse(line,putheader%axis,user%axis,error)
    if (error) return
    call cubetools_axset_axnames_parse(line,putheader%axnames,user%axnames,error)
    if (error) return
    !
    call putheader%obs%parse(line,user%obs,error)
    if (error) return
    !
    call putheader%velo%parse(line,user%velo,error)
    if (error) return
    call putheader%reds%parse(line,user%reds,error)
    if (error) return  
    call putheader%line%parse(line,user%line,error)
    if (error) return
    call putheader%freq%parse(line,user%freq,error)
    if (error) return
    call putheader%wave%parse(line,user%wave,error)
    if (error) return
    call putheader%spefra%parse(line,user%spefra,error)
    if (error) return
  end subroutine cubeedit_putheader_parse
  !
  subroutine cubeedit_putheader_main(putheader,user,cube,error)
    use cube_types
    !-------------------------------------------------------------------
    ! Main routine for header part of command PUT
    !-------------------------------------------------------------------
    class(putheader_comm_t), intent(in)    :: putheader
    type(putheader_user_t),  intent(in)    :: user
    type(cube_t),            intent(inout) :: cube
    logical,                 intent(inout) :: error
    !
    character(len=*), parameter :: rname='PUT>HEADER>MAIN'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call putheader%source%user2prog(user%source,cube%head%spa%source,error)
    if (error) return
    call putheader%spafra%user2prog(user%spafra,cube%head%spa%fra,error)
    if (error) return
    call putheader%ptype%user2prog(user%ptype,cube%head%spa%pro,error)
    if (error) return
    call putheader%pcenter%user2prog(cube%head%spa%fra,user%pcenter,cube%head%spa%pro,error)
    if (error) return
    call putheader%pangle%user2prog(user%pangle,cube%head%spa%pro,error)
    if (error) return
    call putheader%beam%user2prog(user%beam,cube%head%spa%bea,error)
    if (error) return
    !
    call cubetools_array_unit_user2prog(user%unit,cube%head%arr%unit,error)
    if (error) return
    call cubetools_axset_axis_user2prog(user%axis,cube%head%set,error)
    if (error) return
    call cubetools_axset_axnames_user2prog(user%axnames,cube%head%set,error)
    if (error) return
    !
    call putheader%obs%user2prog(user%obs,cube%head%obs,error)
    if (error) return
    !
    call putheader%velo%user2prog(user%velo,cube%head%spe,error)
    if (error) return
    call putheader%reds%user2prog(user%reds,cube%head%spe,error)
    if (error) return
    call putheader%line%user2prog(user%line,cube%head%spe,error)
    if (error) return
    call putheader%freq%user2prog(user%freq,cube%head%spe,error)
    if (error) return
    call putheader%wave%user2prog(user%wave,cube%head%spe,error)
    if (error) return
    call putheader%spefra%user2prog(user%spefra,cube%head%spe%frame,error)
    if (error) return
  end subroutine cubeedit_putheader_main
end module cubeedit_putheader
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
