!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! *** JP: These types are obsolescent. Please use the one in
! *** JP: adm/type-spectral-range.f90 when possible.
!
! window_scalar_t and window_array_t are the user types corresponding to
! the range_scalar_t and range_array_t prog types in the
! main/type-spectral-range-obsolescent.f90 file.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeadm_windowing_types
  use cubetools_parameters
  use cubetools_header_types
  use cubeadm_messaging
  !
  public :: window_scalar_t,window_array_t
  private
  !
  type window_scalar_t
     integer(kind=chan_k) :: nc   = 1   ! [none] Number of channels inside window
     integer(kind=chan_k) :: o(2) = 1   ! [none] Channels sorted by increasing value
     integer(kind=chan_k) :: p(2) = 1   ! [none] Channels unsorted
     type(cube_header_t), pointer :: head => null()
   contains
     procedure :: list => cubeadm_window_scalar_list
     procedure :: chan2velo => cubeadm_window_scalar_chan2velo
     procedure :: chan2freq => cubeadm_window_scalar_chan2freq
  end type window_scalar_t
  type window_array_t
     integer(kind=wind_k) :: n = 0
     type(window_scalar_t), pointer :: val(:) => null()
   contains
     procedure :: allocate => cubeadm_allocate_window_array
     final     :: cubeadm_free_window_array
  end type window_array_t
  !
contains
  !
  subroutine cubeadm_allocate_window_array(wind,nw,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(window_array_t), intent(inout) :: wind
    integer(kind=wind_k),  intent(in)    :: nw
    logical,               intent(inout) :: error
    !
    integer(kind=4) :: ier
    character(len=*), parameter :: rname='ALLOCATE>WINDOW>ARRAY'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (nw.le.0) then
       call cubeadm_message(seve%e,rname,'Negative or zero number of windows')
       error = .true.
       return
    endif
    ! Allocate
    allocate(wind%val(nw),stat=ier)
    if (failed_allocate(rname,'window',ier,error)) return
    ! Allocation success => wind%n may be updated
    wind%n = nw
  end subroutine cubeadm_allocate_window_array
  !
  subroutine cubeadm_free_window_array(wind)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(window_array_t), intent(inout) :: wind
    !
    character(len=*), parameter :: rname='FREE>WINDOW>ARRAY'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    wind%n = 0
    if (associated(wind%val)) deallocate(wind%val)
  end subroutine cubeadm_free_window_array
  !
  !------------------------------------------------------------------------
  !
  subroutine cubeadm_window_scalar_chan2velo(wind,velo,error)
    use cubetools_axis_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(window_scalar_t), intent(in)    :: wind
    real(kind=coor_k),      intent(out)   :: velo(2)
    logical,                intent(inout) :: error
    !
    integer(kind=wind_k) :: iw
    character(len=*), parameter :: rname='WINDOW>SCALAR>CHAN2VELO'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    if (.not.associated(wind%head)) then
       call cubeadm_message(seve%e,rname,'The window has no associated header')
       error = .true.
       return
    endif
    do iw=1,2
       call cubetools_axis_pixel2offset(&
            wind%head%spe%v,wind%p(iw),velo(iw),error)
       if (error) return
    enddo ! iw
  end subroutine cubeadm_window_scalar_chan2velo
  !
  subroutine cubeadm_window_scalar_chan2freq(wind,freq,error)
    use cubetools_axis_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(window_scalar_t), intent(in)    :: wind
    real(kind=coor_k),      intent(out)   :: freq(2)
    logical,                intent(inout) :: error
    !
    integer(kind=wind_k) :: iw
    character(len=*), parameter :: rname='WINDOW>SCALAR>CHAN2FREQ'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    if (.not.associated(wind%head)) then
       call cubeadm_message(seve%e,rname,'The window has no associated header')
       error = .true.
       return
    endif
    do iw=1,2
       call cubetools_axis_pixel2offset(&
            wind%head%spe%f,wind%p(iw),freq(iw),error)
       if (error) return
    enddo ! iw
  end subroutine cubeadm_window_scalar_chan2freq
  !
  subroutine cubeadm_window_scalar_list(wind,error)
    use cubetools_unit
    use cubetools_format
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(window_scalar_t), intent(in)    :: wind
    logical,                intent(inout) :: error
    !
    type(unit_user_t) :: unit
    real(kind=coor_k) :: values(2)
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='WINDOW>SCALAR>LIST'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    values = wind%p
    call cubetools_format_range('SPECTRAL',values,1.d0,'channel',mess,error)
    if (error) return
    call cubeadm_message(seve%r,rname,mess)
    !
    call unit%get_from_code(code_unit_velo,error)
    if (error) return
    call wind%chan2velo(values,error)
    if (error) return
    values = values*unit%user_per_prog    
    call cubetools_format_range('SPECTRAL',values,1.d0,unit%name,mess,error)
    if (error) return
    call cubeadm_message(seve%r,rname,mess)
    !
    call unit%get_from_code(code_unit_freq,error)
    if (error) return
    call wind%chan2freq(values,error)
    if (error) return
    values = values*unit%user_per_prog    
    call cubetools_format_range('SPECTRAL',values,1.d0,unit%name,mess,error)
    if (error) return
    call cubeadm_message(seve%r,rname,mess)
  end subroutine cubeadm_window_scalar_list
end module cubeadm_windowing_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
