!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! *** JP: These types are obsolescent. Please use the one in
! *** JP: template/type-spectral-range.f90 when possible.
!
! range_scalar_t and range_array_t are the user types corresponding to the
! window_scalar_t and window_array_t prog types in the
! template/type-spectral-range-obsolescent.f90 file.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_windowing
  use cubetools_parameters
  use cubeadm_windowing_types
  use cubeobsolete_messaging
  !
  public :: window_scalar_t,window_array_t
  public :: cubemain_window_blank
  public :: cubemain_window2mask
  private
  !
  !
contains
  !
  function cubemain_window_blank(wind,iw) result(isblank)
    use cubetools_nan
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(spectrum_t),     intent(in) :: wind
    integer(kind=wind_k), intent(in) :: iw
    logical                          :: isblank
    !
    isblank = ieee_is_nan(wind%t(2*iw-1)).or.ieee_is_nan(wind%t(2*iw))
  end function cubemain_window_blank
  !
  subroutine cubemain_window2mask(wind,spec,error)
    use cube_types
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(window_array_t), intent(in)    :: wind
    type(spectrum_t),     intent(inout) :: spec
    logical,              intent(inout) :: error
    !
    integer(kind=wind_k) :: iw
    !
    spec%w = 0.0
    do iw=1,wind%n
       spec%w(wind%val(iw)%o(1):wind%val(iw)%o(2)) = 1.0
    enddo
  end subroutine cubemain_window2mask
end module cubemain_windowing
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_range
  use cubetools_parameters
  use cubetools_structure
  use cubetools_unit_arg
  use cubeobsolete_messaging
  use cube_types
  !
  public :: range_opt_t,range_scalar_t,range_array_t
  public :: range_is_single,range_is_multiple
  private
  !
  logical, parameter :: range_is_single   = .true.
  logical, parameter :: range_is_multiple = .false.
  !
  type range_scalar_t
     real(kind=coor_k) :: val(2)
     logical :: truncate=.false.
  end type range_scalar_t
  type range_array_t
     integer(kind=wind_k) :: n = 0
     type(range_scalar_t), allocatable :: val(:)
     character(len=unit_l):: unit = strg_star
   contains
     procedure :: allocate => cubemain_range_allocate
  end type range_array_t
  !
  type range_opt_t
     logical                   :: single
     type(option_t),   pointer :: opt
     type(unit_arg_t), pointer :: unitarg
   contains
     procedure :: register  => cubemain_range_register
     procedure :: parse     => cubemain_range_parse
     procedure :: user2prog => cubemain_range_user2prog
  end type range_opt_t
  !
contains
  !
  subroutine cubemain_range_allocate(range,nr,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(range_array_t), intent(inout) :: range
    integer(kind=wind_k), intent(in)    :: nr
    logical,              intent(inout) :: error
    !
    integer(kind=4) :: ier
    character(len=*), parameter :: rname='RANGE>ALLOCATE'
    !
    call cubeobsolete_message(obsoleteseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (nr.le.0) then
       call cubeobsolete_message(seve%e,rname,'Negative or zero number of ranges')
       error = .true.
       return
    endif
    !
    if (allocated(range%val)) deallocate(range%val)
    ! Allocate
    allocate(range%val(nr),stat=ier)
    if (failed_allocate(rname,'range',ier,error)) return
    ! Allocation success => range%n may be updated
    range%n = nr
  end subroutine cubemain_range_allocate
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_range_register(option,name,abstract,issingle,error)
    use cubetools_unit
    !----------------------------------------------------------------------
    ! Register a /RANGE option that uses a single range according to a
    ! name and abstract provided by the command
    ! ----------------------------------------------------------------------
    class(range_opt_t), intent(out)   :: option
    character(len=*),   intent(in)    :: name
    character(len=*),   intent(in)    :: abstract
    logical,            intent(in)    :: issingle
    logical,            intent(inout) :: error
    !
    type(unit_arg_t) :: unitarg
    type(standard_arg_t) :: stdarg
    !
    character(len=*), parameter :: rname='RANGE>REGISTER'
    !
    call cubeobsolete_message(obsoleteseve%trace,rname,'Welcome')
    !
    option%single = issingle
    if (issingle) then
       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
    else
       call cubetools_register_option(&
            name,'v11 v12 [... [vn1 vn2]] [unit]',&
            abstract,&
            'Range(s) is (are) in velocity, multiple ranges are accepted',&
            option%opt,error)
       if (error) return
       call stdarg%register( &
            'v11',  &
            'Start of first range', &
            strg_id,&
            code_arg_mandatory, &
            error)
       if (error) return
       call stdarg%register( &
            'v12',  &
            'End of first range', &
            strg_id,&
            code_arg_mandatory, &
            error)
       if (error) return
       call stdarg%register( &
            'vn1',  &
            'Start of n-eth range', &
            strg_id,&
            code_arg_unlimited, &
            error)
       if (error) return
       call stdarg%register( &
            'vn2',  &
            'End of n-eth range', &
            strg_id,&
            code_arg_unlimited, &
            error)
       if (error) return
    endif
    call unitarg%register( &
         'unit',  &
         'Range unit', &
         strg_id,&
         code_arg_optional, &
         code_unit_velo, &
         option%unitarg,&
         error)
    if (error) return
  end subroutine cubemain_range_register
  !
  subroutine cubemain_range_parse(option,line,do,range,error)
    use cubetools_structure
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(range_opt_t),  intent(in)    :: option
    character(len=*),    intent(in)    :: line
    logical,             intent(out)   :: do
    type(range_array_t), intent(inout) :: range
    logical,             intent(inout) :: error
    !
    integer(kind=wind_k) :: ir,nr,narg
    character(len=*), parameter :: rname='PARSE>RANGE'
    !
    call cubeobsolete_message(obsoleteseve%trace,rname,'Welcome')
    !
    call option%opt%present(line,do,error)
    if (error) return
    if (do) then
       narg = option%opt%getnarg()
       nr = narg/2
       if (2*nr.ne.narg) then
          call cubeobsolete_message(seve%w,rname,'Odd number of arguments => Assumes that the last one is the unit')
          call cubetools_getarg(line,option%opt,narg,range%unit,mandatory,error)
          if (error) return
       endif
       call range%allocate(nr,error)
       if (error) return
       do ir=1,nr
          call cubetools_getarg(line,option%opt,1+2*(ir-1),range%val(ir)%val(1),mandatory,error)
          if (error) return
          call cubetools_getarg(line,option%opt,2*ir,range%val(ir)%val(2),mandatory,error)
          if (error) return
       enddo
    else
       nr = 1
       call range%allocate(nr,error)
       if (error) return
       ! *** JP I probably should initialize range%unit here   
    endif
  end subroutine cubemain_range_parse
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_range_user2prog(option,cube,user,prog,error)
    use cubetools_unit
    use cubemain_windowing
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(range_opt_t),   intent(in)    :: option
    type(cube_t),         intent(in)    :: cube
    type(range_array_t),  intent(in)    :: user
    type(window_array_t), intent(out)   :: prog
    logical,              intent(inout) :: error
    !
    integer(kind=wind_k) :: iw
    character(len=*), parameter :: rname='RANGE>USER2PROG'
    !
    type(unit_user_t) :: unit
    call cubeobsolete_message(obsoleteseve%trace,rname,'Welcome')
    !
    call unit%get_from_name_for_code(user%unit,code_unit_velo,error)
    if (error) return
    call prog%allocate(user%n,error)
    if (error) return
    do iw=1,user%n
       call cubemain_range_user2prog_one(unit,cube,user%val(iw),prog%val(iw),error)
       if (error) return
    enddo
  end subroutine cubemain_range_user2prog
  !
  subroutine cubemain_range_user2prog_one(unit,cube,user,prog,error)
    use cubetools_axis_types
    use cubetools_shape_types
    use cubetools_header_methods
    use cubetools_unit
    use cubemain_windowing
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(unit_user_t),     intent(in)    :: unit
    type(cube_t), target,  intent(in)    :: cube
    type(range_scalar_t),  intent(in)    :: user
    type(window_scalar_t), intent(out)   :: prog
    logical,               intent(inout) :: error
    !
    type(shape_t) :: n
    integer(kind=wind_k) :: iw
    integer(kind=chan_k) :: nf
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='RANGE>USER2PROG>ONE'
    !
    call cubeobsolete_message(obsoleteseve%trace,rname,'Welcome')
    !
    call cubetools_header_get_array_shape(cube%head,n,error)
    if (error) return
    prog%head => cube%head
    ! Define prog values
    if (user%val(1).ne.0.or.user%val(2).ne.0) then
       ! user%val(1) or user%val(2) != 0 => Use the user-defined range (ie assume that a zero value is valid)
       do iw=1,2
          call cubetools_axis_offset2pixel(&
               prog%head%spe%v,user%val(iw)*unit%prog_per_user,prog%p(iw),error)
          if (error) return
       enddo ! iw
    else
       ! user%val(1) = user%val(2) = 0
       ! => Default to full velocity range in lmv cube in increasing velocity order
       if (cube%head%spe%inc%v.gt.0) then
          ! Velocity increment > 0 => Plotted direction identical to natural direction
          prog%p = (/ 1_size_length,n%c /)
       else if (cube%head%spe%inc%v.lt.0) then
          ! Velocity increment < 0 => Plotted direction identical to natural direction
          prog%p = (/n%c,1_size_length /)
       else
          ! Velocity increment = 0 => Problem
          write(mess,'(a)') 'Velocity increment (cube%head%spe%inc%v) is zero valued'
          call cubeobsolete_message(seve%e,rname,mess)
          error = .true.
          return
       endif
    endif
    !
    ! Define other structure members accordingly
    if (user%truncate) then
       nf = n%c
       if (all(prog%p.lt.1)) then
          write(mess,'(a,i0,a,i0,a)') 'Both range edges lower than 1: [',prog%p(1),',',prog%p(2),']'
          call cubeobsolete_message(seve%e,rname,mess)
          error = .true.
       else if (all(prog%p.gt.nf)) then
          write(mess,'(a,i0,a,i0,a)') 'Both range edges greater than nf: [',prog%p(1),',',prog%p(2),']'
          call cubeobsolete_message(seve%e,rname,mess)
          error = .true.
       else
          if (prog%p(1).lt.1.or.prog%p(1).gt.nf) then
             write(mess,'(a,1pg14.7,a)') 'Range ',user%val(1),' goes beyond bounds, truncating'
             call cubeobsolete_message(obsoleteseve%others,rname,mess)
          endif
          if (prog%p(2).lt.1.or.prog%p(2).gt.nf) then
             write(mess,'(a,1pg14.7,a)') 'Range ',user%val(2),' goes beyond bounds, truncating'
             call cubeobsolete_message(obsoleteseve%others,rname,mess)
          endif
          prog%o(1) = max(min(prog%p(1),prog%p(2)),1)
          prog%o(2) = min(max(prog%p(1),prog%p(2)),nf)
       endif
    else
       prog%o(1) = min(prog%p(1),prog%p(2))
       prog%o(2) = max(prog%p(1),prog%p(2))
    endif
    prog%nc = prog%o(2)-prog%o(1)+1
  end subroutine cubemain_range_user2prog_one
end module cubemain_range
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
