subroutine display_check_uv(comm,error)
  use clean_def
  use clean_arrays
  use gbl_message
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   SHOW UV
  !     TIME-BASE sort the UV table before displaying it
  !----------------------------------------------------------------------
  character(len=*), intent(in) :: comm 
  logical, intent(out) :: error ! Logical error flag
  !
  ! Check data presence in buffer
  if (.not.associated(duv)) then
     call map_message(seve%e,comm,'No UV data')
     error = .true.
     return
  endif
  ! Sort buffer (TIME-BASE) when needed and create the associated SIC buffer
  if (.not.allocated(duvt)) call uv_tri(2,error)
end subroutine display_check_uv
!
subroutine display_uv(chain,error)
  use clean_def
  use clean_arrays
  use gbl_message
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   SHOW UV
  !     TIME-BASE sort the UV table before displaying it
  !----------------------------------------------------------------------
  character(len=*), intent(in) :: chain
  logical, intent(out) :: error ! Logical error flag
  !
  character(len=32) :: comm
  !
  ! Check data presence in buffer
  call display_check_uv('SHOW',error)
  if (error) return
  !
  ! Plot SIC buffer
  comm = 'let type "%"'
  call exec_command(comm,error)
  call exec_program('@ p_uvshow_sub '//chain)
end subroutine display_uv
!
subroutine uv_sort_comm(line,error)
  use gkernel_interfaces
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING Support routine for command
  !   UVSORT [TIME|BASE|UV]
  !----------------------------------------------------------------------
  character(len=*), intent(in)  :: line  ! Command line
  logical,          intent(out) :: error ! Logical error flag
  !
  ! Local variables
  integer code,na
  character(len=4) argu,voc1(2),vvoc
  data voc1/'BASE','TIME'/ ! ,'UV'/ not needed here
  !
  ! Parse input line. Default argument is TIME
  argu = 'TIME'
  call sic_ke(line,0,1,argu,na,.false.,error)
  if (error) return
  call sic_ambigs('UV_SORT',argu,vvoc,code,voc1,2,error)
  if (error) return
  ! Sort uv buffer
  call uv_tri(code,error)
  if (error) return
  !
end subroutine uv_sort_comm
!
subroutine uv_tri(code,error)
  use gkernel_interfaces
  use imager_interfaces, only : uv_findtb
  use clean_def
  use clean_arrays
  use gbl_message
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING Support routine for command
  !   UVSORT [TIME|BASE|UV]
  !     BASE is code 1
  !     TIME is code 2
  !     UV is code 3
  !----------------------------------------------------------------------
  integer, intent(in)  :: code  ! Sorting code
  logical, intent(out) :: error ! Logical error flag
  !
  ! Local variables
  integer code_bt,code_tb
  parameter(code_bt=1)
  parameter(code_tb=2)
  integer ier,nd,nv,id,iv
  integer, allocatable :: it(:),ot(:)
  real(kind=8), allocatable :: order(:)
  character(len=7) :: rname = 'UV_SORT'
  logical sorted, warning, alloc
  !
  if (.not.associated(duv)) then
    call map_message(seve%e,rname,'No UV data')
    error = .true.
    return
  endif
  error = .false.
  !
  ! Create Sorted UV data
  call sic_delvariable('UVS',.false.,warning)
  !
  ! Check first if UVT is already matching UV
  alloc = .false.
  if (allocated(duvt)) then
    if ( (huv%gil%dim(2).ne.huvt%gil%dim(1)) .or. &
      & (huv%gil%dim(1)+3.ne.huvt%gil%dim(2)) ) then
      deallocate (duvt)
    else
      alloc = .true.
    endif
  endif
  !
  call gildas_null (huvt, type = 'TUV')
  call gdf_transpose_header(huv,huvt,'21  ',error)
  if (error)  return
  nd = huvt%gil%dim(2)
  nv = huvt%gil%dim(1)
  huvt%gil%dim(2) = nd+3
  !
  if (.not.alloc) then
    allocate(duvt(huvt%gil%dim(1),huvt%gil%dim(2)),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Error getting UV memory ')
      error = .true.
      return
    endif
  endif
  call sic_def_real('UVS',duvt,huvt%gil%ndim,huvt%gil%dim,.false.,error)
  if (error) return
  !
  allocate(order(nv),it(nv),ot(nv),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Error getting memory ')
    error = .true.
    return
  endif
  !
  call uv_findtb(code,duv,nv,nd,order,it,ot,sorted)
  if (sorted) then
    !!Print *,'****  SHOW UV -- already sorted for code ',code
    do id=1,nd
      do iv=1,nv
        duvt(iv,id) = duv(id,iv)
      enddo
    enddo
  else
    do id=1,nd
      do iv=1,nv
        duvt(iv,id) = duv(id,it(iv))
      enddo
    enddo
  endif
  do iv=1,nv
    duvt(iv,nd+1) = 1.0
  enddo
  deallocate(order,it,ot)
end subroutine uv_tri
!
subroutine uv_findtb(code,uv,nv,nd,order,it,ot,sorted)
  use imager_interfaces, only : triuv8
  !---------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Support for SHOW UV
  !---------------------------------------------------------------
  integer, intent(in)       :: code      ! Code for sort operation
  integer, intent(in)       :: nd,nv     ! Size of visibility table
  real, intent(in)          :: uv(nd,nv) ! Input UV data
  real(kind=8), intent(out) :: order(nv) ! Sorting array
  integer, intent(out)      :: it(nv)    ! Sort index
  integer, intent(out)      :: ot(nv)    ! Reverse order
  logical, intent(out)      :: sorted    ! Is already sorted
  !
  ! Local variables
  integer code_bt,code_tb
  parameter(code_bt=1)
  parameter(code_tb=2)
  real(kind=4) rdate
  real(kind=8) olast
  integer iv
  logical error
  !
  if (code.eq.code_bt) then
    ! Order BASE(primary) then TIME(secondary)
    rdate = uv(4,1)
    do iv=1,nv
      order(iv) = 1000.d0*86400.0d0*(100.0*uv(6,iv)+uv(7,iv))   &
           &        +(uv(4,iv)-rdate)*86400.d0 + uv(5,iv)
      it(iv) = iv
    enddo
  elseif (code.eq.code_tb) then
    ! Order TIME(primary) then BASE(secondary)
    rdate = uv(4,1)
    do iv=1,nv
      order(iv) =(uv(4,iv)-rdate)*86400.d0 + uv(5,iv) +   &
           &       (100.0d0*uv(6,iv)+uv(7,iv))*1.0d-4
      it(iv) = iv
    enddo
  endif
  !
  ! Check order... This is for dummy UV Tables produced by e.g. UV_CIRCLE
  ! which have no unique ordering...
  olast = order(1)
  sorted = .true.
  do iv=1,nv
    if (order(iv).lt.olast) then
      sorted = .false.
      exit
    endif
    olast = order(iv)
  enddo
  if (sorted) return
  !
  call triuv8(order,it,nv,error)
  if (error) return
  do iv=1,nv
    ot(it(iv)) = iv
  enddo
end subroutine uv_findtb
!
subroutine triuv8(x,it,n,error)
  use gbl_message
  !------------------------------------------------------------------------
  ! @ private
  !
  !   Sorting program that uses a quicksort algorithm.
  ! Applies for an input array of real*8 values, which are left
  ! unchanged. Returns an array of indexes sorted for increasing
  ! order of X. Use GR8_SORT to reorder X.
  !------------------------------------------------------------------------
  integer,      intent(in)    :: n     ! Array length
  real(kind=8), intent(inout) :: x(n)  ! Unsorted array
  integer,      intent(out)   :: it(n) ! Sort index
  logical,      intent(out)   :: error ! Logical return flag
  !
  ! Local variables
  integer mstack, nstop
  parameter(mstack=1000,nstop=15)
  integer i, j, k, itemp, l, r, m, lstack(mstack), rstack(mstack), sp
  real(kind=8) temp, key
  logical mgtl, lgtr, rgtm
  character(len=message_length) :: mess
  !
  ! Initial pointers are already loaded
  !
  if (n.le.nstop) goto 50
  sp = 0
  sp = sp + 1
  lstack(sp) = 1
  rstack(sp) = n
  !
  ! Sort a subrecord off the stack
  ! Set KEY = median of X(L), X(M), X(R)
  ! No! This is not reasonable, as systematic very inequal partitioning will
  ! occur in some cases(especially for nearly already sorted files)
  ! To fix this problem, I found(but I cannot prove it) that it is best to
  ! select the estimation of the median value from intermediate records. P.V.
1 l = lstack(sp)
  r = rstack(sp)
  sp = sp - 1
  m =(l + r) / 2
  !
  mgtl = x(m) .gt. x(l)
  rgtm = x(r) .gt. x(m)
  !
  ! Algorithm to select the median key. The original one from MONGO
  ! was completely wrong. P. Valiron, 24-Jan-84 .
  !
  !       MGTL  RGTM  LGTR  MGTL.EQV.LGTR MEDIAN_KEY
  !
  ! KL < KM < KR  T T * *   KM
  ! KL > KM > KR  F F * *   KM
  !
  ! KL < KM > KR  T F F F   KR
  ! KL < KM > KR  T F T T   KL
  !
  ! KL > KM < KR  F T F T   KL
  ! KL > KM < KR  F T T F   KR
  !
  if (mgtl .eqv. rgtm) then
     key = x(m)
  else
     lgtr = x(l) .gt. x(r)
     if (mgtl .eqv. lgtr) then
        key = x(l)
     else
        key = x(r)
     endif
  endif
  i = l
  j = r
  !
  ! Find a big record on the left
10 continue
  if (x(i).ge.key) goto 11
  i = i + 1
  goto 10
11 continue
  ! Find a small record on the right
20 if (x(j).le.key) goto 21
  j = j - 1
  goto 20
21 continue
  if (i.ge.j) goto 2
  !
  ! Exchange records
  temp = x(i)
  x(i) = x(j)
  x(j) = temp
  itemp = it(i)
  it(i) = it(j)
  it(j) = itemp
  i = i + 1
  j = j - 1
  goto 10
  !
  ! Subfile is partitioned into two halves, left .le. right
  ! Push the two halves on the stack
2 continue
  if (j-l+1 .gt. nstop) then
     sp = sp + 1
     if (sp.gt.mstack) then
        write(mess,*) 'Stack overflow ',sp
        call map_message(seve%e,'SORT',mess)
        error = .true.
        return
     endif
     lstack(sp) = l
     rstack(sp) = j
  endif
  if (r-j .gt. nstop) then
     sp = sp + 1
     if (sp.gt.mstack) then
        write(mess,*) 'Stack overflow ',sp
        call map_message(seve%e,'SORT',mess)
        error = .true.
        return
     endif
     lstack(sp) = j+1
     rstack(sp) = r
  endif
  !
  ! Anything left to process?
  if (sp.gt.0) goto 1
  !
50 continue
  !
  do j = n-1,1,-1
     k = j
     do i = j+1,n
        if (x(j).le.x(i)) goto 121
        k = i
     enddo
121  continue
     if (k.eq.j) goto 110
     temp = x(j)
     do i = j+1,k
        x(i-1) = x(i)
     enddo
     x(k) = temp
     itemp = it(j)
     do i = j+1,k
        it(i-1) = it(i)
     enddo
     it(k) = itemp
110  continue
  enddo
  error = .false.
end subroutine triuv8
!
subroutine uv_flag_comm(line,error)
  use gkernel_interfaces
  use imager_interfaces, except_this=>uv_flag_comm
  use clean_def
  use clean_arrays
  use clean_support
  use clean_types
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING Support routine for command
  !     UV_FLAG [/ANTENNA] [/RESET]
  !----------------------------------------------------------------------
  character(len=*), intent(in)  :: line  ! Command line
  logical,          intent(out) :: error ! Logical error flag
  !
  type(polygon_t), save :: flagspol      ! User defined polygon
  !
  integer :: iant, idate, nc, ic
  integer(kind=index_length) :: iv
  character(len=16) :: argum
  character(len=16) :: chain
  integer, parameter :: O_RESET=3
  integer, parameter :: O_DATE=2
  integer, parameter :: O_ANT=1
  !
  ! Parse input line
  call sic_delvariable('UVFLAG%SUPPORT',.false.,error)
  if (sic_present(O_RESET,0)) then  ! /RESET
    ! Reset flag array
    if (.not.allocated(duvt)) then
      ! No Displayed UV data, work directly
      do iv=1,huv%gil%nvisi
        do ic=1,huv%gil%nchan*huv%gil%nstokes
          duv(7+3*ic,iv) = abs( duv(7+3*ic,iv))
        enddo
      enddo
      return
    endif
    call reset_uvflag(duvt,huvt%gil%dim(1),huvt%gil%dim(2))
    flagspol%ngon = 0
  else if (sic_present(O_ANT,0) ) then  ! /ANTENNA
    flagspol%ngon = 0
    call sic_i4(line,O_ANT,1,iant,.true.,error)
    if (error) return
    ! Verify if data ready
    call display_check_uv('UV_FLAG',error)
    if (error) return
    call get_uvflag_ant(duvt,huvt%gil%dim(1),huvt%gil%dim(2),iant)
  else if (sic_present(O_DATE,0) ) then  ! /DATE
    flagspol%ngon = 0
    call sic_ke(line,O_DATE,1,argum,nc,.true.,error)
    call gag_fromdate(argum(1:nc),idate,error)
    if (error) return
    ! Verify if data ready
    call display_check_uv('UV_FLAG',error)
    if (error) return
    call get_uvflag_date(duvt,huvt%gil%dim(1),huvt%gil%dim(2),idate)
  else
    ! Plot data
    call sic_let_logi('uvshow%flag',.true.,error)
!    call display_buffer_sub('UV_FLAG',2,'UV',line,error)
    chain = 'UV'   !! !dtype//' '//trim(argu1)//' '//trim(argu2) First Last
    call display_uv (chain,error)
    if (error) return
    ! Ideally, plot the previous Polygon if any
    ! ...
    if (flagspol%ngon.ge.2) call greg_poly_plot(flagspol,error)
    ! Make user to define a polygon from cursor
    call sic_defstructure('UVFLAG%SUPPORT',.true.,error)
    call greg_poly_define('UV_FLAG',' ',.false.,flagspol,'UVFLAG%SUPPORT',error)
    if (error)  return
    ! Get flag array
    call get_uvflag(flagspol,duvt,huvt%gil%dim(1),huvt%gil%dim(2))
    call sic_let_logi('uvshow%flag',.false.,error)
  endif
  ! Apply flag array to buffer
  call apply_uvflag(duvt,huvt%gil%dim(1),huvt%gil%dim(2)-3,duv)
  do_weig = .true.
  optimize(code_save_uv)%lastnc = -1 !  means UV data.
end subroutine uv_flag_comm
!
subroutine get_uvflag_ant(uvs,nv,nd,iant)
  use gildas_def
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Set uvflag array from antenna number
  !----------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: nv,nd        ! Size of UV data
  real, intent(inout) :: uvs(nv,nd)
  integer, intent(in) :: iant
  !
  ! Local variables
  integer ne,nf,i
  !
  ne = nd-1
  nf = nd-2
  do i=1,nv
    if (uvs(i,6).eq.iant .or. uvs(i,7).eq.iant) then
      uvs(i,nf) = 0.0
    endif
  enddo
  !
end subroutine get_uvflag_ant
!
subroutine get_uvflag_date(uvs,nv,nd,idate)
  use gildas_def
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Set uvflag array from (gildas) Date number
  !----------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: nv,nd        ! Size of UV data
  real, intent(inout) :: uvs(nv,nd)
  integer, intent(in) :: idate
  !
  ! Local variables
  integer ne,nf,i
  !
  ne = nd-1
  nf = nd-2
  do i=1,nv
    if (uvs(i,4).eq.idate) then
      uvs(i,nf) = 0.0
    endif
  enddo
  !
end subroutine get_uvflag_date
!
subroutine get_uvflag(spol,uvs,nv,nd)
  use gildas_def
  use clean_support
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Get uvflag array from polygon (0 => Flag, 1 => Keep)
  !----------------------------------------------------------------------
  type(polygon_t), intent(in) :: spol                ! User defined region polygon
  integer(kind=index_length), intent(in) :: nv,nd    ! Size of UV data
  real, intent(inout) :: uvs(nv,nd)
  !
  ! Local variables
  integer ne,nf
  !
  ne = nd-1
  nf = nd-2
  !
  ! Oh gosh, all that logic assumes the plotted stuff is in
  ! ne, nd, nf ...
  call gr4_inout(spol,uvs(1,ne),uvs(1,nd),uvs(1,nf),nv,.true.)
  !
end subroutine get_uvflag
!
!
subroutine reset_uvflag(uvs,nv,nd)
  use gildas_def
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Reset uvflag array to 1
  !----------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: nv,nd        ! Size of UV data
  real, intent(inout) :: uvs(nv,nd)   ! UV data set
  !
  ! Local variables
  integer :: nf,i
  !
  nf = nd-2
  do i=1,nv
    uvs(i,nf) = 1.0
  enddo
end subroutine reset_uvflag
!
subroutine apply_uvflag(uvs,nv,nd,uv)
  use gildas_def
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Apply uvflag array by making negative the weight of the flagged data
  !----------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: nv,nd    ! Size of UV data
  real, intent(inout) :: uvs(nv,nd+3)   ! UV data set with Flags
  real, intent(inout) :: uv(nd,nv)      ! Transposed version
  !
  ! Local variables
  real :: factor
  integer :: i,j
  !
  ! Loop on visibilities
  do i=1,nv
    ! Apply uvflag array
    factor = 2*uvs(i,nd+1)-1    ! 1 or -1 depending on selected option
    do j=10,nd,3
      uvs(i,j) = abs(uvs(i,j))*factor
    enddo
    ! Transpose uvs completely because uv and uvs may be ordered differently...
    do j=1,nd
      uv(j,i) = uvs(i,j)
    enddo
  enddo
end subroutine apply_uvflag
