!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetopology_sparange_types
  use cubetopology_messaging
  use cubetopology_range_types
  use cubetools_axis_types
  !
  public :: sparange_prog_t
  private
  !
  integer(kind=4), parameter :: imin = 1
  integer(kind=4), parameter :: imax = 2
  !
  type, extends(range_prog_t) :: sparange_prog_t
     type(axis_t), pointer, private :: axis => null() ! [---] Associated axis
   contains
     procedure :: fromuser       => cubetopology_sparange_prog_fromuser
     procedure :: def_substruct  => cubetopology_sparange_prog_def_substruct
     procedure :: get_offset     => cubetopology_sparange_prog_get_offset
     procedure :: list           => cubetopology_sparange_prog_list
     procedure :: intersect_axis => cubetopology_sparange_prog_intersect_axis
     procedure :: to_pixe_k      => cubetopology_sparange_prog_to_pixe_k
  end type sparange_prog_t
  !
contains
  !
  subroutine cubetopology_sparange_prog_fromuser(range,iaxis,cube,progcenter,&
       usersizeval,usersizeunit,progsampval,progsampunit,error)
    use cubetools_unit
    use cubetools_user2prog
    use cubetools_header_methods
    use cube_types
    !----------------------------------------------------------------------
    ! 1. When the size is default, always use the natural axis direction as
    !    plotted direction
    ! 2. Else, the plotted direction depends on the sign of the user size
    !----------------------------------------------------------------------
    class(sparange_prog_t), intent(inout) :: range
    integer(kind=ndim_k),   intent(in)    :: iaxis
    type(cube_t),           intent(in)    :: cube
    real(kind=coor_k),      intent(in)    :: progcenter
    character(len=argu_l),  intent(in)    :: usersizeval
    character(len=argu_l),  intent(in)    :: usersizeunit
    real(kind=coor_k),      intent(in)    :: progsampval
    integer(kind=code_k),   intent(in)    :: progsampunit
    logical,                intent(inout) :: error
    !
    type(unit_user_t) :: progunit
    real(kind=coor_k) :: ofirst,olast,progsize
    real(kind=coor_k) :: pfirst,plast
    real(kind=coor_k), parameter :: default = 0d0
    character(len=*), parameter :: rname='SPARANGE>PROG>FROMUSER'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    call cubetools_header_point2axis(iaxis,cube%head,range%axis,error)
    if (error) return
    if (range%axis%inc.ne.0.0) then
       select case(progsampunit)
       case(code_unit_pixe)
          ! progsampval is here a number of boxes
          ! => Compute the number of pixels per box
          if (usersizeval.ne.strg_star) then
             ! Use the user-defined size
             call progunit%get_from_name_for_code(usersizeunit,range%axis%kind,error)
             if (error) return
             call cubetools_user2prog_resolve_star(usersizeval,progunit,default,progsize,error)
             if (error) return
             range%dp = abs(progsize/progsampval/range%axis%inc)
          else
             ! Use the full field of view
             range%dp = abs(range%axis%n/progsampval)
          endif
          range%dp = max(1d0,min(real(range%axis%n,kind=coor_k),range%dp))
       case default
          ! progsampval is here in axis unit
          range%dp = abs(progsampval/range%axis%inc)
          range%dp = max(range%dp,1.0) ! At least one pixel
       end select
    else
       call cubetopology_message(seve%e,rname,'Zero valued axis increment')
       error = .true.
       return
    endif    
    if (usersizeval.ne.strg_star) then
       ! Use the user-defined range from his size and his center
       call progunit%get_from_name_for_code(usersizeunit,range%axis%kind,error)
       if (error) return
       call cubetools_user2prog_resolve_star(usersizeval,progunit,default,progsize,error)
       if (error) return       
       ofirst = progcenter-0.5*progsize
       olast  = progcenter+0.5*progsize
       call cubetools_axis_offset2pixel(range%axis,ofirst,pfirst,error)
       if (error) return    
       call cubetools_axis_offset2pixel(range%axis,olast,plast,error)
       if (error) return
       if (progsize*range%axis%inc.ge.0.0) then
          ! Plotted direction equal to axis natural direction
          range%dp = +sign(range%dp,range%axis%inc)
       else
          ! Plotted direction reverse to axis natural direction
          range%dp = -sign(range%dp,range%axis%inc)
       endif
       if (range%dp.ge.0.0) then
          range%p(imin) = min(pfirst,plast)
          range%p(imax) = max(pfirst,plast)
       else
          range%p(imin) = max(pfirst,plast)
          range%p(imax) = min(pfirst,plast)
       endif
    else
       ! Plotted direction always equal to axis natural direction
       !
       ! *** JP: This one breaks at least the EXTRACT and FFT commands. Revert
       ! *** JP: waiting for a better solution.
!!$       ! Default to full axis range, ie, don't use the center information in this case
!!$       range%p(imin) = 0.5d0               ! Left of first pixel
!!$       range%p(imax) = range%axis%n+0.5d0  ! Right of last pixel
       range%p(imin) = 1
       range%p(imax) = range%axis%n
       range%dp = abs(range%dp)
    endif
    range%n = abs((range%p(imax)-range%p(imin))/range%dp)
  end subroutine cubetopology_sparange_prog_fromuser
  !
  subroutine cubetopology_sparange_prog_def_substruct(prog,name,struct,error)
    use cubetools_unit
    use cubetools_userstruct
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(sparange_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='SPARANGE>PROG>DEF>SUBSTRUCT'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    call struct%def_substruct(name,rangesubstruct,error)
    if (error) return
    !
    call prog%get_offset(offset,error)
    if (error) return
    call unit%get_from_code(prog%axis%kind,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_sparange_prog_def_substruct
  !
  subroutine cubetopology_sparange_prog_get_offset(range,offset,error)
    use cubetools_axis_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(sparange_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='SPARANGE>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*range%axis%inc
  end subroutine cubetopology_sparange_prog_get_offset
  !
  subroutine cubetopology_sparange_prog_list(range,error)
    use cubetools_unit
    use cubetools_format
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(sparange_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='SPARANGE>PROG>LIST'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    call cubetools_format_range(range%axis%name,range%p,'pixel',mess,error)
    if (error) return
    call cubetopology_message(seve%r,rname,mess)
    !
    call range%get_offset(offset,error)
    if (error) return
    call unit%get_from_code(range%axis%kind,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_sparange_prog_list
  !
  subroutine cubetopology_sparange_prog_intersect_axis(range,error)
    !----------------------------------------------------------------------
    ! Ensure that the range will be inside the axis range
    !----------------------------------------------------------------------
    class(sparange_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='SPARANGE>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 spatial 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_sparange_prog_intersect_axis
  !
  subroutine cubetopology_sparange_prog_to_pixe_k(range,first,last,stride,error)
    !----------------------------------------------------------------------
    ! First and last are expected to be inclusive, We expect them to
    ! include the whole pixels at the edges
    !----------------------------------------------------------------------
    class(sparange_prog_t), intent(in)    :: range
    integer(kind=pixe_k),   intent(out)   :: first
    integer(kind=pixe_k),   intent(out)   :: last
    integer(kind=pixe_k),   intent(out)   :: stride
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPARANGE>PROG>TO>PIXE_K'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    call range%to_inte_k(first,last,stride,error)
    if (error)  return
  end subroutine cubetopology_sparange_prog_to_pixe_k
end module cubetopology_sparange_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
