!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetopology_sperange_types
  use cubetools_structure
  use cubetools_unit_arg
  use cubetools_axis_types
  use cubetopology_messaging
  use cubetopology_range_types
  !
  public :: sperange_opt_t,sperange_user_t,sperange_prog_t
  private
  !
  integer(kind=4), parameter :: imin = 1
  integer(kind=4), parameter :: imax = 2
  !
  type sperange_opt_t
     type(option_t),   pointer :: opt
     type(unit_arg_t), pointer :: unitarg
   contains
     procedure :: register => cubetopology_sperange_register
     procedure :: parse    => cubetopology_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          => cubetopology_sperange_user_init
     ! procedure :: def_substruct => cubetopology_sperange_user_def_substruct
     procedure :: toprog        => cubetopology_sperange_user_toprog
     procedure :: list          => cubetopology_sperange_user_list
  end type sperange_user_t
  !
  type, extends(range_prog_t) :: sperange_prog_t
     type(axis_t), pointer, private :: axis => null() ! [----] Associated axis
   contains
     procedure :: def_substruct   => cubetopology_sperange_prog_def_substruct
     procedure :: get_offset      => cubetopology_sperange_prog_get_offset
     procedure :: list            => cubetopology_sperange_prog_list
     procedure :: intersect_axis  => cubetopology_sperange_prog_intersect_axis
     procedure :: to_chan_k       => cubetopology_sperange_prog_to_chan_k
     procedure :: to_axis_channel => cubetopology_sperange_prog_to_axis_channel
  end type sperange_prog_t
  !
contains
  !
  subroutine cubetopology_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(unit_arg_t) :: unitarg
    type(standard_arg_t) :: stdarg
    character(len=*), parameter :: rname='SPERANGE>REGISTER'
    !
    call cubetopology_message(toposeve%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 unitarg%register(&
         'unit',&
         'Range unit',&
         strg_id,&
         code_arg_optional,&
         code_unit_velo,&
         option%unitarg,&
         error)
    if (error) return
  end subroutine cubetopology_sperange_register
  !
  subroutine cubetopology_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 cubetopology_message(toposeve%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 cubetopology_sperange_parse
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetopology_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 cubetopology_message(toposeve%trace,rname,'Welcome')
  end subroutine cubetopology_sperange_user_init
  !
  subroutine cubetopology_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) :: default_unit,user_unit
    real(kind=coor_k) :: default(2),offset(2)
    integer(kind=4) :: ip
    character(len=*), parameter :: rname='SPERANGE>USER>TOPROG'
    !
    call cubetopology_message(toposeve%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]
    ! *** JP: This one breaks at least the EXTRACT and FFT commands. Revert
    ! *** JP: waiting for a better solution.
!!$    default(1) = 0.5d0              ! [channel] Left of first channel
!!$    default(2) = prog%axis%n+0.5d0  ! [channel] Right of last channel
    ! Default unit will depend on the axis kind
    call default_unit%get_from_code(prog%axis%kind,error)
    if (error) return
    ! Get user unit from user input
    call user_unit%get_from_name(user%unit,error)
    if (error) return
    !
!!$    call default_unit%list(error)
!!$    if (error) return
!!$    call user_unit%list(error)
!!$    if (error) return
    select case(user_unit%kind%code)
    case(code_unit_chan,code_unit_pixe)
       ! Directly resolve first and last
       do ip=1,2
          call cubetools_user2prog_resolve_star(user%val(ip),user_unit,default(ip),prog%p(ip),error)
          if (error) return
       enddo ! ip
    case(code_unit_unk)
       ! Use default axis unit
       do ip=1,2
          ! Convert default values from channel to offset
          call cubetools_axis_pixel2offset(prog%axis,default(ip),default(ip),error)
          if (error) return
          ! Resolve between user and default values taking into account the user2prog unit conversion
          call cubetools_user2prog_resolve_star(user%val(ip),default_unit,default(ip),offset(ip),error)
          if (error) return
          ! Convert back from offset to channel
          call cubetools_axis_offset2pixel(prog%axis,offset(ip),prog%p(ip),error)
          if (error) return
       enddo ! ip
    case default
       ! Check whether user and default units are consistent
       call user_unit%is_consistent_with(default_unit,error)
       if (error) return
       ! If yes, use them
       do ip=1,2
          ! Convert default values from channel to offset
          call cubetools_axis_pixel2offset(prog%axis,default(ip),default(ip),error)
          if (error) return
          ! Resolve between user and default values taking into account the user2prog unit conversion
          call cubetools_user2prog_resolve_star(user%val(ip),user_unit,default(ip),offset(ip),error)
          if (error) return
          ! Convert back from offset to channel
          call cubetools_axis_offset2pixel(prog%axis,offset(ip),prog%p(ip),error)
          if (error) return
       enddo ! ip
    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 cubetopology_sperange_user_toprog
  !
  subroutine cubetopology_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 cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    write(mess,'(6a)') &
         'Range  : (',trim(user%val(1)),',',trim(user%val(2)),') ',user%unit
    call cubetopology_message(seve%r,rname,mess)
  end subroutine cubetopology_sperange_user_list
  !
  subroutine cubetopology_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 cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    ! *** JP What happens if the sub-structure already exists?
    call struct%def_substruct(name,rangesubstruct,error)
    if (error) return
    !
    call unit%get_from_code(prog%axis%kind,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 cubetopology_sperange_prog_def_substruct
  !
  subroutine cubetopology_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 cubetopology_message(toposeve%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 cubetopology_sperange_prog_get_offset
  !
  subroutine cubetopology_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 cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    call cubetools_format_range(range%axis%name,range%p,'channel',mess,error)
    if (error) return
    call cubetopology_message(seve%r,rname,mess)
    !
    call unit%get_from_code(range%axis%kind,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 cubetopology_message(seve%r,rname,mess)
  end subroutine cubetopology_sperange_prog_list
  !
  subroutine cubetopology_sperange_prog_intersect_axis(range,error)
    !----------------------------------------------------------------------
    ! Ensure that the range will be inside the axis range
    !----------------------------------------------------------------------
    class(sperange_prog_t), intent(inout) :: range
    logical,                intent(inout) :: error
    !
    real(kind=coor_k) :: rangemin,axismin
    real(kind=coor_k) :: rangemax,axismax
    character(len=*), parameter :: rname='SPERANGE>PROG>INTERSECT>AXIS'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    rangemin = minval(range%p)
    rangemax = maxval(range%p)
    axismin = 1d0
    axismax = real(range%axis%n,kind=coor_k)
    if ((rangemax.lt.axismin).or.(axismax.lt.rangemin)) then
       ! Outside axis range
       call cubetopology_message(seve%e,rname,'User defined spectral range outside cube')
       error = .true.
       return
    endif
    !
    rangemin = max(rangemin,axismin)
    rangemax = min(rangemax,axismax)
    if (range%dp.ge.0.0) then
       ! Plotted direction equal to axis natural direction
       range%p(imin) = rangemin
       range%p(imax) = rangemax
    else
       ! Plotted direction reverse to axis natural direction
       range%p(imin) = rangemax
       range%p(imax) = rangemin
    endif
    range%n = abs((range%p(imax)-range%p(imin))/range%dp)
  end subroutine cubetopology_sperange_prog_intersect_axis
  !
  subroutine cubetopology_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 edges.
    ! However, they may be located outside the associated axis range.
    !----------------------------------------------------------------------
    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 cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    call range%to_inte_k(first,last,stride,error)
    if (error)  return
  end subroutine cubetopology_sperange_prog_to_chan_k
  !
  subroutine cubetopology_sperange_prog_to_axis_channel(range,ix,error)
    use cubetopology_firstlaststride_types
    !----------------------------------------------------------------------
    ! First and last are expected to be inclusive, ie, we expect them to
    ! include the whole channels at the borders.
    ! They also are expected to fit inside the associated axis range.
    !----------------------------------------------------------------------
    class(sperange_prog_t),  intent(in)    :: range
    type(firstlaststride_t), intent(out)   :: ix
    logical,                 intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPERANGE>PROG>TO>AXIS>CHANNEL'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    ix%stride = nint(range%dp)
    ! As per the requirement to be inclusive (i.e. the request for a fraction
    ! of channel should imply including the whole channel), the nint() function
    ! is the right function to be used (because channel N runs from N-0.5 to
    ! N+0.5)
    ix%first  = nint(minval(range%p))
    ix%last   = nint(maxval(range%p))
    ! Ensure that they fits inside the associated axis range
    ix%first  = max(ix%first,1)
    ix%last   = min(ix%last,range%axis%n)
  end subroutine cubetopology_sperange_prog_to_axis_channel
end module cubetopology_sperange_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
