!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! In this file, the following modules are present in this order:
!    cubetools_spectral_systemic_types
!    cubetools_spectral_v_or_z_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_spectral_systemic_types
  !------------------------------------------------------------------------
  ! Systemic velocity or redshift information
  !------------------------------------------------------------------------
  use cubetools_parameters
  use cubeheader_messaging
  use cubetools_structure
  use cubetools_unit_arg
  use cubetools_keywordlist_types
  use cubetools_header_interface
  !
  public :: spectral_systemic_comm_t,spectral_systemic_user_t,spectral_systemic_prog_t
  private
  !
  type spectral_systemic_comm_t
     type(option_t),           pointer :: comm
     type(unit_arg_t),         pointer :: unit
     type(keywordlist_comm_t), pointer :: conv
   contains
     procedure, public :: register => cubetools_spectral_systemic_comm_register
     procedure, public :: parse    => cubetools_spectral_systemic_comm_parse
  end type spectral_systemic_comm_t
  !
  type spectral_systemic_user_t
     logical               :: present = .false.  ! Is the key present?
     character(len=argu_l) :: value   = strg_unk ! Value at reference pixel
     character(len=argu_l) :: unit    = strg_unk ! unit
     character(len=argu_l) :: conv    = strg_unk ! Convention (Optical|Radio)
   contains
     procedure, public :: list => cubetools_spectral_systemic_user_list
  end type spectral_systemic_user_t
  !
  type spectral_systemic_prog_t
     integer(kind=code_k)  :: code = code_systemic_unknown ! [--------] Systemic description: velocity or redshift
     integer(kind=code_k)  :: conv = code_speconv_unknown  ! [--------] Convention for velocity or redshift
     real(kind=coor_k)     :: value = 0d0                  ! [km/s|Red] Systemic value
   contains
     procedure, public :: list => cubetools_spectral_systemic_prog_list
     procedure, public :: from => cubetools_spectral_systemic_prog_from_headinter
     procedure, public :: to   => cubetools_spectral_systemic_prog_to_headinter
  end type spectral_systemic_prog_t
  !
contains
  !
  subroutine cubetools_spectral_systemic_comm_register(comm,name,abstract,help,unit,error)
    !----------------------------------------------------------------------
    ! Register a /VELOCITY|REDSHIFT key
    !----------------------------------------------------------------------
    class(spectral_systemic_comm_t), intent(inout) :: comm
    character(len=*),                intent(in)    :: name
    character(len=*),                intent(in)    :: abstract
    character(len=*),                intent(in)    :: help
    integer(kind=code_k),            intent(in)    :: unit
    logical,                         intent(inout) :: error
    !
    type(standard_arg_t) :: stdarg
    type(unit_arg_t) :: unitarg
    type(keywordlist_comm_t) :: keyarg
    character(len=*), parameter :: rname='SPECTRAL>SYSTEMIC>COMM>REGISTER'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if ((name.ne.'VELOCITY').and.(name.ne.'REDSHIFT')) then
       call cubeheader_message(seve%e,rname,"Can only register a VELOCITY or REDSHIFT key")
       error = .true.
       return
    endif
    !
    call cubetools_register_option(&
         name,'value [unit [convention]]',&
         abstract,&
         help,&
         comm%comm,&
         error)
    if (error) return
    call stdarg%register(&
         'VALUE',&
         'Value at reference pixel',&
         '"*" or "=" mean previous value is kept',&
         code_arg_mandatory,&
         error)
    if (error) return   
    call unitarg%register(&
         'UNIT',&
         'Unit',&
         '"=" or "*" mean current user unit',&
         code_arg_optional,&
         unit,&
         comm%unit,&
         error)
    if (error) return
    call keyarg%register(&
         'CONVENTION',&
         'Convention type',&
         '"=" mean previous value is kept, * means RADIO',&
         code_arg_optional,&
         speconvnames,&
         .not.flexible,&
         comm%conv,&
         error)
    if (error) return
  end subroutine cubetools_spectral_systemic_comm_register
  !
  subroutine cubetools_spectral_systemic_comm_parse(comm,line,user,error)
    !----------------------------------------------------------------------
    ! Parse /VELOCITY|REDSHIFT value [unit [convention]}
    !----------------------------------------------------------------------
    class(spectral_systemic_comm_t), intent(in)    :: comm
    character(len=*),                intent(in)    :: line
    class(spectral_systemic_user_t), intent(inout) :: user
    logical,                         intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>SYSTEMIC>COMM>PARSE'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    user%value = strg_star
    user%unit  = strg_equal ! Unit should not be changed if user has not given a value
    user%conv  = strg_equal ! Convention should not be changed if user has not given a value
    call comm%comm%present(line,user%present,error)
    if (error) return
    if (user%present) then
       call cubetools_getarg(line,comm%comm,1,user%value,mandatory,error)
       if (error) return
       call cubetools_getarg(line,comm%comm,2,user%unit,optional,error)
       if (error) return
       call cubetools_getarg(line,comm%comm,3,user%conv,optional,error)
       if (error) return
    endif
  end subroutine cubetools_spectral_systemic_comm_parse
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_spectral_systemic_user_list(user,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(spectral_systemic_user_t), intent(in)    :: user
    logical,                         intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>SYSTEMIC>USER>LIST'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    print *,'Present:    ',user%present
    print *,'Value:      ',user%value
    print *,'Unit:       ',user%unit
    print *,'Convention: ',user%conv
  end subroutine cubetools_spectral_systemic_user_list
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_spectral_systemic_prog_list(prog,error)
    use cubetools_format
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(spectral_systemic_prog_t), intent(in)    :: prog
    logical,                         intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='SPECTRAL>SYSTEMIC>PROG>LIST'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    mess = cubetools_format_stdkey_boldval('SYSTEMICKIND',prog%code,'i3',17)
    mess = trim(mess)//' '//cubetools_format_stdkey_boldval('VAL',prog%value,fdouble,ndouble+3)
    mess = trim(mess)//' '//cubetools_format_stdkey_boldval('CONVENTION',prog%conv,'i3',17)
    call cubeheader_message(seve%r,rname,mess)
  end subroutine cubetools_spectral_systemic_prog_list
  !
  subroutine cubetools_spectral_systemic_prog_from_headinter(prog,head,error)
    use cubetools_header_interface
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(spectral_systemic_prog_t), intent(inout) :: prog
    type(cube_header_interface_t),   intent(in)    :: head
    logical,                         intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>SYSTEMIC>PROG>FROM>HEADINTER'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    prog%code  = head%spectral_systemic_code
    prog%value = head%spectral_systemic_value
    prog%conv  = head%spectral_convention
  end subroutine cubetools_spectral_systemic_prog_from_headinter
  !
  subroutine cubetools_spectral_systemic_prog_to_headinter(prog,head,error)
    use cubetools_header_interface
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(spectral_systemic_prog_t), intent(in)    :: prog
    type(cube_header_interface_t),   intent(inout) :: head
    logical,                         intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>SYSTEMIC>PROG>TO>HEADINTER'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    head%spectral_systemic_code  = prog%code
    head%spectral_systemic_value = prog%value
    head%spectral_convention     = prog%conv
  end subroutine cubetools_spectral_systemic_prog_to_headinter
end module cubetools_spectral_systemic_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_spectral_v_or_z_types
  use cubetools_parameters
  use cubeheader_messaging
  use cubetools_spectral_systemic_types
  !
  public :: spectral_v_or_z_comm_t,spectral_v_or_z_user_t
  private
  !
  type spectral_v_or_z_comm_t
     type(spectral_systemic_comm_t) :: velo
     type(spectral_systemic_comm_t) :: reds
   contains
     procedure, public :: register => cubetools_spectral_v_or_z_comm_register
     procedure, public :: parse    => cubetools_spectral_v_or_z_comm_parse
  end type spectral_v_or_z_comm_t
  !
  type spectral_v_or_z_user_t
     type(spectral_systemic_user_t) :: velo
     type(spectral_systemic_user_t) :: reds
   contains
     procedure, public :: toprog => cubetools_spectral_v_or_z_user_toprog
  end type spectral_v_or_z_user_t
  !
contains
  !
  subroutine cubetools_spectral_v_or_z_comm_register(comm,error)
    use cubetools_unit
    !----------------------------------------------------------------------
    ! Register the /VELOCITY and /REDSHIFT keys
    !----------------------------------------------------------------------
    class(spectral_v_or_z_comm_t), intent(inout) :: comm
    logical,                       intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>V>OR>Z>COMM>REGISTER'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call comm%velo%register(&
         'VELOCITY',&
         'Edit the systemic velocity',&
         'Systemic velocity updated based on user value in current user unit',&
         code_unit_velo,&
         error)
    if (error) return
    call comm%reds%register(&
         'REDSHIFT',&
         'Edit the systemic redshift',&
         'Systemic redshift updated based on user value. The unit is meaningless in this case.',&
         code_unit_unk,& !***JP: should be code_unit_none!
         error)
    if (error) return
  end subroutine cubetools_spectral_v_or_z_comm_register
  !
  subroutine cubetools_spectral_v_or_z_comm_parse(comm,line,user,error)
    !----------------------------------------------------------------------
    ! Parse the /VELOCITY and /REDSHIFT keys
    !----------------------------------------------------------------------
    class(spectral_v_or_z_comm_t), intent(in)    :: comm
    character(len=*),              intent(in)    :: line
    type(spectral_v_or_z_user_t),  intent(inout) :: user
    logical,                       intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>V>OR>Z>COMM>PARSE'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call comm%velo%parse(line,user%velo,error)
    if (error) return
    call comm%reds%parse(line,user%reds,error)
    if (error) return
  end subroutine cubetools_spectral_v_or_z_comm_parse
  !
  subroutine cubetools_spectral_v_or_z_user_toprog(user,comm,proghead,error)
    use cubetools_unit
    use cubetools_header_interface
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(spectral_v_or_z_user_t), intent(in)    :: user
    class(spectral_v_or_z_comm_t), intent(in)    :: comm
    type(cube_header_interface_t), intent(inout) :: proghead
    logical,                       intent(inout) :: error
    !
    type(spectral_systemic_prog_t) :: progsyst
    character(len=*), parameter :: rname='SPECTRAL>V>OR>Z>USER>TOPROG'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
!!$    call user%velo%list(error)
!!$    if (error) return
!!$    call user%reds%list(error)
!!$    if (error) return
    !
    if (user%velo%present.and.user%reds%present) then
       call cubeheader_message(seve%e,rname,'The /VELOCITY and /REDSHIFT keys are exclusive from each other')
       error = .true.
       return
    else if (user%velo%present.or.user%reds%present) then
       call progsyst%from(proghead,error)
       if (error) return
       if (user%velo%present) then
          call user2prog(code_systemic_velocity,code_unit_velo,&
               comm%velo,user%velo,progsyst,error)
          if (error) return
       else if (user%reds%present) then
          call user2prog(code_systemic_redshift,code_unit_unk,&
               comm%reds,user%reds,progsyst,error)
          if (error) return
       endif
       call progsyst%to(proghead,error)
       if (error) return
    else
       ! Does nothing!
    endif
    !
!!$    call progsyst%list(error)
!!$    if (error) return
    !
  contains
    !
    subroutine user2prog(code_syst,code_unit,comm,user,prog,error)
      !----------------------------------------------------------------------
      !----------------------------------------------------------------------
      integer(kind=code_k),           intent(in)    :: code_syst
      integer(kind=code_k),           intent(in)    :: code_unit
      type(spectral_systemic_comm_t), intent(in)    :: comm
      type(spectral_systemic_user_t), intent(in)    :: user
      type(spectral_systemic_prog_t), intent(inout) :: prog
      logical,                        intent(inout) :: error
      !
      type(unit_user_t) :: unit
      !
      call update_systemic_code(prog%code,code_syst)
      call unit%get_from_name_for_code(user%unit,code_unit,error)
      if (error) return
      call resolve_value(unit,user%value,prog%value,error)
      if (error) return
      call resolve_conv(comm%conv,user%conv,prog%conv,error)
      if (error) return
    end subroutine user2prog
    !
    subroutine update_systemic_code(prog,code)
      !----------------------------------------------------------------------
      !----------------------------------------------------------------------
      integer(kind=code_k) :: prog
      integer(kind=code_k) :: code
      !
      if (prog.ne.code) then
         call cubeheader_message(seve%w,rname,'You are trying to change the systemic kind')
         call cubeheader_message(seve%w,rname,'Using * or = may lead to unexpected results')
      endif
      prog = code      
    end subroutine update_systemic_code
    !
    subroutine resolve_value(unit,user,prog,error)
      use cubetools_user2prog
      !----------------------------------------------------------------------
      !----------------------------------------------------------------------
      type(unit_user_t), intent(in)    :: unit
      character(len=*),  intent(in)    :: user
      real(kind=coor_k), intent(inout) :: prog
      logical,           intent(inout) :: error
      !
      real(kind=coor_k) :: default,previous
      !
      default = prog
      previous = prog
      call cubetools_user2prog_resolve_all(user,unit,default,previous,prog,error)
      if (error) return      
    end subroutine resolve_value
    !
    subroutine resolve_conv(comm,user,prog,error)
      use cubetools_user2prog
      use cubetools_keywordlist_types
      !----------------------------------------------------------------------
      !----------------------------------------------------------------------
      type(keywordlist_comm_t), intent(in)    :: comm
      character(len=*),         intent(in)    :: user
      integer(kind=code_k),     intent(inout) :: prog
      logical,                  intent(inout) :: error
      !
      integer(kind=code_k) :: default,previous
      !
      default = prog
      previous = prog
      call cubetools_user2prog_resolve_code(comm,user,default,previous,prog,error)
      if (error) return      
    end subroutine resolve_conv
  end subroutine cubetools_spectral_v_or_z_user_toprog
end module cubetools_spectral_v_or_z_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
