subroutine display_check_uv(comm,chain,error)
  use clean_def
  use clean_arrays
  use clean_default
  use gkernel_interfaces
  use gkernel_types
  use gbl_message
  use iso_c_binding
  use imager_interfaces, only : map_message, uv_tri
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Support for commands 
  !     SHOW UV and UV_FLAG
  !
  !   TIME-BASE sort the UV table before displaying it
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: comm 
  character(len=*), intent(inout) :: chain
  logical, intent(out) :: error ! Logical error flag
  !
  character(len=64) :: nname
  character(len=64), save :: oname
  logical :: do_tri
  type(gildas) :: hin
  type(sic_descriptor_t) :: desc
  type(c_ptr) :: cptr
  real(4), pointer :: r2ptr(:,:)
  integer(kind=4) :: ib
  !
  ib = index(chain,' ')
  if (ib.eq.0) ib = len_trim(chain)
  nname = chain(1:ib)
  call map_message(seve%d,comm,'Requesting sort on '//trim(nname))
  ! Check data presence in buffer - NOT APPROPRIATE AT THIS STAGE ...
  select case (nname)
  case ('UV','DATA_UV','RESIDUAL_UV','MODEL_UV')
    if (.not.associated(duv)) then
      call map_message(seve%e,comm,'No UV data')
      error = .true.
      return
    endif
    chain = 'UV'
  end select
  !
  ! Sort buffer (TIME-BASE) when needed and create the associated SIC buffer
  if (nname.eq.'MODEL_UV') then
    do_tri = uv_model_updated
    uv_model_updated = .false.
  else if (nname.eq.'RESIDUAL_UV') then
    do_tri = uv_resid_updated
    uv_resid_updated = .false.
  else    
    do_tri = .false.
  endif
  !
  if (.not.allocated(duvt)) then
    do_tri = .true.
  else if (oname.ne.nname) then
    do_tri = .true.
  endif
  !
  if (do_tri) then
    if (chain.eq.'UV') then
      call uv_tri(2,huv,duv,error)
    else
      call gildas_null(hin,type='UVT')
      call get_gildas(comm,nname,desc,hin,error)
      if (error) return
      call gdf_copy_header(desc%head,hin,error)
      if (error) return
      call adtoad(desc%addr,cptr)
      call c_f_pointer(cptr,r2ptr,hin%gil%dim(1:2))
      call uv_tri(2,hin,r2ptr,error)
    endif
  else
    call map_message(seve%d,comm,trim(nname)//' is already sorted')
  endif
  oname = nname
  !
end subroutine display_check_uv
!
subroutine select_uvdata(line,comm,error)
  use gkernel_interfaces
  use clean_default
  use clean_arrays
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! IMAGER
  !
  ! @ private
  !
  !   Support for command
  !       UV_DATA [NewOne]
  !   Select the UV_DATA to be Imaged (and Plotted ?)
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  character(len=*), intent(in) :: comm
  logical, intent(inout) :: error
  !
  character(len=12) :: old_uvdata, argum
  integer, parameter :: mcase=6
  integer :: icase,jcase,n
  character(len=12) :: uvcase(mcase), ccase
  data uvcase /'DATA_UV','MODEL_UV','RESIDUAL_UV','UV_DATA','UV_MODEL','UV_RESIDUAL'/
  !
  if (sic_narg(0).eq.0) then
    call map_message(seve%i,comm,'Current UV data is '//current_uvdata)
    return
  endif
  !
  call sic_ke(line,0,1,argum,n,.true.,error)
  call sic_ambigs (comm,argum,ccase,icase,uvcase,mcase,error)
  if (error) return
  !
  old_uvdata = current_uvdata
  jcase = mod(icase-1,3)+1
  current_uvdata = uvcase(jcase) ! Use only the first 3 names.
  !
  if (old_uvdata.ne.current_uvdata) then
    huvc%loca%size = 0
    ! Note that subroutine uv_new_data should NOT be called here.
    ! We just select some data set, we do not modify it.
    !
    ! However, weight may have changed
    do_weig = .true.  
    ! This will not be the case in most cases, but can happen
    ! in the following circumstances
    ! 1) Reading directly by a READ MODEL command some data set 
    !    that may be inconsistent with the READ UV command
    ! 2) UV_RESIDUAL /FIELD  command
    !     To optimize this, a new information should be stored 
    !   which would say whether the weights of a MODEL or RESIDUAL
    !   UV data are just copies of that of the UV_DATA itself.
    !   It is easy to do in the MODEL and UV_RESIDUAL commands,
    !   but then any UV_RESAMPLE, UV_FLAG or what not would
    !   change this information too.
  endif
end subroutine select_uvdata
!
subroutine uvdata_select(comm,error)
  use clean_arrays
  use clean_default
  use gbl_message
  use imager_interfaces, only : map_message
  !
  character(len=*), intent(in):: comm
  logical, intent(inout) :: error
  !
  if (current_uvdata.eq.'DATA_UV') then
    call map_message(seve%i,comm,'Selecting UV data UV_DATA')
    continue
  else if (current_uvdata.eq.'MODEL_UV') then   
    if (huvm%loca%size.eq.0) then
      call map_message(seve%e,comm,'No UV_MODEL available')
      error = .true.
      return
    endif
    call gdf_copy_header(huvm,huv,error)
    duv => duvm
    call map_message(seve%i,comm,'Selecting UV data UV_MODEL')
  else if (current_uvdata.eq.'RESIDUAL_UV') then            
    if (huvf%loca%size.eq.0) then
      call map_message(seve%e,comm,'No UV_RESIDUAL available')
      error = .true.
      return
    endif
    call gdf_copy_header(huvf,huv,error)
    duv => duvf
    call map_message(seve%i,comm,'Selecting UV data UV_RESIDUAL')
  else
    call map_message(seve%w,comm,'Unknown UV_DATA '//current_uvdata)
    return
  endif
end subroutine uvdata_select
!
subroutine display_uv(chain,line,error)
  use clean_def
  use clean_arrays
  use gkernel_interfaces
  use imager_interfaces, only : display_check_uv
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Support for command
  !     SHOW UV
  !   TIME-BASE sort and transpose the UV data and display it.
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: chain
  character(len=*), intent(in) :: line
  logical, intent(out) :: error ! Logical error flag
  !
  character(len=32) :: string, keyw, cval
  integer :: n
  !
  ! Check data presence in buffer
  string = chain
  call display_check_uv('SHOW',string,error)
  if (error) return
  if (sic_narg(0).gt.1) then
    call sic_ke(line,0,2,keyw,n,.true.,error)
    cval = ' '
    call sic_ch(line,0,3,cval,n,.false.,error)
    call exec_program('@ p_uvshow_sub '//string//keyw//cval)
  else
    call exec_program('@ p_uvshow_sub '//string)
  endif
end subroutine display_uv
!
subroutine uv_sort_comm(line,error)
  use gkernel_interfaces
  use clean_arrays
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER Support routine for command
  !   UV_SORT [TIME|BASE|UV]
  ! Sort the UV data in the specified order
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: line  ! Command line
  logical,          intent(out) :: error ! Logical error flag
  !
  character(len=*), parameter :: rname='UV_SORT'
  !
  ! Local variables
  type(gildas) :: htmp
  logical :: err
  integer :: code,jcode,na
  integer, parameter :: mvoc=3
  character(len=12) argu,voc1(mvoc),vvoc
  data voc1/'BASE','TIME','FREQUENCY'/ ! ,'UV'/ not needed here - respect order...
  !
  ! 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(rname,argu,vvoc,code,voc1,mvoc,error)
  if (error) return
  !
  !
  if (vvoc.eq.'FREQUENCY') then
    call uvsort_frequency_mem(huv,duv,error)
  else
    !
    ! Sort uv buffer
    call gildas_null(htmp,type='UVT')
    call uv_buffer_finduv(jcode) 
    call gdf_copy_header(huv,htmp,error)
    call uvdata_select(rname,error)
    if (error) return
    call uv_tri(code,huv,duv,error)
    ! Reset the previous UV data pointers
    call uv_buffer_resetuv(jcode) 
    call gdf_copy_header(htmp,huv,err)
    if (error) return
  endif
  !
end subroutine uv_sort_comm
!
subroutine uv_tri(code,huvin,duvin,error)
  use gkernel_interfaces
  use imager_interfaces, only : uv_findtb, map_message
  use clean_def
  use clean_arrays
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER Support routine for command
  !   UV_SORT [TIME|BASE|UV]
  !
  !     BASE is code 1
  !     TIME is code 2
  !     UV is code 3
  !---------------------------------------------------------------------
  integer, intent(in)  :: code  ! Sorting code
  type(gildas), intent(in) :: huvin   ! UV data to be sorted
  real, intent(in) :: duvin(huvin%gil%dim(1),huvin%gil%dim(2))
  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,mv,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(duvin)) 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 ( (huvin%gil%dim(2).ne.huvt%gil%nvisi) .or. &
      & (10+3*huvin%gil%nchan+huvin%gil%ntrail.ne.huvt%gil%dim(2)) ) then
      deallocate (duvt)
    else
      alloc = .true.
    endif
  endif
  !
  call gildas_null (huvt, type = 'TUV')
  call gdf_transpose_header(huvin,huvt,'21  ',error)
  if (error)  return
  mv = huvin%gil%dim(1)    ! Including trailing columns
  nd = 7+3*huvin%gil%nchan+huv%gil%ntrail ! Also count trailing columns
  nv = huvin%gil%nvisi     ! Number of visibilities
  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,duvin,mv,nv,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) = duvin(id,iv)
      enddo
    enddo
  else
    do id=1,nd
      do iv=1,nv
        duvt(iv,id) = duvin(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,mv,nv,order,it,ot,sorted)
  use imager_interfaces, only : triuv8
  !---------------------------------------------------------------
  ! @ private-mandatory
  !
  ! IMAGER
  !   Support for SHOW UV
  !---------------------------------------------------------------
  integer, intent(in)       :: code      ! Code for sort operation
  integer, intent(in)       :: mv,nv     ! Size of visibility table
  real, intent(in)          :: uv(mv,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
  use imager_interfaces, only : map_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
