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
  !
  ! Check data presence in buffer
  if (.not.associated(duv)) then
     call map_message(seve%e,'SHOW','No UV data')
     error = .true.
     return
  endif
  ! Sort buffer (TIME-BASE) when needed and create the associated SIC buffer
  if (.not.allocated(duvt)) then
     call uv_tri(2,error)
     if (error) return
  endif
  ! Plot SIC buffer
  call exec_program('@ p_uvshow_w.map w '//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=5) argu,vvoc
  character(len=5) voc1(3)
  data voc1/'BASE','TIME','FIELD'/ ! ,'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,3,error)
  if (error) return
  ! Sort uv buffer
  if (code.eq.3) then ! Sort UV table by field
     call uv_fsort(error) ! New by field
  else
     call uv_tri(code,error)
  endif
  if (error) return
  !
end subroutine uv_sort_comm
!
subroutine uv_fsort(error)
  use gkernel_interfaces
  use mapping_interfaces, except => uv_fsort
  use clean_def
  use clean_arrays
  use gbl_message
  !-----------------------------------------------------------------
  ! @ private
  !
  ! MAPPING support routine for command UV_SORT
  ! Allows for sorting for fields using mosaic uv sorting routines
  !-----------------------------------------------------------------
  logical, intent(inout) :: error
  !
  character(len=7) :: rname='UV_SORT'
  logical :: warning,sorted
  logical, allocatable :: signv(:)
  integer(kind=4) :: ier,ncol,nv,nf,xoff,yoff,loff,moff,ixcol,iycol
  integer(kind=index_length) :: iv,ifi,fsize(1)
  integer(kind=4), allocatable :: it(:)
  real(kind=4) :: cs(2),uvmax,uvmin,xy(2)
  real(kind=4), allocatable :: uarr(:),varr(:),foff(:,:),newv(:)
  real(kind=8), allocatable :: farr(:)
  !
  if (.not.associated(duv)) then
     call map_message(seve%e,rname,'No UV data')
     error = .true.
     return
  endif
  ! Do we find pointing offsets?
  xoff = huv%gil%column_pointer(code_uvt_xoff)
  yoff = huv%gil%column_pointer(code_uvt_yoff)
  if ((xoff.ne.0).or.(yoff.ne.0)) then
     ! Yes => This is a mosaic
     if (yoff.ne.xoff+1) then
        ! Ill-defined mosaic
        call map_message(seve%e,rname,'Mosaic Y column does not follow the X column')
        error = .true.
        return
     endif
     ixcol = xoff
     iycol = yoff
  else
     ! No => Do we find phase offsets?
     loff = huv%gil%column_pointer(code_uvt_loff)
     moff = huv%gil%column_pointer(code_uvt_moff)
     if ((loff.ne.0).or.(moff.ne.0)) then
        ! Yes => This is a mosaic
        if (moff.ne.loff+1) then
           ! Ill-defined mosaic
           call map_message(seve%e,rname,'Mosaic M column does not follow the L column')
           error = .true.
           return
        endif
        ixcol = loff
        iycol = moff
     else
        ! No => This is a single-field
        error = .true.
        call map_message(seve%e,rname,'UV table contains a single field, cannot sort it by field')
        return
     endif
  endif  
  !
  ! Create Sorted UV data
  call sic_delvariable('UVS',.false.,warning)
  !
  ! Check if new UV Table (duvt) is already allocated
  if (allocated(duvt))  deallocate (duvt)
  !
  ! Copy header information
  call gildas_null(huvt)
  call gdf_copy_header(huv,huvt,error)
  if (error) return
  !
  ! Allocate duvt
  allocate(duvt(huvt%gil%dim(1),huvt%gil%dim(2)),stat=ier)
  if (ier.ne.0) then
     call map_message(seve%e,rname,'Error allocating secondary UV buffer')
     error = .true.
     return
  endif
  call sic_def_real('UVS',duvt,huvt%gil%ndim,huvt%gil%dim,.false.,error)
  if (error) return
  !
  ! Start sorting using routines from Mosaic mode
  !
  nv = huv%gil%dim(2)
  ncol = huv%gil%dim(1)
  cs(1) = 1.0 ! no UV shift
  cs(2) = 0.0 ! no UV shift
  xy(1) = 0.0 ! no UV shift
  xy(2) = 0.0 ! no UV shift
  !
  allocate(uarr(nv), varr(nv), signv(nv), farr(nv), it(nv), stat=ier)
  if (ier.ne.0) then
     call map_message(seve%e,rname,'Error allocating work arrays')
     error = .true.
     return
  endif
  call loaduv(duv, ncol, nv, cs, uarr, varr, signv, uvmax, uvmin)
  ! Loading field numbers
  call loadfiuv(duv, ncol, nv, farr, it, sorted, ixcol, iycol, varr, nf, foff)
  !
  ! Proceed to sorting
  if (.not.sorted) then
     call gr8_trie (farr,it,nv,error) ! Actual sorting using quicksort
     deallocate (farr, stat=ier) ! Deallocate farr to save some memory
     allocate (newv(nv), stat=ier)
     if (ier.ne.0) then
        call map_message(seve%e,rname,'Error allocating work arrays')
        error = .true.
        return
     endif
     !
     ! v is sorted here so sortuv can be used later
     do iv=1,nv
        newv(iv) = varr(it(iv))
     enddo
     varr(:) = newv(:)
     deallocate (newv,stat=ier) ! Deallocate newv to save some memory
  else
     deallocate (farr,stat=ier) ! if data is already sorted dealocate farr since it will not be used
  endif
  ! Apply sorting to output visibilities
  call sortuv (duv, duvt, ncol, nv, huv%gil%ntrail, xy, uarr, varr, signv, it)
  !
  ! Deallocate reamining arrays to avoid leaks
  deallocate(uarr, varr, signv, it)
  !
  ! Adding field start and end info to Fields variable
  if (allocated(themap%ifields)) deallocate(themap%ifields)
  allocate(themap%ifields(nf+1))
  ifi = 1
  themap%ifields(ifi) = 1
  do iv=1,nv
     if ( (foff(1,ifi).ne.duvt(ixcol,iv)) .or. &
          &  (foff(2,ifi).ne.duvt(iycol,iv)) ) then
        ifi = ifi+1
        themap%ifields(ifi) = iv
     endif
  enddo
  themap%ifields(nf+1) = nv+1
  fsize(1) = nf+1  
  call sic_def_inte("FIELDS%ifields",themap%ifields,1,fsize,.true.,error)
  deallocate(foff)
  !
  error = .false.
end subroutine uv_fsort
!
subroutine uv_tri(code,error)
  use gkernel_interfaces
  use mapping_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 mapping_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 mapping_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
  !
  integer :: iant
  integer, parameter :: O_RESET=2
  integer, parameter :: O_ANT=1
  !
  ! Parse input line
  if (sic_present(O_RESET,0)) then  ! /RESET
    ! Reset flag array
    call reset_uvflag(duvt,huvt%gil%dim(1),huvt%gil%dim(2))
  else if (sic_present(O_ANT,0) ) then  ! /ANTENNA
    call sic_i4(line,O_ANT,1,iant,.true.,error)
    if (error) return
    ! Plot data
    call sic_let_logi('uvshow%flag',.true.,error)
    call display_buffer_sub('UV_FLAG',2,line,error)
    if (error) return
    call get_uvflag_ant(duvt,huvt%gil%dim(1),huvt%gil%dim(2),iant)
  else
    ! Plot data
    call sic_let_logi('uvshow%flag',.true.,error)
    call display_buffer_sub('UV_FLAG',2,line,error)
    if (error) return
    ! Make user to define a polygon from cursor
    call greg_poly_define('UV_FLAG','',.false.,supportpol,supportvar,error)
    if (error)  return
    ! Get flag array
    call get_uvflag(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(uvs,nv,nd)
  use gildas_def
  use clean_support
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Get uvflag array from polygon (0 => Flag, 1 => Keep)
  !----------------------------------------------------------------------
  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(supportpol,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)   ! UV data set
  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
