!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_sperange_types
  use cubetools_structure
  use cubetools_keyword_arg
  use cubetools_axis_types
  use cubemain_messaging
  !
  public :: sperange_opt_t,sperange_user_t,sperange_prog_t
  private
  !
  type sperange_opt_t
     type(option_t),      pointer :: opt
     type(keyword_arg_t), pointer :: unitarg
   contains
     procedure :: register => cubemain_sperange_register
     procedure :: parse    => cubemain_sperange_parse
  end type sperange_opt_t
  !
  type sperange_user_t
     logical               :: do = .false.
     character(len=argu_l) :: val(2) = strg_star
     character(len=argu_l) :: unit = strg_star
   contains
     procedure :: init          => cubemain_sperange_user_init
     ! procedure :: def_substruct => cubemain_sperange_user_def_substruct
     procedure :: toprog        => cubemain_sperange_user_toprog
     procedure :: list          => cubemain_sperange_user_list
  end type sperange_user_t
  !
  type sperange_prog_t
     real(kind=coor_k) :: p(2) = 0d0         ! [chan] First and last values
     real(kind=coor_k) :: dp = 0d0           ! [chan] Step size
     real(kind=coor_k) :: n = 0d0            ! [----] Number of steps
     type(axis_t), pointer :: axis => null() ! [----] Associated axis
   contains
     procedure :: def_substruct => cubemain_sperange_prog_def_substruct
     procedure :: get_offset    => cubemain_sperange_prog_get_offset
     procedure :: list          => cubemain_sperange_prog_list
     procedure :: to_chan_k     => cubemain_sperange_prog_to_chan_k
  end type sperange_prog_t
  !
contains
  !
  subroutine cubemain_sperange_register(option,name,abstract,error)
    use cubetools_unit
    !----------------------------------------------------------------------
    ! Register a /NAME option for a single spectral range. The option
    ! abstract is customizable by the caller.
    !----------------------------------------------------------------------
    class(sperange_opt_t), intent(out)   :: option
    character(len=*),      intent(in)    :: name
    character(len=*),      intent(in)    :: abstract
    logical,               intent(inout) :: error
    !
    type(keyword_arg_t) :: keyarg
    type(standard_arg_t) :: stdarg
    character(len=*), parameter :: rname='SPERANGE>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         name,'first last [unit]',&
         abstract,&
         'A single spectral range is accepted',&
         option%opt,error)
    if (error) return
    call stdarg%register(&
         'first',&
         'Start of range',&
         strg_id,&
         code_arg_mandatory,&
         error)
    if (error) return
    call stdarg%register(&
         'last',&
         'End of range',&
         strg_id,&
         code_arg_mandatory,&
         error)
    if (error) return
    call keyarg%register(&
         'unit',&
         'Range unit',&
         strg_id,&
         code_arg_optional,&
         unit_velo_name,&
         flexible,&
         option%unitarg,&
         error)
    if (error) return
  end subroutine cubemain_sperange_register
  !
  subroutine cubemain_sperange_parse(option,line,user,error)
    use cubetools_structure
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(sperange_opt_t), intent(in)    :: option
    character(len=*),      intent(in)    :: line
    type(sperange_user_t), intent(out)   :: user
    logical,               intent(inout) :: error
    !
    integer(kind=wind_k) :: ip
    character(len=*), parameter :: rname='SPERANGE>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call option%opt%present(line,user%do,error)
    if (error) return
    if (user%do) then
       do ip = 1,2
          call cubetools_getarg(line,option%opt,ip,user%val(ip),mandatory,error)
          if (error)  return
       enddo ! ip
       call cubetools_getarg(line,option%opt,3,user%unit,.not.mandatory,error)
       if (error) return
    else
       do ip=1,2
          user%val(ip) = strg_star
       enddo ! ip
    endif
  end subroutine cubemain_sperange_parse
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_sperange_user_init(range,error)
    !----------------------------------------------------------------------
    ! Initialize by setting the intent of sperange to out
    !----------------------------------------------------------------------
    class(sperange_user_t), intent(out)   :: range 
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPERANGE>USER>INIT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
  end subroutine cubemain_sperange_user_init
  !
  subroutine cubemain_sperange_user_toprog(user,cube,prog,error)
    use cubetools_unit
    use cubetools_user2prog
    use cubetools_header_methods
    use cube_types
    !----------------------------------------------------------------------
    ! 1. When first.eq.*, default to first pixel.
    ! 2. When  last.eq.*, default to  last pixel.
    ! 3. Step sign follows user request (ie, whether first.le.last)
    !----------------------------------------------------------------------
    class(sperange_user_t), intent(in)    :: user
    type(cube_t),           intent(in)    :: cube
    type(sperange_prog_t),  intent(inout) :: prog
    logical,                intent(inout) :: error
    !
    type(unit_user_t) :: unit
    real(kind=coor_k) :: default(2),offset(2)
    integer(kind=4) :: ip
    integer(kind=code_k) :: code_unit
    integer(kind=4), parameter :: imin = 1
    integer(kind=4), parameter :: imax = 2
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='SPERANGE>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_header_point2axis(cube%head%set%ic,cube%head,prog%axis,error)
    if (error) return
    ! First and last will default to natural axis direction
    default = [1_chan_k,prog%axis%n] ! [channel]
    if (user%unit.eq.strg_star) then
       code_unit = code_unit_velo
    else
       call cubetools_unit_get_kind(user%unit,code_unit,error)
       if (error) return
    endif
    call cubetools_unit_get(user%unit,code_unit,unit,error)
    if (error) return
    select case(code_unit)
    case(code_unit_chan)
       do ip=1,2
          call cubetools_user2prog_resolve_star(user%val(ip),unit,default(ip),prog%p(ip),error)
          if (error) return
       enddo ! ip
    case(code_unit_velo)
       do ip=1,2
          call cubetools_axis_pixel2offset(prog%axis,default(ip),default(ip),error)
          if (error) return
          call cubetools_user2prog_resolve_star(user%val(ip),unit,default(ip),offset(ip),error)
          if (error) return
          call cubetools_axis_offset2pixel(prog%axis,offset(ip),prog%p(ip),error)
          if (error) return
       enddo ! ip
    case default
       write(mess,'(a,i0)') 'Unknown unit code ',code_unit
       call cubemain_message(seve%e,rname,mess)
       error = .true.
       return
    end select
    ! Nothing clever for the step value for the moment!
    prog%dp = 1.0 ! At least one channel
    ! Step sign follows user request
    if (prog%p(imin).le.prog%p(imax)) then
       prog%dp = +abs(prog%dp)
    else
       prog%dp = -abs(prog%dp)
    endif
    prog%n = abs((prog%p(imax)-prog%p(imin))/prog%dp)
  end subroutine cubemain_sperange_user_toprog
  !
  subroutine cubemain_sperange_user_list(user,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(sperange_user_t), intent(in)    :: user 
    logical,                intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='SPERANGE>USER>LIST'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    write(mess,'(6a)') &
         'Range  : (',trim(user%val(1)),',',trim(user%val(2)),') ',user%unit
    call cubemain_message(seve%r,rname,mess)
  end subroutine cubemain_sperange_user_list
  !
  subroutine cubemain_sperange_prog_def_substruct(prog,name,struct,error)
    use cubetools_unit
    use cubetools_userstruct
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(sperange_prog_t), intent(in)    :: prog
    character(len=*),       intent(in)    :: name
    type(userstruct_t),     intent(inout) :: struct
    logical,                intent(inout) :: error
    !
    real(kind=coor_k) :: offset(3)
    type(unit_user_t) :: unit
     type(userstruct_t) :: rangesubstruct
    character(len=*), parameter :: rname='SPERANGE>PROG>DEF>RANGESUBSTRUCT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! *** JP What happens if the sub-structure already exists?
    call struct%def_substruct(name,rangesubstruct,error)
    if (error) return
    !
    call cubetools_unit_get(strg_star,code_unit_velo,unit,error)
    if (error) return
    call prog%get_offset(offset,error)
    if (error) return
    offset = offset*unit%user_per_prog    
    call rangesubstruct%set_member('first',offset(1),error)
    if (error) return
    call rangesubstruct%set_member('last',offset(2),error)
    if (error) return
    call rangesubstruct%set_member('step',offset(3),error)
    if (error) return
    call rangesubstruct%set_member('n',prog%n,error)
    if (error) return
    call rangesubstruct%set_member('unit',unit%name,error)
    if (error) return
  end subroutine cubemain_sperange_prog_def_substruct
  !
  subroutine cubemain_sperange_prog_get_offset(range,offset,error)
    use cubetools_axis_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(sperange_prog_t), intent(in)    :: range
    real(kind=coor_k),      intent(out)   :: offset(3)
    logical,                intent(inout) :: error
    !
    integer(kind=4) :: ip
    character(len=*), parameter :: rname='SPERANGE>PROG>GET>OFFSET'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    do ip=1,2
       call cubetools_axis_pixel2offset(range%axis,range%p(ip),offset(ip),error)
       if (error) return
    enddo ! ip
    offset(3) = range%dp*abs(range%axis%inc) ! Here the sign is coded in range%dp
  end subroutine cubemain_sperange_prog_get_offset
  !
  subroutine cubemain_sperange_prog_list(range,error)
    use cubetools_unit
    use cubetools_format
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(sperange_prog_t), intent(in)    :: range
    logical,                intent(inout) :: error
    !
    type(unit_user_t) :: unit
    real(kind=coor_k) :: offset(3)
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='SPERANGE>PROG>LIST'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_format_range(range%axis%name,range%p,'channel',mess,error)
    if (error) return
    call cubemain_message(seve%r,rname,mess)
    !
    call cubetools_unit_get(strg_star,code_unit_velo,unit,error)
    if (error) return
    call range%get_offset(offset,error)
    if (error) return
    offset = offset*unit%user_per_prog    
    call cubetools_format_range(range%axis%name,offset,unit%name,mess,error)
    if (error) return
    call cubemain_message(seve%r,rname,mess)
  end subroutine cubemain_sperange_prog_list
  !
  subroutine cubemain_sperange_prog_to_chan_k(range,first,last,stride,error)
    !----------------------------------------------------------------------
    ! First and last are expected to be inclusive, We expect them to
    ! include the whole channels at the borders
    !----------------------------------------------------------------------
    class(sperange_prog_t), intent(in)    :: range
    integer(kind=chan_k),   intent(out)   :: first
    integer(kind=chan_k),   intent(out)   :: last
    integer(kind=chan_k),   intent(out)   :: stride    
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPERANGE>PROG>TO>CHAN_K'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    first  = floor(minval(range%p))
    last   = ceiling(maxval(range%p))
    stride = nint(range%dp)
  end subroutine cubemain_sperange_prog_to_chan_k
end module cubemain_sperange_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
