program uv_check
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! GILDAS
  ! A dedicated task to check a UV table for non-constant weights
  !     as a function of channels
  !
  !---------------------------------------------------------------------
  ! Generic variables
  character(len=filename_length) :: cuvin
  logical :: error
  !
  ! Code:
  call gildas_open
  call gildas_char('UV_INPUT$',cuvin)
  call gildas_close
  !
  call sub_uv_check (cuvin, error)
  if (error) call sysexi(fatale)
end program uv_check
!
subroutine sub_uv_check (cuvin, error)
  use image_def
  use gkernel_interfaces
  use gbl_message
  !---------------------------------------------------------------------
  ! GILDAS
  ! A dedicated task to check a UV table for non-constant weights
  !     as a function of channels
  !
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: cuvin
  logical, intent(out) :: error
  !
  type (gildas) :: uvin
  integer, allocatable :: cases(:)
  integer :: ier,ib
  character(len=*), parameter :: rname='UV_CHECK'
  character(len=80) :: mess
  integer :: ncase, nvisi, nblock
  !
  ! Simple checks
  error = len_trim(cuvin).eq.0
  if (error) then
    call map_message(seve%e,rname,'No input UV table name')
    return
  endif
  !
  call gildas_null (uvin, type = 'UVT')
  call gdf_read_gildas(uvin, cuvin, '.uvt', error, data=.false.)
  if (error) then
    call gagout('F-'//rname//',  Cannot read input UV table')
    return
  endif
  !
  ncase = uvin%gil%nchan
  allocate (cases(uvin%gil%nchan),stat=ier)
  !
  ! Define blocking factor, on largest data file, usually the input one
  ! but not always...
  call gdf_nitems('SPACE_GILDAS',nblock,uvin%gil%dim(1)) ! Visibilities at once
  nblock = min(nblock,uvin%gil%dim(2))
  ! Allocate respective space
  allocate (uvin%r2d(uvin%gil%dim(1),nblock), stat=ier)
  if (ier.ne.0) then
    write(mess,*) 'Memory allocation error ',uvin%gil%dim(1), nblock
    call map_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! Initialize
  ncase = 1
  cases(1) = 1
  !
  ! Loop over line table -
  uvin%blc = 0
  uvin%trc = 0
  !
  do ib = 1,uvin%gil%dim(2),nblock
    write(mess,*) ib,' / ',uvin%gil%dim(2),nblock
    call map_message(seve%d,rname,mess)
    uvin%blc(2) = ib
    uvin%trc(2) = min(uvin%gil%dim(2),ib-1+nblock)
    call gdf_read_data (uvin,uvin%r2d,error)
    !
    ! Here do the job
    nvisi = uvin%trc(2)-uvin%blc(2)+1
    call howmany_beams (uvin, nvisi, uvin%r2d, cases, ncase, error)
    if (error) return
  enddo
  !
  ! Write the result
  if (ncase.eq.1) then
    call map_message(seve%i,rname,'Only one beam needed')
  else
    call map_message(seve%w,rname,'More than one beam needed, channels:')
    write(6,*) cases(1:ncase)
  endif
end subroutine sub_uv_check
!
subroutine howmany_beams(uvin, nvisi, din, cases, ncase, error)
  use image_def
  type(gildas), intent(in) :: uvin
  integer, intent(in) :: nvisi
  real, intent(in) :: din(uvin%gil%dim(1),nvisi)
  integer, intent(inout) :: cases(uvin%gil%nchan)
  integer, intent(inout) :: ncase
  logical, intent(out) :: error
  !
  real, allocatable :: wlast(:), wcur(:)
  logical, allocatable :: mask(:)
  !
  integer :: k,ic,ier
  !
  allocate (wlast(nvisi),wcur(nvisi),mask(nvisi),stat=ier)
  error = ier.ne.0
  if (error) return
  !
  wlast(:) = din(uvin%gil%fcol+2,:)
  !
  k = uvin%gil%fcol+2
  do ic = 2,uvin%gil%nchan
     k = k+3
     wcur(:) = din(k,:)
     mask(:) = wcur(:).ne.wlast(:)
     if (any(mask)) then
        ncase = ncase+1
        cases(ncase) = ic ! Which channel
        wlast(:) = wcur(:)
     endif
  enddo
  deallocate (wlast,wcur,mask)
end subroutine howmany_beams

