!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeedit_putheader
  use cubetools_structure
  use cubetools_keywordlist_types
  use cubetools_header_array_types
  use cubetools_spatial_types
  use cubetools_spectral_prog_types
  use cubetools_spectral_frame_types
  use cubetools_spectral_velocity_types
  use cubetools_spectral_redshift_types
  use cubetools_spectral_line_types
  use cubetools_spectral_freq_types
  use cubetools_spectral_wave_types
  use cubetools_axset_types
  use cubetools_noise_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(noise_opt_t)              :: noise
     type(option_t),      pointer   :: axis
     type(keywordlist_comm_t), pointer   :: ax_kind
     type(observatory_opt_t)        :: obs
     type(spectral_velocity_comm_t) :: velo
     type(spectral_redshift_comm_t) :: reds
     type(spectral_line_comm_t)     :: line
     type(spectral_freq_comm_t)     :: freq
     type(spectral_wave_comm_t)     :: wave
     type(spectral_frame_comm_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(noise_user_t)             :: noise
     type(axset_axnames_user_t)     :: axnames
     type(observatory_user_t)       :: obs
     type(spectral_velocity_user_t) :: velo
     type(spectral_redshift_user_t) :: reds
     type(spectral_line_user_t)     :: line
     type(spectral_freq_user_t)     :: freq
     type(spectral_wave_user_t)     :: wave
     type(spectral_frame_user_t)    :: spefra
  end type putheader_user_t
  !
contains
  !
  subroutine cubeedit_putheader_register(comm,error)
    !----------------------------------------------------------------------
    ! Register options related to header edition
    !----------------------------------------------------------------------
    class(putheader_comm_t), intent(inout) :: comm
    logical,                 intent(inout) :: error
    !
    character(len=*), parameter :: rname='PUT>HEADER>REGISTER'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call comm%source%register(&
         'Put a new source name',&
         error)
    if (error) return
    !
    call comm%spafra%register(&
         'Put new Spatial frame information',&
         error)
    if (error) return
    !
    call comm%ptype%register(&
         'PTYPE',&
         'Put a new projection type',&
         error)
    if (error) return
    call comm%pcenter%register(&
         'PCENTER',&
         'Put a new projection center',&
         error)
    if (error) return
    call comm%pangle%register(&
         'PANGLE',&
         'Put a new projection angle',&
         error)
    if (error) return
    !
    call comm%beam%register(&
         'Put a new beam',&
         error)
    if (error) return
    !
    !----------------------------------------------------------------------
    !
    call cubetools_array_unit_register(&
         'UNIT',&
         'Put a new unit for the cube',&
         comm%unit,error)
    if (error) return
    !
    call comm%noise%register(&
         'Put new noise values',&
         error)
    if (error) return
    !
    call cubetools_axset_axis_register(&
         'AXIS',&
         'Put a new axis description for one of the current axes',&
         comm%axis,comm%ax_kind,error)
    if (error) return
    !
    call cubetools_axset_axnames_register(&
         'AXNAMES',&
         'Put new names on cube''s axes',&
         comm%axnames,error)
    if (error) return
    !
    !----------------------------------------------------------------------
    !
    call comm%obs%register(&
         'Put new observatory information',&
         error)
    if (error) return
    !
    !----------------------------------------------------------------------
    !
    call comm%line%register(&
         'Put a new line name',&
         error)
    if (error) return
    !
    call comm%velo%register(&
         'VELOCITY',&
         'Put new systemic velocity information',&
         error)
    if (error) return
    !
    call comm%reds%register(&
         'REDSHIFT',&
         'Put new systemic redshift information',&
         error)
    if (error) return
    !
    call comm%freq%register(&
         'FREQUENCY',&
         'Put new rest frequency information',&
         error)
    if (error) return
    call comm%wave%register(&
         'WAVELENGTH',&
         'Put new rest wavelength information',&
         error)
    if (error) return
    !
    call comm%spefra%register(&
         'Put new spectral frame information',&
         error)
    if (error) return
  end subroutine cubeedit_putheader_register
  !
  subroutine cubeedit_putheader_parse(comm,line,user,error)
    !-------------------------------------------------------------------
    ! Parse routine for header part of command PUT
    !-------------------------------------------------------------------
    class(putheader_comm_t), intent(in)    :: comm
    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 comm%velo%comm%present(line,dovelo,error)
    if (error) return
    call comm%reds%comm%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 comm%freq%comm%present(line,dofreq,error)
    if (error) return
    call comm%wave%comm%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 comm%source%parse(line,user%source,error)
    if (error) return
    call comm%spafra%parse(line,user%spafra,error)
    if (error) return
    call comm%ptype%parse(line,user%ptype,error)
    if (error) return
    call comm%pcenter%parse(line,user%pcenter,error)
    if (error) return
    call comm%pangle%parse(line,user%pangle,error)
    if (error) return
    call comm%beam%parse(line,user%beam,error)
    if (error) return
    !
    call cubetools_array_unit_parse(line,comm%unit,user%unit,error)
    if (error) return
    call comm%noise%parse(line,user%noise,error)
    if (error) return
    call cubetools_axset_axis_parse(line,comm%axis,user%axis,error)
    if (error) return
    call cubetools_axset_axnames_parse(line,comm%axnames,user%axnames,error)
    if (error) return
    !
    call comm%obs%parse(line,user%obs,error)
    if (error) return
    !
    call comm%velo%parse(line,user%velo,error)
    if (error) return
    call comm%reds%parse(line,user%reds,error)
    if (error) return  
    call comm%line%parse(line,user%line,error)
    if (error) return
    call comm%freq%parse(line,user%freq,error)
    if (error) return
    call comm%wave%parse(line,user%wave,error)
    if (error) return
    call comm%spefra%parse(line,user%spefra,error)
    if (error) return
  end subroutine cubeedit_putheader_parse
  !
  subroutine cubeedit_putheader_main(comm,user,cube,error)
    use cube_types
    !-------------------------------------------------------------------
    ! Main routine for header part of command PUT
    !-------------------------------------------------------------------
    class(putheader_comm_t), intent(in)    :: comm
    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 comm%source%user2prog(user%source,cube%head%spa%source,error)
    if (error) return
    call comm%spafra%user2prog(user%spafra,cube%head%spa%fra,error)
    if (error) return
    call comm%ptype%user2prog(user%ptype,cube%head%spa%pro,error)
    if (error) return
    call comm%pcenter%user2prog(cube%head%spa%fra,user%pcenter,cube%head%spa%pro,error)
    if (error) return
    call comm%pangle%user2prog(user%pangle,cube%head%spa%pro,error)
    if (error) return
    call comm%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 comm%noise%user2prog(user%noise,cube%head%arr%noi,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 comm%obs%user2prog(user%obs,cube%head%obs,error)
    if (error) return
    !
    call user%velo%toprog(comm%velo,cube%head%spe,error)
    if (error) return
    call user%reds%toprog(comm%reds,cube%head%spe,error)
    if (error) return
    call user%line%toprog(cube%head%spe,error)
    if (error) return
    call user%freq%toprog(cube%head%spe,error)
    if (error) return
    call user%wave%toprog(cube%head%spe,error)
    if (error) return
    call user%spefra%toprog(comm%spefra,cube%head%spe,error)
    if (error) return
  end subroutine cubeedit_putheader_main
end module cubeedit_putheader
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
