!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_modify
  use cubetools_parameters
  use cubetools_structure
  use cubetools_keywordlist_types
  use cube_types
  use cubeadm_cubeid_types
  use cubeadm_cubeprod_types
  use cubetopology_speline_types
  use cubetopology_spevsys_types
  use cubemain_messaging
  !
  public :: modify
  private
  !
  integer(kind=4), parameter :: axsetmode_l=16
  integer(kind=4), parameter :: naxsetmodes=1
  character(len=axsetmode_l), parameter :: axsetmodes(naxsetmodes) =  &
       (/ 'IGNOREDEGENERATE' /)
  integer(kind=4), parameter :: nrefspecaxes = 4
  character(len=*), parameter :: refspecaxes(nrefspecaxes) = &
       ['FREQUENCY ','WAVELENGTH','VELOCITY  ','REDSHIFT  ']
  integer(kind=4), parameter :: ifreq = 1
  integer(kind=4), parameter :: iwave = 2
  integer(kind=4), parameter :: ivelo = 3
  integer(kind=4), parameter :: ireds = 4
  !
  type :: modify_comm_t
     type(option_t),      pointer :: comm
     type(cubeid_arg_t),  pointer :: incube
     type(speline_opt_t)          :: freq
     type(spevsys_opt_t)          :: vsys
     type(option_t),      pointer :: axset
     type(keywordlist_comm_t), pointer :: axset_mode
     type(option_t),      pointer :: specaxis
     type(keywordlist_comm_t), pointer :: axis_arg
     type(option_t),      pointer :: redshift
     type(keywordlist_comm_t), pointer :: convention
     type(cube_prod_t),   pointer :: oucube
   contains
     procedure, public  :: register       => cubemain_modify_register
     procedure, private :: parse          => cubemain_modify_parse
     procedure, private :: parse_axset    => cubemain_modify_parse_axset
     procedure, private :: parse_specaxis => cubemain_modify_parse_specaxis
     procedure, private :: parse_redshift => cubemain_modify_parse_redshift
     procedure, private :: main           => cubemain_modify_main
  end type modify_comm_t
  type(modify_comm_t) :: modify
  !
  type modify_user_t
     type(cubeid_user_t)   :: cubeids
     logical               :: dospecaxis
     character(len=16)     :: specaxis
     type(speline_user_t)  :: freq
     type(spevsys_user_t)  :: vsys
     logical               :: doignoredegenerate
     logical               :: doredshift
     character(len=argu_l) :: redshift
     character(len=argu_l) :: convention
   contains
     procedure, private :: toprog => cubemain_modify_user_toprog
  end type modify_user_t
  !
  type modify_prog_t
     type(cube_t), pointer :: incube ! Input cube
     type(cube_t), pointer :: oucube ! Output cube
     type(speline_prog_t)  :: freq
     type(spevsys_prog_t)  :: vsys
     integer(kind=4)       :: ispecaxis
     real(kind=coor_k)     :: zval
     integer(kind=code_k)  :: conv_code
     logical               :: do     ! Is there something to de done?
     logical               :: dofreq
     logical               :: dovelocity
     logical               :: dospecaxis
     logical               :: doignoredegenerate
     logical               :: doredshift
   contains
     procedure, private :: header => cubemain_modify_prog_header 
  end type modify_prog_t
  !
contains
  !
  subroutine cubemain_modify_command(line,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(modify_user_t) :: user
    character(len=*), parameter :: rname='MODIFY>COMMAND'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call modify%parse(line,user,error)
    if (error) return
    call modify%main(user,error)
    if (error) return
  end subroutine cubemain_modify_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_modify_register(modify,error)
    use cubedag_allflags
    use cubetools_header_interface
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(modify_comm_t), intent(inout) :: modify
    logical,              intent(inout) :: error
    !
    !
    type(cubeid_arg_t) :: cubearg
    type(cube_prod_t) :: oucube
    type(keywordlist_comm_t) :: keyarg
    type(standard_arg_t) :: stdarg
    character(len=*), parameter :: rname='MODIFY>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'MODIFY','[cubeid]',&
         'Modify a header coherently',&
         'MODIFY applies coherent header updates and writes a modified cube.'//strg_bl//&
         'Behavior:'//strg_cr//&
         '- Supported updates are /FREQUENCY, /VSYS, /AXSET, /SPECAXIS, and&
         & /REDSHIFT.'//strg_cr//&
         '- If no modifying option is provided, MODIFY reports "Nothing to be&
         & done".'//strg_cr//&
         '- /REDSHIFT is currently under development and currently logs that no&
         & header change is applied for this option.'//strg_cr//&
         '- Use EDIT for low-level manual header fixes when incoherences must be&
         & corrected directly.'//strg_bl//&
         'Examples:'//strg_cr//&
         'CUBE> MODIFY 12co10:cube /FREQUENCY CO(1-0) 115.271 GHz'//strg_cr//&
         'CUBE> MODIFY 12co10:cube /VSYS 5 km/s /SPECAXIS VELOCITY'//strg_cr//&
         'CUBE> MODIFY 12co10:cube /AXSET IGNOREDEGENERATE',&
         cubemain_modify_command,&
         modify%comm,error)
    if (error) return
    call cubearg%register(&
         'CUBE',&
         'Signal cube',&
         'If omitted, use the last matching cube (cube flag) in the default&
         & index (DAG by default; see SET\INDEX).',&
         code_arg_optional,&
         [flag_cube],&
         code_read,&
         code_access_subset,&
         modify%incube,&
         error)
    if (error) return
    !
    call modify%freq%register(&
         'Update line name/rest frequency and keep spectral coherence',&
         error)
    if (error) return
    !
    call modify%vsys%register(&
         'Update systemic velocity and keep spectral coherence',&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'AXSET','mode',&
         'Update axes-set structure',&
         'Update axes-set structure metadata.'//strg_cr//&
         'Current mode IGNOREDEGENERATE removes degenerate axes (size 1) from&
         & the output header axes set while keeping data values unchanged.',&
         modify%axset,error)
    if (error) return
    call keyarg%register(&
         'MODE',&
         'Axes set modification mode',&
         'Accepted value: IGNOREDEGENERATE.'//strg_cr//&
         'This mode removes degenerate axes (size 1) from the output header&
         & axes set.',&
         code_arg_mandatory,&
         axsetmodes,&
         .not.flexible,&
         modify%axset_mode,&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'SPECAXIS','newaxis',&
         'Select active spectral axis representation',&
         'Set which spectral representation is used as the active spectral axis&
         & in the output header axes set.'//strg_cr//&
         'Accepted values are FREQUENCY, WAVELENGTH, VELOCITY, and REDSHIFT.',&
         modify%specaxis,error)
    if (error) return
    call keyarg%register(&
         'newaxis',&
         'Target spectral axis representation',&
         'Choose one of FREQUENCY, WAVELENGTH, VELOCITY, or REDSHIFT for the&
         & output header axes set.',&
         code_arg_mandatory,&
         refspecaxes,&
         .not.flexible,&
         modify%axis_arg,&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'REDSHIFT','z [convention]',&
         'Request systemic redshift update (under development)',&
         'Parse a systemic redshift value and an optional convention.'//strg_cr//&
         'If convention is omitted, RADIO is used.'//strg_cr//&
         '"*" for z keeps the current header redshift value.'//strg_cr//&
         'Current implementation logs a warning and does not modify the header&
         & yet.',&
         modify%redshift,error)
    if (error) return
    call stdarg%register(&
         'z',&
         'New systemic redshift',&
         'Requested systemic redshift value.'//strg_cr//&
         '"*" keeps the current header redshift value.'//strg_cr//&
         'Current implementation parses this value but does not apply header&
         & changes yet.',&
         code_arg_mandatory,&
         error)
    if (error) return
    call keyarg%register(&
         'CONVENTION',&
         'Systemic redshift convention',&
         'Convention keyword for /REDSHIFT.'//strg_cr//&
         'If omitted, RADIO is used.'//strg_cr//&
         'Current implementation parses this value but does not apply header&
         & changes yet.',&
         code_arg_optional,&
         speconvnames,&
         .not.flexible,&
         modify%convention,&
         error)
    if (error) return
    !
    ! Product
    call oucube%register(&
         'MODIFY',&
         'Modified cube',&
         strg_emp,&
         [flag_modify],&
         modify%oucube,&
         error,&
         flagmode=keep_all)
    if (error) return
  end subroutine cubemain_modify_register
  !
  subroutine cubemain_modify_parse(modify,line,user,error)
    !-------------------------------------------------------------------
    ! Parsing facility for command
    !-------------------------------------------------------------------
    class(modify_comm_t), intent(in)    :: modify
    character(len=*),     intent(in)    :: line
    type(modify_user_t),  intent(out)   :: user
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='MODIFY>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,modify%comm,user%cubeids,error)
    if (error) return
    call modify%freq%parse(line,user%freq,error)
    if (error) return
    call modify%vsys%parse(line,user%vsys,error)
    if (error) return
    call modify%parse_axset(line,user,error)
    if (error) return
    call modify%parse_specaxis(line,user,error)
    if (error) return
    call modify%parse_redshift(line,user,error)
    if (error) return
    !
    ! VVV should this be an error?
    ! if (user%vsys%do.and.user%doredshift) then
    !    error = .true.?
    ! endif
  end subroutine cubemain_modify_parse
  !
  subroutine cubemain_modify_parse_axset(modify,line,user,error)
    use cubetools_disambiguate
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(modify_comm_t), intent(in)    :: modify
    character(len=*),     intent(in)    :: line
    type(modify_user_t),  intent(inout) :: user
    logical,              intent(inout) :: error
    !
    logical :: present
    integer(kind=4) :: imode
    character(len=argu_l) :: argum
    character(len=axsetmode_l) :: mode
    character(len=*), parameter :: rname='MODIFY>PARSE>AXSET'
    !
    call modify%axset%present(line,present,error)
    if (error) return
    if (present) then
       call cubetools_getarg(line,modify%axset,1,argum,mandatory,error)
       if (error) return
       call cubetools_disambiguate_strict(argum,axsetmodes,imode,mode,error)
       if (error) return
       user%doignoredegenerate = mode.eq.'IGNOREDEGENERATE'
    else
       user%doignoredegenerate = .false.
    endif
  end subroutine cubemain_modify_parse_axset
  !
  subroutine cubemain_modify_parse_specaxis(modify,line,user,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(modify_comm_t), intent(in)    :: modify
    character(len=*),     intent(in)    :: line
    type(modify_user_t),  intent(inout) :: user
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='MODIFY>PARSE>SPECAXIS'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call modify%specaxis%present(line,user%dospecaxis,error)
    if (error) return
    if (user%dospecaxis) then
       call cubetools_getarg(line,modify%specaxis,1,user%specaxis,mandatory,error)
       if (error) return
    endif
  end subroutine cubemain_modify_parse_specaxis
  !
  subroutine cubemain_modify_parse_redshift(modify,line,user,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(modify_comm_t), intent(in)    :: modify
    character(len=*),     intent(in)    :: line
    type(modify_user_t),  intent(inout) :: user
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='MODIFY>PARSE>REDSHIFT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call modify%redshift%present(line,user%doredshift,error)
    if (error) return
    user%convention = 'RADIO'
    if (user%doredshift) then
       call cubetools_getarg(line,modify%redshift,1,user%redshift,mandatory,error)
       if (error) return
       call cubetools_getarg(line,modify%redshift,2,user%convention,.not.mandatory,error)
       if (error) return
    endif
  end subroutine cubemain_modify_parse_redshift
  !
  subroutine cubemain_modify_main(modify,user,error)
    use cubeadm_copy_tool
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(modify_comm_t), intent(in)    :: modify
    type(modify_user_t),  intent(in)    :: user
    logical,              intent(inout) :: error
    !
    type(modify_prog_t) :: prog
    character(len=*), parameter :: rname='MODIFY>MAIN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call user%toprog(prog,error)
    if (error) return
    if (prog%do) then
       call prog%header(modify,error)
       if (error) return
       call cubeadm_copy_data(prog%incube,prog%oucube,error)
       if (error) return
    else
       call cubemain_message(seve%w,rname,"Nothing to be done")
    endif
  end subroutine cubemain_modify_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_modify_user_toprog(user,prog,error)
    use cubeadm_get
    use cubetools_unit
    use cubetools_user2prog
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(modify_user_t), intent(in)    :: user
    type(modify_prog_t),  intent(out)   :: prog
    logical,              intent(inout) :: error
    !
    character(len=16) :: kind
    type(unit_user_t) :: nounit
    character(len=*), parameter :: rname='MODIFY>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Is there something to do?
    prog%do = user%freq%do      .or.  &
              user%vsys%do      .or.  &
              user%dospecaxis   .or.  &
              user%doredshift   .or.  &
              user%doignoredegenerate
    !
    ! Read CUBE if there is something to be done with it and then
    ! define the work according to the parsing
    if (prog%do) then
        call cubeadm_get_header(modify%incube,user%cubeids,prog%incube,error)
        if (error) return
        !
        if (user%freq%do) then
           call user%freq%toprog(prog%incube,prog%freq,error)
           if (error) return
           prog%dofreq = .true.
        else
           prog%dofreq = .false.
        endif
        !
        if (user%vsys%do) then
           call user%vsys%toprog(prog%incube,prog%vsys,error)
           if (error) return
           prog%dovelocity = .true.
        else
           prog%dovelocity = .false.
        endif
        !
        prog%doignoredegenerate = user%doignoredegenerate
        !
        if (user%dospecaxis) then
           call cubetools_keywordlist_user2prog(modify%axis_arg,user%specaxis,prog%ispecaxis,kind,error)
           if (error) return
           prog%dospecaxis = .true.
        else
           prog%dospecaxis = .false.
        endif
        !
        prog%doredshift = user%doredshift
        if (prog%doredshift) then
           call nounit%get_from_code(code_unit_unk,error)
           if (error) return
           call cubetools_user2prog_resolve_star(user%redshift,nounit,prog%incube%head%spe%ref%z,prog%zval,error)
           if (error) return
           call cubetools_keywordlist_user2prog(modify%convention,user%convention,prog%conv_code,kind,error)
           if (error) return
        endif
    endif
  end subroutine cubemain_modify_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_modify_prog_header(prog,comm,error)
    use cubetools_axis_types
    use cubetools_axset_types
    use cubetools_header_methods
    use cubeadm_clone
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(modify_prog_t), intent(inout) :: prog
    type(modify_comm_t),  intent(in)    :: comm
    logical,              intent(inout) :: error
    !
    type(axis_t) :: axis
    character(len=*), parameter :: rname='MODIFY>PROG>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_clone_header(comm%oucube,prog%incube,prog%oucube,error)
    if (error) return
    !
    ! Modification of frequency must be done before other
    ! modifications do guarantee correct results when multiple options
    ! are given together
    !
    if (prog%dofreq) then
       call cubetools_header_modify_rest_frequency(prog%freq%freq,prog%oucube%head,error)
       if (error) return
       call cubetools_header_put_line(prog%freq%name,prog%oucube%head,error)
       if (error) return
       call cubetools_header_get_axis_head_f(prog%oucube%head,axis,error)
       if (error) return
       call cubetools_header_update_frequency_from_axis(axis,prog%oucube%head,error)
       if (error) return
    endif
    if (prog%dovelocity) then
       call cubetools_header_modify_frame_velocity(prog%vsys%velo,prog%oucube%head,error)
       if (error) return
       call cubetools_header_get_axis_head_v(prog%oucube%head,axis,error)
       if (error) return
       call cubetools_header_update_velocity_from_axis(axis,prog%oucube%head,error)
       if (error) return
    endif
    if (prog%doredshift) then
       call cubemain_message(seve%w,rname,'Under development, nothing modified')
       ! VVV This is the series of routines I estimate necessary to acomplish the job
       !
       ! call cubetools_header_modify_frame_redshift(prog%zval,prog%oucube%head,error)
       ! if (error) return
       ! call cubetools_header_modify_convention(prog%conv_code,prog%oucube%head,error)
       ! if (error) return
       ! call cubetools_header_get_axis_head_z(prog%oucube%head,axis,error)
       ! if (error) return
       ! call cubetools_header_update_redshift_from_axis(axis,prog%oucube%head,error)
       ! if (error) return
    endif
    if (prog%doignoredegenerate) then
       call cubetools_axset_ignore_degenerate(prog%oucube%head%set,error)
       if (error) return
    endif
    if (prog%dospecaxis) then
       select case(prog%ispecaxis)
       case(ifreq)
          call cubetools_header_update_axset_c(prog%oucube%head%spe%f,prog%oucube%head,error)
          if (error) return
       case(iwave)
          call cubetools_header_update_axset_c(prog%oucube%head%spe%l,prog%oucube%head,error)
          if (error) return
       case(ivelo)
          call cubetools_header_update_axset_c(prog%oucube%head%spe%v,prog%oucube%head,error)
          if (error) return
       case(ireds)
          call cubetools_header_update_axset_c(prog%oucube%head%spe%z,prog%oucube%head,error)
          if (error) return
       case default
          call cubemain_message(seve%e,rname,'Unrecognized axis type')
          error = .true.
          return
       end select
    endif
  end subroutine cubemain_modify_prog_header
end module cubemain_modify
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
