module field_type
  type field            !! Field data 
    integer :: nvisi    !! Current visibility pointer
    integer :: mvisi    !! Maximum number of visibilities
    real, allocatable :: visi(:,:) !! Visibilities
  end type
end module field_type
!
subroutine uv_sort_comm(line,error)
  use gkernel_interfaces
  use imager_interfaces, except_this => uv_sort_comm
  use clean_arrays
  use gbl_message
  !---------------------------------------------------------------------
  ! @ 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'
  integer, parameter :: mvoc=4
  character(len=12) :: voc1(mvoc)
  data voc1/'BASE','TIME','FIELDS','FREQUENCY'/ ! ,'UV'/ not needed here - respect order...
  !
  ! Local ---
  type(gildas) :: htmp, hiuv, houv
  real, pointer :: duv_previous(:,:), duv_next(:,:)
  integer :: ioff, joff, itel, nu, kv
  logical :: err, ismosaic, sorted
  integer :: code,jcode,na
  character(len=12) :: argu,vvoc
  ! 
  if (huv%loca%size.eq.0) then
    call map_message(seve%e,rname,'No UV data')
    error = .true.
    return
  endif
  call get_mosaic_cols(huv,ioff,joff,itel,ismosaic)  
  !
  ! Parse input line. Default argument is TIME for Single-Fields, FIELDS for Mosaics
  if (ismosaic) then
    argu = 'FIELDS'
  else
    argu = 'TIME'
  endif
  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 (ismosaic) then
    !
    ! For Mosaic, the behaviour is to Sort the UV data
    if (vvoc.eq.'FIELDS') then
      huv%r2d => duv
      call uvsort_check_fields(huv,ioff,joff,itel,sorted)
      if (sorted) then
        call map_message(seve%i,rname,'Mosaic is already sorted by FIELDS')
        return
      endif
    endif
    nullify (duv_previous, duv_next)
    kv = huv%gil%nvisi
    nu = huv%gil%dim(1)
    call uv_find_buffers (rname,nu,kv,duv_previous,duv_next,error)
    call gildas_null(hiuv,type='UVT')
    call gdf_copy_header(huv,hiuv,error)
    hiuv%r2d => duv_previous
    call gildas_null(houv,type='UVT')
    call gdf_copy_header(huv,houv,error)
    houv%r2d => duv_next
    call uvsort_mosaic_mem(hiuv,houv,vvoc,ioff,joff,itel,error)
    call uv_clean_buffers (duv_previous, duv_next,error)
    ! Indicate UV data has changed, and weight must be computed
    call gdf_copy_header(houv,huv,error)
    call uv_new_data(weight=.true.)
    if (error) return  
  else if (vvoc.ne.'FIELDS') then
    !
    ! For Single Fields, the output is a transposed version of the UV data
    ! for further display
    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
    !
  else  
    call map_message(seve%e,rname,'FIELDS keyword is only valid for Mosaics')
    error = .true.
  endif
  !
end subroutine uv_sort_comm
!
subroutine uvsort_check_fields(hiuv,ioff,joff,itel,sorted)
  use image_def
  !
  type(gildas), intent(in) :: hiuv  !! Input UV header
  integer, intent(in) :: ioff       !! X column pointer
  integer, intent(in) :: joff       !! Y column pointer
  integer, intent(in) :: itel       !! Telescope ID pointer
  logical, intent(out) :: sorted    !! Is data sorted ?
  !
  ! Local ---
  integer, parameter :: mf=1024 ! Max number of fields, hardly ever used
  real :: offi(mf), offj(mf)
  integer :: telid(mf)
  real :: offx, offy
  integer :: otel
  integer :: nv,iv
  integer :: nf,jf
  !
  ! Code ----
  sorted = .false.
  nv = hiuv%gil%nvisi
  nf = 1
  !
  offi(1) = hiuv%r2d(ioff,1)
  if (itel.eq.0) then
    if (joff.eq.0) then
      do iv=2,nv
        offx = hiuv%r2d(ioff,iv)
        if (offx.ne.offi(nf)) then
          ! Not the same as the previous one. Is it among the already existing ones ?
          do jf=1,nf-1
            if (offx.eq.offi(jf)) return  ! Yes. Then the data is not sorted
          enddo
          ! No. It is a new one
          nf = nf+1
          offi(nf) = offx
        endif
      enddo
    else
      offj(1) = hiuv%r2d(joff,1)
      do iv=2,nv
        offx = hiuv%r2d(ioff,iv)
        offy = hiuv%r2d(joff,iv)
        if ((offx.ne.offi(nf)).or.(offy.ne.offj(nf))) then
          ! Not the same as the previous one. Is it among the already existing ones ?
          do jf=1,nf-1
            if ((offx.eq.offi(jf)).and.(offy.eq.offj(jf))) return  ! Yes. Then the data is not sorted
          enddo
          ! No. It is a new one
          nf = nf+1
          offi(nf) = offx
          offj(nf) = offy
        endif
      enddo
    endif
  else
    telid(1) = hiuv%r2d(itel,1)
    if (joff.eq.0) then
      do iv=2,nv
        offx = hiuv%r2d(ioff,iv)
        otel = hiuv%r2d(itel,iv)
        if ((offx.ne.offi(nf)).or.(otel.ne.telid(nf))) then
          ! Not the same as the previous one. Is it among the already existing ones ?
          do jf=1,nf-1
            if ((offx.eq.offi(jf)).and.(otel.eq.telid(jf))) return  ! Yes. Then the data is not sorted
          enddo
          ! No. It is a new one
          nf = nf+1
          offi(nf) = offx
          telid(nf) = otel
        endif
      enddo
    else
      offj(1) = hiuv%r2d(joff,1)
      do iv=2,nv
        offx = hiuv%r2d(ioff,iv)
        offy = hiuv%r2d(joff,iv)
        otel = hiuv%r2d(itel,iv)
        if ((offx.ne.offi(nf)).or.(offy.ne.offj(nf)).or.(otel.ne.telid(nf))) then
          ! Not the same as the previous one. Is it among the already existing ones ?
          do jf=1,nf-1
            if ((offx.eq.offi(jf)).and.(offy.eq.offj(jf)).and.(otel.eq.telid(jf))) return  ! Yes. Then the data is not sorted
          enddo
          ! No. It is a new one
          nf = nf+1
          offi(nf) = offx
          offj(nf) = offy
          telid(nf) = otel
        endif
      enddo
    endif
  endif
  sorted = .true.
end subroutine uvsort_check_fields
!
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)) !! Visibilities
  logical, intent(out) :: error       !! Logical error flag
  !
  character(len=7) :: rname = 'UV_SORT'
  !
  ! Local ---
  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(:)
  logical sorted, warning, alloc
  !
  ! Code ----
  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
  !
  !   Check if ordered according to Code, and return sorting
  ! order if needed.
  !---------------------------------------------------------------
  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
  !
  ! Constants
  integer, parameter :: code_bt=1
  integer, parameter :: code_tb=2
  !
  ! Local variables
  real(kind=4) rdate
  real(kind=8) olast
  integer iv
  logical error
  !
  ! Code ----
  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
!
subroutine uv_sort_file(line,error)
  use image_def
  use gkernel_interfaces
  use field_type
  use gbl_message
  use imager_interfaces, except_this => uv_sort_file
  !----------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER --  Support routine for command  
  !   UV_SORT [TIME|BASE|FIELDS|FREQUENCY] /FILE FileIn FileSort
  !!
  !----------------------------------------------------------------------
  character(len=*), intent(in)  :: line  !! Command line
  logical,          intent(out) :: error !! Logical error flag
  !
  ! Constants
  character(len=*), parameter :: rname='UV_SORT'
  integer, parameter :: o_file=1 ! /FILE option order
  integer, parameter :: mvoc=4
  character(len=12) voc1(mvoc)
  data voc1/'BASE','TIME','FIELDS','FREQUENCY'/ ! ,'UV'/ not needed here
    !
  ! Local ---
  character(len=12) argu,vvoc
  integer :: iunit, code, na
  type(gildas) :: hiuv, houv
  integer :: ioff,joff,itel
  character(len=filename_length) :: in_file, ou_file
  character(len=120) :: mess
  logical :: ismosaic
  integer :: n, nblock
  !
  ! Code ----
  !
  ! Parse input line. Default argument is TIME
  argu = 'BASE'
  call sic_ke(line,0,1,argu,na,.false.,error)
  if (error) return
  call sic_ambigs('UV_SORT',argu,vvoc,code,voc1,mvoc,error)
  if (error) return
  !
  call gildas_null(hiuv,type='UVT')
  call gildas_null(houv,type='UVT')
  !
  ! Get the file names
  call sic_ch(line,o_file,1,in_file,n,.true.,error)
  if (error) return
  call sic_parse_file(in_file,' ','.uvt',hiuv%file)
  !
  ! Strip extension if present
  call sic_parsef(in_file,ou_file,' ','.uvt')
  ou_file = in_file
  !
  ! Sorted  UV table
  if (sic_present(o_file,2)) then
    call sic_ch(line,o_file,2,ou_file,n,.true.,error)
  else
    ou_file = trim(in_file)//'-sort'
  endif
  !
  ! Treat the Frequency re-ordering separately
  if (vvoc.eq.'FREQUENCY') then
    call uvsort_frequency_file(in_file,ou_file,error)
    return
  endif
  !
  ! Other UV_SORT cases
  call gdf_read_header(hiuv,error)
  if (error) return
  !
  ! Prepare a proper output Header
  call gdf_copy_header(hiuv,houv,error)
  if (error) return
  !
  ! Finalize output file name
  call sic_parse_file(ou_file,' ','.uvt',houv%file)
  !
  ! Set the Blocking Factor
  nblock = space_nitems('SPACE_IMAGER',hiuv,1) 
  iunit = 6
  !
  ! Get the offset columns
  call get_mosaic_cols(hiuv,ioff,joff,itel,ismosaic)
  !
  if (ismosaic) then
    write(mess,'(A,I0,A,I0,A,I0)') 'Mosaic of file size ',hiuv%gil%dim(2), &
      & ' and blocking factor ',nblock      
    call map_message(seve%i,rname,mess)
      call uvsort_mosaic_disk(hiuv,houv,vvoc,ioff,joff,itel,error)
    !
  else
    !
    if (nblock.ge.hiuv%gil%dim(2)) then
      call map_message(seve%i,rname,'Doing in-memory sort')
      call uvsort_single_mem(hiuv,houv,vvoc,error)
      !
    else
      !
      ! Must be made from disk...
      !call big_stupid_uvsort(hiuv%file, houv%file, vvoc, error)
      call uvsort_single_disk(hiuv, houv, vvoc, error)
    endif
  endif
  !
end subroutine uv_sort_file
!
subroutine get_mosaic_cols(hiuv,ioff,joff,itel,ismosaic)
  use image_def
  ! @ private
  !!  Returns 
  type(gildas), intent(in) :: hiuv    !! Input UV header
  integer, intent(out) :: ioff        !! Pointer to X offset
  integer, intent(out) :: joff        !! Pointer to Y offset
  integer, intent(out) :: itel        !! Pointer to Telescope ID
  logical, intent(out) :: ismosaic    !! Mosaic indicator
  !
  ! Local
  integer :: loff,moff,poff,qoff,idoff
  !
  ismosaic = .true.
  loff = hiuv%gil%column_pointer(code_uvt_loff)
  moff = hiuv%gil%column_pointer(code_uvt_moff)
  poff = hiuv%gil%column_pointer(code_uvt_xoff)
  qoff = hiuv%gil%column_pointer(code_uvt_yoff)
  idoff = hiuv%gil%column_pointer(code_uvt_id)
  itel = hiuv%gil%column_pointer(code_uvt_tele)
  if ((loff.ne.0).and.(moff.ne.0)) then
    ioff = loff
    joff = moff
  else if ((poff.ne.0).and.(qoff.ne.0)) then
    ioff = poff
    joff = qoff
  else if (idoff.ne.0) then
    ioff = idoff
    joff = 0
  else if (itel.ne.0) then
    ioff = 0
    joff = 0
  else
    ismosaic = .false.
  endif
end subroutine get_mosaic_cols

subroutine resize_real_array(array,osize,nsize)
  !
  ! @ public-mandatory
  !! IMAGER - Utility routine to extend a REAL array
  !
  real, allocatable, intent(inout) :: array(:) !! Array to be resized
  integer, intent(in) :: osize    !! Old size
  integer, intent(in) :: nsize    !! New size
  !
  real, allocatable :: tmp_arr(:)
  !
  !!write(iunit,*) 'Real resize from ',osize,' to ',nsize
  if (osize.eq.0) then
    allocate(array(nsize))
  else
    allocate(tmp_arr(nsize))
    tmp_arr(1:osize) = array
    deallocate(array)
    call move_alloc(tmp_arr, array)
  endif
  ! tmp_arr is now deallocated
end subroutine resize_real_array
!
subroutine resize_inte_array(array,osize,nsize)
  !
  ! @ public-mandatory
  !! IMAGER - Utility routine to extend a INTEGER array
  !
  integer, allocatable, intent(inout) :: array(:) !! Array to be resized
  integer, intent(in) :: osize    !! Old size
  integer, intent(in) :: nsize    !! New size
  !
  integer, allocatable :: tmp_arr(:)
  !
  if (osize.eq.0) then
    allocate(array(nsize))
  else
    allocate(tmp_arr(nsize))
    tmp_arr(1:osize) = array
    deallocate(array)
    call move_alloc(tmp_arr, array)
  endif
  ! tmp_arr is now deallocated
end subroutine resize_inte_array
!
subroutine resize_dble_array(array,osize,nsize)
  !
  ! @ public-mandatory
  !! IMAGER - Utility routine to extend a DBLE array
  !
  real(8), allocatable, intent(inout) :: array(:) !! Array to be resized
  integer, intent(in) :: osize    !! Old size
  integer, intent(in) :: nsize    !! New size
  !
  real(kind=8), allocatable :: tmp_arr(:)
  !
  if (osize.eq.0) then
    allocate(array(nsize))
  else
    allocate(tmp_arr(nsize))
    tmp_arr(1:osize) = array
    deallocate(array)
    call move_alloc(tmp_arr, array)
  endif
  ! tmp_arr is now deallocated
end subroutine resize_dble_array
!
!
subroutine uvsort_tb (hin,hou,error)
  use gkernel_interfaces
  use image_def
  use gbl_message
  use imager_interfaces, only : map_message
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Sorting utility routine  
  !
  !     Sort a UV data set by Time-Baseline order.
  !     Data must be in the %R2D pointer
  !!
  !----------------------------------------------------------------------
  type(gildas), intent(inout) :: hin    !! Input UV data
  type(gildas), intent(inout) :: hou    !! Output UV data
  logical, intent(out) :: error         !! Error flage
  !
  ! Local ---
  character(len=*), parameter :: rname='UVSORT_TB'
  character(len=60) :: mess
  integer :: ier
  integer :: nv
  integer :: np
  real(8), allocatable :: times(:)
  integer, allocatable :: indx(:)
  logical :: sorted
  !
  ! Code ----
  if (hin%gil%nvisi.gt.huge(nv)) then
    write(mess,*) 'Cannot handle more than ',huge(nv),' visibilities'
    call map_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  nv = hin%gil%nvisi
  np = hin%gil%dim(1)
  !
  allocate(times(nv),indx(nv), stat=ier)
  error = ier.ne.0
  if (error) return
  call loadtb (hin%r2d,np,nv,times,indx,sorted,4)
  !
  ! Sort if needed
  if (.not.sorted) then
    call gr8_trie(times,indx,nv,error)
    if (error) then
      call map_message(seve%e,rname,'Sorting error')
    else
      call sortiv (hin%r2d,hou%r2d,np,nv,indx)
    endif
  else
    call map_message(seve%w,rname,'Table is already sorted')
    hou%r2d = hin%r2d
  endif
  deallocate(times,indx)
end subroutine uvsort_tb
!
subroutine sortiv (vin,vout,np,nv,it)
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support routine for UV_SORT
  !
  !     Sort an input UV table into an output one, according
  !     to an index array
  !!
  !----------------------------------------------------------------------
  integer, intent(in) :: np         !! Size of a visibility
  integer, intent(in) ::  nv        !! Number of visibilities
  real, intent(in) ::  vin(np,nv)   !! Input visibilities
  real, intent(out) ::  vout(np,nv) !! Output visibilities
  integer, intent(in) ::  it(nv)    !! Sorting pointer
  !
  integer iv,kv,ic
  !
  ! Simple case
  do iv=1,nv
    kv = it(iv)
    vout(:,iv) = vin(:,kv)
    if (vout(6,iv).gt.vout(7,iv)) then
      vout(6,iv) = vin(7,kv)
      vout(7,iv) = vin(6,kv)
      do ic=9,np,3
        vout(ic,iv) = -vout(ic,iv)
      enddo
    endif
  enddo
end subroutine sortiv
!
subroutine uvsort_bt (hin,hou,error)
  use gkernel_interfaces
  use image_def
  use gbl_message
  use imager_interfaces, only : map_message
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support routine for UV_SORT
  !
  !     Sort by Baseline - Time.
  !     Data must be in the %R2D pointers
  !!
  !----------------------------------------------------------------------
  type(gildas), intent(inout) :: hin  !! Input header
  type(gildas), intent(inout) :: hou  !! Output header
  logical, intent(out) :: error       !! Error flag
  !
  character(len=*), parameter :: rname='UVSORT_BT'
  character(len=60) :: mess
  integer :: ier
  integer :: nv
  integer :: np
  real(8), allocatable :: times(:)
  integer, allocatable :: indx(:)
  logical :: sorted
  !
  if (hin%gil%nvisi.gt.huge(nv)) then
    write(mess,*) 'Cannot handle more than ',huge(nv),' visibilities'
    call map_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  nv = hin%gil%nvisi
  np = hin%gil%dim(1)
  !
  allocate(times(nv),indx(nv), stat=ier)
  error = ier.ne.0
  if (error) return
  call loadbt (hin%r2d,np,nv,times,indx,sorted,4)
  !
  ! Sort if needed
  if (.not.sorted) then
    call gr8_trie(times,indx,nv,error)
    if (error) then
      call map_message(seve%e,rname,'Sorting error')
    else
      call sortiv (hin%r2d,hou%r2d,np,nv,indx)
    endif
  else
    call map_message(seve%w,rname,'Table is already sorted')
    hou%r2d = hin%r2d
  endif
  deallocate(times,indx)
end subroutine uvsort_bt
!
subroutine loadbt (visi,np,nv,tb,it,sorted,idate)
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER --  Support routine for UV_SORT 
  !
  !     Load Baseline / Time combination into work arrays for sorting
  !   and check if data is already sorted.
  !!
  !----------------------------------------------------------------------
  integer, intent(in)  :: np                   !! Size of a visibility
  integer, intent(in)  :: nv                   !! Number of visibilities
  real, intent(in) :: visi(np,nv)              !! Input visibilities
  real(8), intent(out) :: tb(nv)               !! Output Date+Time
  integer, intent(out) :: it(nv)               !! Indexes
  logical, intent(out) :: sorted               !! Is data sorted ?
  integer, intent(in)  :: idate                !! Date pointer
  !
  integer, external :: uvshort_basenum
  !
  integer :: iv, itime, iant, jant, id, jd, nd,ier
  real(8) :: vmax, dd
  integer, allocatable :: dates(:),jdate(:)
  !
  itime = idate+1
  iant = itime+1
  jant = iant+1
  !
  ! Compact the dates - We could be less Memory hungry 
  !   - dates could be much smaller
  !   - jdate can be avoided (see the Disk version in same file)
  allocate(dates(nv),jdate(nv),stat=ier)
  if (ier.ne.0) return
  nd = 1
  dates(nd) = visi(idate,1)
  jdate(1) = 0
  do iv=2,nv
    jd = 0
    do id = 1,nd
      if (visi(idate,iv).eq.dates(id)) then
        jd = id
        jdate(iv) = jd-1
        exit
      endif
    enddo
    if (jd.eq.0) then
      nd = nd+1
      dates(nd) = visi(idate,iv)
      jdate(iv) = nd-1
    endif
  enddo
  !
  dd = nd+2
  do iv=1,nv
    ! Time compacted value:
    ! This is a date in Days, with a minimun range
    tb(iv) = ( dble(jdate(iv))+dble(visi(itime,iv))/86400d0 ) 
    tb(iv) = tb(iv) / dd  ! That is between [0,1]
    ! Add the baseline number code as major driver
    tb(iv) = tb(iv) + uvshort_basenum(visi(iant,iv),visi(jant,iv))
  enddo
  !
  do iv=1,nv
    it(iv) = iv
  enddo
  !
  vmax = tb(1)
  do iv = 1,nv
    if (tb(iv).lt.vmax) then
      sorted = .false.
      return
    endif
    vmax = tb(iv)
  enddo
  sorted = .true.
end subroutine loadbt
!
!
subroutine loadtb (visi,np,nv,tb,it,sorted,idate)
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support routine for UV_SORT
  !
  !     Load new U,V coordinates and sign indicator into work arrays
  !     for  Time-Basline sorting.
  !!
  !----------------------------------------------------------------------
  integer, intent(in)  :: np                   !! Size of a visibility
  integer, intent(in)  :: nv                   !! Number of visibilities
  real, intent(in) :: visi(np,nv)              !! Input visibilities
  real(8), intent(out) :: tb(nv)               !! Output Date+Time
  integer, intent(out) :: it(nv)               !! Indexes
  logical, intent(out) :: sorted               !! Is data sorted
  integer, intent(in)  :: idate                !! Date pointer
  !
  integer :: iv, itime, iant, jant, id, jd, nd,ier
  integer, allocatable :: dates(:),jdate(:)
  integer :: imin, imax
  real(8) :: vmax
  !
  ! Scan how many days
  itime = idate+1
  iant = itime+1
  jant = iant+1
  allocate(dates(nv),jdate(nv),stat=ier)
  if (ier.ne.0) return
  nd = 1
  dates(nd) = visi(idate,1)
  jdate(1) = 0
  do iv=2,nv
    jd = 0
    do id = 1,nd
      if (visi(idate,iv).eq.dates(id)) then
        jd = id
        jdate(iv) = jd-1
        exit
      endif
    enddo
    if (jd.eq.0) then
      nd = nd+1
      dates(nd) = visi(idate,iv)
      jdate(iv) = nd-1
    endif
  enddo
  !
  do iv=1,nv
    ! Time compacted value in seconds
    tb(iv) = dble(jdate(iv))*86400d0+dble(visi(itime,iv))
    ! The baseline is not accounted for into this yet...
    ! Do it by adding the baseline number as a sub-item.
    ! This assumes time differ by more than 1 second here, and there
    ! are less than 256 antennas
    imax = max(visi(iant,iv),visi(jant,iv))
    imin = min(visi(iant,iv),visi(jant,iv))    
    tb(iv) = tb(iv) + (256.0*imin+imax)/(256.0*256.0)
  enddo
  !
  do iv=1,nv
    it(iv) = iv
  enddo
  !
  vmax = tb(1)
  do iv = 1,nv
    if (tb(iv).lt.vmax) then
      sorted = .false.
      return
    endif
    vmax = tb(iv)
  enddo
  sorted = .true.
end subroutine loadtb
!
subroutine uvsort_single_mem(hiuv,houv,ctype,error)
  use gkernel_types
  use imager_interfaces, except_this => uvsort_single_mem
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER --  Support for UV_SORT /FILE
  !
  !   Sort the UV data file by loading all in Memory 
  !!
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: hiuv   !! Input UV header
  type(gildas), intent(inout) :: houv   !! Output UV header
  character(len=*), intent(in) :: ctype !! sort type
  logical, intent(out) :: error         !! Error flag
  !
  character(len=*), parameter :: rname='UV_SORT'
  !
  integer :: ier
  character(len=80) :: mess
  integer :: np, nv
  real(4) :: uvmax, uvmin, xy(2), cs(2)
  logical :: an_error
  !
  if (hiuv%file .eq. houv%file) then
    call map_message(seve%e,rname,'In place sorting not allowed')
    error = .true.
    return
  endif
  !
  allocate(hiuv%r2d(hiuv%gil%dim(1),hiuv%gil%dim(2)), & 
    & houv%r2d(houv%gil%dim(1),houv%gil%dim(2)),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Cannot Allocate UV data')
    error = .true.
    return
  endif
  !
  call gdf_read_data(hiuv, hiuv%r2d, error)
  if (error) then
    call map_message(seve%e,rname,'Cannot read UV data')
    deallocate(hiuv%r2d,houv%r2d)
    return
  endif
  !
  select case (ctype)
  case ('TIME')
    call uvsort_tb(hiuv,houv,error)
  case ('BASE')
    call uvsort_bt(hiuv,houv,error)
  case ('UV')
    if (hiuv%gil%nvisi.gt.huge(nv)) then
      write(mess,*) 'Cannot handle more than ',huge(nv),' visibilities'
      call map_message(seve%e,rname,mess)
      error = .true.
    else
      nv = hiuv%gil%nvisi
      np = hiuv%gil%dim(1)
      xy = 0.
      call uvsort_uv (np,nv,hiuv%gil%ntrail,     &
        &      hiuv%r2d,houv%r2d,                &
        &      xy,cs,uvmax,uvmin,error)
      write (mess,'(A,F10.2,F10.2)') 'Min - Max UV-spacing: ',uvmin,uvmax
      call map_message(seve%i,rname,mess)
    endif
  !case ('FIELDS')
  !  call uvsort_fi(hiuv,houv,error)
  case default
    call map_message(seve%e,rname,'Does not yet handle '//ctype)
    error = .true.
  end select
  !
  if (.not.error) then
    call gdf_write_image(houv,houv%r2d,error)
  endif
  !
  ! Free memory and close images if opened
  deallocate(hiuv%r2d,houv%r2d,stat=ier)
  an_error = .false.
  call gdf_close_image(hiuv,an_error)
  if (error) then
    an_error = .false.
    call gdf_close_image(houv,an_error)
  endif
end subroutine uvsort_single_mem
!
subroutine big_stupid_uvsort(uvdata,uvtri,type,error)
  use image_def
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message, sub_sortuv, chksuv, loaduv
  !----------------------------------------------------------------------
  ! IMAGER -- Sort an input UV table
  !
  !       Add CC code to implement precession
  !----------------------------------------------------------------------
  character(len=*), intent(in) :: type
  character(len=*), intent(in) :: uvdata,uvtri
  logical, intent(out) :: error
  !
  ! Local variables:
  character(len=*), parameter :: rname='BIG_UVSORT'
  character(len=60) :: mess
  type (gildas) :: in, out
  character(len=12) :: xtype
  character(len=filename_length) :: name
  real, allocatable :: din(:,:)
  real(8), allocatable :: times(:)
  integer, allocatable :: indx(:)
  real(4), allocatable :: u(:), v(:)
  logical, allocatable :: s(:)
  integer :: codes(4)
  logical :: sorted
  integer :: iv,jv,kv,mv,ib
  integer :: nblock
  integer :: one(1)
  !
  real xy(2),cs(2), uvmax, uvmin
  integer :: ier, np, nv
  data xy/0.0,0.0/, cs/1.0,0.0/
  data xtype /'UV-DATA'/
  !
  error = .false.
  call map_message(seve%w,rname,'Doing '//trim(type)//' sorting for huge file')
  !
  ! Input file
  call gildas_null(in, type = 'UVT')
  name = trim(uvdata)
  call gdf_read_gildas(in, name, '.uvt', error, data=.false.)
  !
  nv = in%gil%nvisi
  allocate (indx(nv),times(nv),stat=ier)
  error = ier.ne.0
  if (error) return
  !
  sorted = .false.
  if  (type.eq.'TIME') then
    allocate (din(4,nv),stat=ier)
    codes(1:4) = [code_uvt_date, code_uvt_time, code_uvt_anti, code_uvt_antj]
    call gdf_read_uvonly_codes(in, din, codes, 4, error)
    call loadtb (din,4,nv,times,indx,sorted,1)
  elseif  (type.eq.'BASE') then
    allocate (din(4,nv),stat=ier)
    codes(1:4) = [code_uvt_date, code_uvt_time, code_uvt_anti, code_uvt_antj]
    call gdf_read_uvonly_codes(in, din, codes, 4, error)
    call loadbt (din,4,nv,times,indx,sorted,1)
  elseif (type.eq.'UV') then
    allocate (din(2,in%gil%nvisi),stat=ier)
    codes(1:2) = [code_uvt_u,code_uvt_v]
    call gdf_read_uvonly_codes(in, din, codes, 2, error)
    !
    allocate(u(nv),v(nv),s(nv),stat=ier)
    call loaduv (din,2,nv,cs,u,v,s,uvmax,uvmin)
    call chksuv (nv,v,indx,sorted)
    if (.not.sorted) then
      allocate (in%r2d(in%gil%dim(1),1), stat=ier)
      times(1:nv) = v(1:nv)
    endif
  endif
  !
  ! Sort if needed
  if (sorted) then
    call map_message(seve%e,rname,'Input file is already sorted')
    error = .true.
    return ! Do not even copy the input file ?...
  endif
  !
  call gr8_trie(times,indx,nv,error)
  if (error) return
  !
  ! Simple case
  call gildas_null(out, type = 'UVT')
  call gdf_copy_header(in,out,error)
  name = trim(uvtri)
  call sic_parsef(name,out%file,' ','.uvt')
  if (in%file .eq. out%file) then
    call map_message(seve%e,rname,'In place sorting not allowed')
    error = .true.
    return
  endif
  call gdf_create_image (out,error)
  if (error) return
  !
  call gdf_nitems('SPACE_GILDAS',nblock,out%gil%dim(1))
  nblock = min(out%gil%dim(2),nblock)
  allocate (out%r2d(out%gil%dim(1),nblock), stat=ier)
  !
  ! Loop over line table
  out%blc = 0
  out%trc = 0
  in%blc = 0
  in%trc = 0
  iv = 0
  one(1) = 1
  np = in%gil%dim(1)
  !
  ! Create output by block
  do ib = 1,out%gil%nvisi,nblock
    write(mess,*) ib,' / ',out%gil%nvisi,nblock
    call map_message(seve%d,rname,mess)
    out%blc(2) = ib
    out%trc(2) = min(out%gil%dim(2),ib-1+nblock)
    mv = out%trc(2)-out%blc(2)+1
    !
    ! Build the output only one visibility at once
    ! This can be VERY slow, but no other choice here...
    do jv=1,mv
      iv = iv+1
      kv = indx(iv)
      in%blc(2) = kv
      in%trc(2) = kv
      if (type.eq.'UV') then
        ! Read and modify the visibility because of
        ! the possible phase shift
        call gdf_read_data(in,in%r2d,error)
        call sub_sortuv (in%r2d,out%r2d(:,jv),np,1,in%gil%ntrail, &
          &   xy,1,1,u(kv),v(kv),s(kv),one)
      else
        ! Just read in appropriate place
        call gdf_read_data(in,out%r2d(:,jv),error)
      endif
    enddo
    call gdf_write_data (out,out%r2d,error)
    if (error) return
  enddo
  !
  call gdf_close_image(out,error)
  if (error) then
    call map_message(seve%e,rname,'Error writing UV table')
    return
  endif
end subroutine big_stupid_uvsort
!
subroutine uvsort_mosaic_disk(hiuv,houv,ctype,ioff,joff,itel,error)
  use gkernel_types
  use imager_interfaces, except_this => uvsort_mosaic_disk
  use gkernel_interfaces
  use field_type
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !* 
  ! IMAGER -- 
  !   Support for UV_SORT /FILE
  !
  !   Sort a Mosaic UV table - Each field must be independently sorted.
  !     by Time-Baseline 
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: hiuv       !! Input UV header
  type(gildas), intent(inout) :: houv       !! Output UV header
  character(len=*), intent(in) :: ctype     !! Type of sorting
  integer, intent(in) :: ioff               !! Offset column pointer
  integer, intent(in) :: joff               !! Offset column pointer
  integer, intent(in) :: itel               !! Telescope column pointer
  logical, intent(out) :: error             !! Error flag
  !
  ! Constants
  character(len=*), parameter :: rname='UV_SORT'
  !
  ! Local ---
  real :: xoff,yoff,rtel
  real, allocatable :: xfield(:), yfield(:),tfield(:) ! Field coordinates
  integer, allocatable :: iblc(:), itrc(:)  ! File pointers 
  integer, allocatable :: ifield(:)         ! Field pointer for each visibility
  integer, allocatable :: vfield(:)         ! Number of visibilities per field
  type (field), allocatable :: fields(:)    ! Fields data
  integer :: vsize ! Visibility size
  integer :: nvisi, mvisi
  integer(kind=index_length) :: mvis, kv
  integer :: if, iv, jv, ib, kf, mf, nf, of, jf
  integer :: ier, nblock
  !
  integer :: basenum
  real(kind=8) :: ti,rti,vmax
  real(kind=8), allocatable :: ddates(:), tb(:)
  real(kind=4), allocatable, target :: avisi(:,:), bvisi(:,:)
  integer(kind=4), allocatable :: indx(:)
  integer:: j,jt,mdates,ndates
  real(kind=8) :: maxdat, mindat, spadat
  logical :: sorted, an_error
  !
  character(len=120) :: mess
  character(len=filename_length) :: final_file
  !
  ! Code ----
  nblock = space_nitems('SPACE_GILDAS',hiuv,1)  
  mdates = 10 ! A good starting number of dates...
  !
  final_file = houv%file ! Save 
  !
  vsize = hiuv%gil%dim(1)
  nf = 0
  of = 0
  !
  ! Read the input file by block
  mvisi = nblock
  !
  allocate(hiuv%r2d(hiuv%gil%dim(1),mvisi),ifield(mvisi),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Input Memory allocation error')
    error = .true.
    return
  endif
  !
  ! Get the fields by Block
  do ib=1,hiuv%gil%dim(2),mvisi
    !
    ! Read the data
    write(mess,*) ib,' / ',hiuv%gil%dim(2),mvisi
    call map_message(seve%i,rname,mess)
    hiuv%blc(2) = ib
    hiuv%trc(2) = min(hiuv%gil%dim(2),ib-1+mvisi)
    nvisi = hiuv%trc(2)-hiuv%blc(2)+1
    call gdf_read_data(hiuv,hiuv%r2d,an_error)
    if (an_error) exit 
    !
    nf = 0 ! We start with an empty number of Fields
    rtel = 0
    !
    do iv=1,nvisi
      kf = 0
      xoff = hiuv%r2d(ioff,iv)
      yoff = hiuv%r2d(joff,iv)
      if (itel.ne.0) rtel = hiuv%r2d(itel,iv)
      do if=1,nf
        if (xfield(if).eq.xoff .and. yfield(if).eq.yoff &
        & .and. tfield(if).eq.rtel) then
          kf = if
          exit
        endif
      enddo
      !
      ! Prepare buffers to handle the Fields characteristics
      if (kf.eq.0) then
        nf = nf+1
        if (nf.gt.of) then
          if (of.eq.0) then
            mf = 10   ! Start with 10 fields
          else
            mf = 2*of ! Double the field numbers
          endif
          call resize_real_array(xfield,of,mf)
          call resize_real_array(yfield,of,mf)
          call resize_real_array(tfield,of,mf)
          call resize_inte_array(itrc,of,mf)
          call resize_inte_array(iblc,of,mf)
          call resize_inte_array(vfield,of,mf)
          of = mf
        endif
        xfield(nf) = xoff
        yfield(nf) = yoff
        iblc(nf) = 1
        itrc(nf) = 1
        vfield(nf) = 1
        kf = nf
      else
        ! Increment the visibilities here...
        itrc(kf) = itrc(kf)+1
        vfield(kf) = vfield(kf)+1
      endif
      !
      ! Remember the field pointer
      ifield(iv) = kf
      !
    enddo
    write(mess,'(A,I0,A)') 'Found ',nf,' fields'
    call map_message(seve%i,rname,mess)
    !
    ! Allocate work space per field to the field size computed before
    allocate(fields(nf),stat=ier)
    do if=1,nf
      nvisi = itrc(if)-iblc(if)+1
      nvisi = vfield(if)
      if (nvisi.gt.0) then
        allocate(fields(if)%visi(vsize,nvisi),stat=ier)
        if (ier.ne.0) then
          call map_message(seve%e,rname,'Field Memory allocation error')
          an_error = .true.
          exit
        endif
      endif
      fields(if)%mvisi = nvisi
      fields(if)%nvisi = 0
    enddo
    !
    if (an_error) return 
    !
    ! Second pass, split into the workspaces
    nvisi = hiuv%trc(2)-hiuv%blc(2)+1
    do iv=1,nvisi
      if = ifield(iv)
      !
      if (fields(if)%nvisi.eq.fields(if)%mvisi) then
        write(mess,'(A,I0,A,I0,A,I0)') 'Fields ',if,' visibility overrun ',vfield(if),' at visi ',iv
        call map_message(seve%e,rname,mess)
        an_error = .true.
        exit
      endif
      fields(if)%nvisi = fields(if)%nvisi +1
      jv = fields(if)%nvisi
      !! write(iunit,*) 'Field ',if,' In visi ',iv,' outvisi ',jv
      fields(if)%visi(:,jv) = hiuv%r2d(:,iv)
    enddo
    !
    ! Write the workspaces to different files
    if (.not.an_error) then
      jf = 0
      do if=1,nf
        if (fields(if)%nvisi.gt.0) then
          write(houv%file,'(A,I0,A)') 'tmp-',if,'.uvt'
          if (iblc(if).eq.1) then
            write(mess,'(A,I0,A)') 'Creating '//trim(houv%file)//' with ',fields(if)%nvisi,' visi...'
            call map_message(seve%i,rname,mess)
            ! Field must be created
            houv%blc = 0
            houv%trc = 0
            houv%gil%nvisi = fields(if)%nvisi
            houv%gil%dim(2) = houv%gil%nvisi
            call gdf_write_image(houv,fields(if)%visi,an_error)
            if (an_error) exit
          else
            ! Field already existed
            call gdf_read_header(houv,an_error)
            if (an_error) exit
            mvis = houv%gil%nvisi + fields(if)%nvisi
            !
            if (mvis.gt.houv%gil%dim(2)) then
              write(mess,'(A,I0,A,I0,A)') 'Extending '//trim(houv%file)//' from ', &
                & houv%gil%dim(2), ' to  ',mvis
              call map_message(seve%i,rname,mess)
              call gdf_close_image(houv,an_error)
              call gdf_extend_image(houv,mvis,an_error)
              if (an_error) exit
            endif
            houv%blc(2) = iblc(if)
            houv%trc(2) = itrc(if)
            call gdf_write_data (houv,fields(if)%visi,an_error)
            if (an_error) exit
            !
            ! Update header
            houv%gil%nvisi = houv%trc(2)
            houv%gil%dim(2) = houv%trc(2)
            call gdf_update_header(houv,an_error)
            if (an_error) exit
            call gdf_close_image(houv,an_error)
            if (an_error) exit
          endif
        endif
        jf = if
      enddo
      !
      ! De-Allocate work space and Set Blc/Trc again
      do if=1,nf
        if (fields(if)%nvisi.gt.0) then
          deallocate(fields(if)%visi,stat=ier)
          iblc(if) = itrc(if)+1
        endif
      enddo
      deallocate(fields,stat=ier)
    endif
    !
    ! Clean up in case of error
    error = error.or.an_error
    if (error) then
      call map_message(seve%e,rname,'Error reading input file')
      do if=1,jf
        write(houv%file,'(A,I0,A)') 'tmp-',if,'.uvt'
        call gag_filrm(houv%file)
      enddo
      error = .true.
      return
    endif
    !
  enddo
  !
  ! at end, collect all output files :
  !   - sort them by Time-Baseline
  !   - and gather them together
  ! This can be done file by file.
  !
  houv%file = final_file
  houv%gil%nvisi = 0 
  houv%blc(2) = 1
  write(mess,'(A,I0,A)') 'Creating '//trim(houv%file)//' with initial size ',houv%gil%dim(2)
  call map_message(seve%i,rname,mess)
  call gdf_create_image(houv,error)
  if (error) return
  !
  houv%gil%nvisi = 0 
  houv%blc(2) = 1
  !
  jf = 0
  do if=1,nf    
    write(hiuv%file,'(A,I0,A)') 'tmp-',if,'.uvt'
    hiuv%blc = 0
    hiuv%trc = 0
    ndates = 0
    !
    ! No blocking factor here (we assume a field is small enough)
    call gdf_read_header(hiuv,an_error)
    if (an_error) exit 
    !
    allocate(avisi(hiuv%gil%dim(1),hiuv%gil%dim(2)),stat=ier)
    call gdf_read_data(hiuv,avisi,error)
    if (an_error) then
      write(mess,'(A,I0,1X,A)') 'Error reading field ',if,trim(hiuv%file)
      call map_message(seve%e,rname,mess)
      error = .true.
      exit ! Abort 
    endif
    !
    ! Sort it by BASELINE or TIME
    if (ctype.ne.'FIELDS') then
      !
      ! Check the order
      nvisi = hiuv%gil%nvisi ! Current number of visibilities
      allocate (tb(nvisi),ddates(mdates),stat=ier)
      if (ier.ne.0) then
        call map_message(seve%e,rname,'TB Memory allocation error')
        an_error = .true.
        exit
      endif
      !
      ! Count the dates first
      do iv=1,nvisi
        rti = dble(avisi(4,iv))+dble(avisi(5,iv))/86400.0d0
        if (rti.ge.0) then
          ti = int(rti)
        else
          ti = int(rti)-1
        endif
        !
        jt = 0
        do j=1,ndates
          if (ti.eq.ddates(j)) then
            jt = j
            exit
          endif
        enddo
        if (jt.eq.0) then
          if (ndates.gt.mdates) then
            call resize_dble_array(ddates,mdates,2*mdates)
            mdates = 2*mdates
          endif
          ndates = ndates+1
          ddates(ndates) = ti
          jt = ndates
        endif
        ! Compress the Dates by sequence to get times in Days 
        tb(iv) = dble(avisi(4,iv)-ddates(jt)+jt) + dble(avisi(5,iv))/86400.d0
      enddo
      !
      select case(ctype)
      ! tb(iv) is in Seconds
      case ('BASE')
        !
        maxdat = maxval(ddates(1:ndates))
        mindat = minval(ddates(1:ndates))
        spadat = (maxdat-mindat+1)
        !! Print *,'Date range ',mindat,maxdat,spadat
        !
        do iv=1,nvisi
          !
          ! Convert TB into Days, positive. The rescale to [0,1] interval
          tb(iv) = (tb(iv)-1)/(ndates+1)  ! After date compression
          if (tb(iv).lt.0 .or. tb(iv).gt.1) then
            Print *,'Programming error ',iv,tb(iv)
          endif
          ! Get the Baseline Number
          basenum = uvshort_basenum(avisi(6,iv),avisi(7,iv)) 
          ! Use the Baseline Number as major driver
          ! Times enter only in the decimal field
          ! We get enough precision here...
          ! 5 digits for the baseline numbers 
          ! 7 digits for a reasonable number of observing dates
          tb(iv) = basenum + tb(iv) 
        enddo
      case ('TIME')
        !
        do iv=1,nvisi
          ! Get the Baseline Number
          basenum = uvshort_basenum(avisi(6,iv),avisi(7,iv)) 
          ! Use the time as major driver
          ! We get enough precision here...
          ! 7 digits for a reasonable number of observing times in seconds
          ! 5 digits for the baseline numbers 
          tb(iv) = tb(iv)*86400.d0 + dble(basenum)/(256*256) 
        enddo
      end select
      !
      ! Verify if sorted
      sorted = .true.
      vmax = tb(1)
      do iv = 1,nvisi
        if (tb(iv).lt.vmax) then
          sorted = .false.
          exit
        endif
        vmax = tb(iv)
      enddo
      !
      ! Sort it if needed
      if (.not.sorted) then
        allocate(indx(nvisi),bvisi(hiuv%gil%dim(1),nvisi),stat=ier)
        if (ier.ne.0) then
          call map_message(seve%e,rname,'Sort Memory allocation error')
          an_error = .true.
          exit 
        endif
        do iv = 1,nvisi
          indx(iv) = iv
        enddo
        call gr8_trie(tb,indx,nvisi,an_error)
        if (an_error) then
          call map_message(seve%e,rname,'Sorting error')
          exit
        endif
        do iv=1,nvisi
          kv = indx(iv)
          bvisi(:,iv) = avisi(:,kv)
        enddo
        hiuv%r2d => bvisi
        !
        deallocate(indx)
      else
        hiuv%r2d => avisi
      endif
    else
      hiuv%r2d => avisi
    endif
    !
    ! Write at appropriate place
    houv%blc(2) = houv%gil%nvisi+1
    houv%trc(2) = houv%blc(2)+hiuv%gil%nvisi-1
    mvis = houv%trc(2)
    !
    if (mvis.gt.houv%gil%dim(2)) then
      write(mess,'(A,I9,A,I9)') 'Extending '//trim(houv%file)//' from ',houv%gil%dim(2), ' to  ',mvis
      call map_message(seve%i,rname,mess)
      call gdf_close_image(houv,an_error)
      call gdf_extend_image(houv,mvis,an_error)
    else
      write(mess,'(A,I9)') 'Filling '//trim(houv%file)//' up to  ',mvis
      call map_message(seve%i,rname,mess)        
    endif
    houv%gil%nvisi = mvis
    call gdf_write_data (houv,hiuv%r2d,an_error)
    !
    deallocate(avisi,tb,ddates,stat=ier)
    if (allocated(bvisi)) deallocate(bvisi,stat=ier)
    !
    jf = jf+1
  enddo
  !
  ! Remove temporary files in all cases
  do if=1,nf
    write(hiuv%file,'(A,I0,A)') 'tmp-',if,'.uvt'
    call gag_filrm(hiuv%file)
  enddo
  !
  ! Clean up in case of error
  error = error.or.an_error
  if (error) then
    call gdf_close_image(houv,an_error)
    call map_message(seve%e,rname,'Error collecting output file')
    call gag_filrm(houv%file)
    error = .true.
    return
  endif      
  !
  ! Finalize the image
  houv%gil%nvisi = houv%trc(2)
  houv%gil%dim(2) = houv%trc(2)
  call gdf_update_header(houv,error)
  call gdf_close_image(houv,error)
  if (error) then
    call map_message(seve%e,rname,'Error finishing output file')
    call gag_filrm(houv%file)
    error = .true.
    return
  endif      
  !
  ! In total, we will have read 2x the size of the initial
  ! input file, and written also 2x its initial size
end subroutine uvsort_mosaic_disk
!
subroutine uvsort_mosaic_mem(hiuv,houv,ctype,ioff,joff,itel,error)
  use gkernel_types
  use imager_interfaces, except_this => uvsort_mosaic_mem
  use gkernel_interfaces
  use field_type
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !* 
  ! IMAGER -- 
  !   Support for UV_SORT 
  !
  !   Sort a Mosaic UV table  
  !   Each field must be independently sorted by Time-Baseline. 
  !   The method splits the Input UV data per Field, creating a virtual
  !   single-field UV data for each Field. These per-Field UV data are
  !   sorted by Time-Baseline, and the results is put back in place at
  !   the same time. 3 copies are required, unless HOUV points to HIUV
  !
  !   Data sets are assumed to be in the %R2D pointers
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: hiuv       !! Input UV header
  type(gildas), intent(inout) :: houv       !! Output UV header
  character(len=*), intent(in) :: ctype     !! Type of sorting
  integer, intent(in) :: ioff               !! Offset column pointer
  integer, intent(in) :: joff               !! Offset column pointer
  integer, intent(in) :: itel               !! Telescope column pointer
  logical, intent(out) :: error             !! Error flag
  !
  ! Constants
  character(len=*), parameter :: rname='UV_SORT'
  !
  ! Local ---
  real :: xoff,yoff,rtel
  real, allocatable :: xfield(:), yfield(:), tfield(:) ! Field coordinates
  integer, allocatable :: iblc(:), itrc(:)  ! File pointers 
  integer, allocatable :: ifield(:)         ! Field pointer for each visibility
  integer, allocatable :: vfield(:)         ! Number of visibilities per field
  type (field), allocatable, target :: fields(:)    ! Fields data
  integer :: vsize ! Visibility size
  integer :: nvisi 
  integer(kind=index_length) :: kv
  integer :: if, iv, jv, kf, mf, nf, of
  integer :: ier
  integer :: fvisi, lvisi
  !
  integer :: basenum
  real(kind=8) :: ti,rti,vmax
  real(kind=8), allocatable :: ddates(:), tb(:)
  real(kind=4), pointer :: avisi(:,:), bvisi(:,:)
  integer(kind=4), allocatable :: indx(:)
  integer:: j,jt,mdates,ndates
  real(kind=8) :: maxdat, mindat, spadat
  logical :: sorted, an_error
  !
  character(len=120) :: mess
  !
  ! Code ----
  mdates = 10 ! A good starting number of dates...
  !
  if (.not.associated(hiuv%r2d)) then
    call map_message(seve%e,rname,'Input UV data is not associated')
    error = .true.
  endif
  if (.not.associated(houv%r2d)) then
    call map_message(seve%e,rname,'Output UV data is not associated')
    error = .true.
  endif
  if (size(hiuv%r2d).ne.size(houv%r2d)) then
    call map_message(seve%e,rname,'Input and Output UV data  do not match')
    error = .true.
  endif
  if (error) return
  !
  vsize = hiuv%gil%dim(1)
  nvisi = hiuv%gil%nvisi
  allocate(ifield(nvisi),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  of = 0      ! Arrays are not allocated
  nf = 0      ! We start with an empty number of Fields
  ndates = 0  ! Initialize
  rtel = 0    ! No telescope
  !
  do iv=1,nvisi
    kf = 0
    xoff = hiuv%r2d(ioff,iv)
    yoff = hiuv%r2d(joff,iv)
    if (itel.ne.0) rtel = hiuv%r2d(itel,iv)
    do if=1,nf
      if (xfield(if).eq.xoff .and. yfield(if).eq.yoff &
        & .and. tfield(if).eq.rtel) then
        kf = if
        exit
      endif
    enddo
    !
    ! Prepare buffers to handle the Fields characteristics
    if (kf.eq.0) then
      nf = nf+1
      ! !Print *,'Visi IV ',iv,' xoff yoff ',xoff,yoff,' NF ',nf,' OF ',of 
      if (nf.gt.of) then
        if (of.eq.0) then
          mf = 10   ! Start with 10 fields
        else
          mf = 2*of ! Double the field numbers
        endif
        call resize_real_array(xfield,of,mf)
        call resize_real_array(yfield,of,mf)
        call resize_real_array(tfield,of,mf)
        call resize_inte_array(itrc,of,mf)
        call resize_inte_array(iblc,of,mf)
        call resize_inte_array(vfield,of,mf)
        of = mf
      endif
      xfield(nf) = xoff
      yfield(nf) = yoff
      tfield(nf) = rtel
      iblc(nf) = 1
      itrc(nf) = 1
      vfield(nf) = 1
      kf = nf
    else
      ! Increment the visibilities here...
      itrc(kf) = itrc(kf)+1
      vfield(kf) = vfield(kf)+1
    endif
    !
    ! Remember the field pointer
    ifield(iv) = kf
    !
  enddo
  write(mess,'(A,I0,A)') 'Found ',nf,' fields'
  call map_message(seve%i,rname,mess)
  !
  ! Allocate work space per field to the field size computed before
  allocate(fields(nf),stat=ier)
  do if=1,nf
    nvisi = vfield(if)
    if (nvisi.gt.0) then
      allocate(fields(if)%visi(vsize,nvisi),stat=ier)
      if (ier.ne.0) then
        call map_message(seve%e,rname,'Field Memory allocation error')
        error = .true.
        exit
      endif
    endif
    fields(if)%mvisi = nvisi
    fields(if)%nvisi = 0
  enddo
  if (error) return 
  !
  ! Second pass, split into the workspaces
  nvisi = hiuv%gil%nvisi
  do iv=1,nvisi
    if = ifield(iv)
    !
    if (fields(if)%nvisi.eq.fields(if)%mvisi) then
      write(mess,'(A,I0,A,I0,A,I0)') 'Fields ',if,' visibility overrun ',vfield(if),' at visi ',iv
      call map_message(seve%e,rname,mess)
      an_error = .true.
      exit
    endif
    fields(if)%nvisi = fields(if)%nvisi +1
    jv = fields(if)%nvisi
    !! write(iunit,*) 'Field ',if,' In visi ',iv,' outvisi ',jv
    fields(if)%visi(:,jv) = hiuv%r2d(:,iv)
  enddo
  !
  ! Now we have a WorkSpace per field
  write(mess,'(A,I0,A)') 'Allocating UV with initial size ',houv%gil%dim(2)
  call map_message(seve%i,rname,mess)
  houv%gil%nvisi = 0 
  houv%blc(2) = 1
  !
  an_error = .false.
  !
  fvisi = 1                   ! Pointer to first Visi
  do if=1,nf    
    nvisi = fields(if)%nvisi  ! Current number of visibilities
    lvisi = fvisi+nvisi-1     ! Pointer to last Visi
    avisi => fields(if)%visi
    bvisi => houv%r2d(:,fvisi:lvisi)
    !
    ! Sort it by BASELINE or TIME
    if (ctype.ne.'FIELDS') then
      !
      ! Check the order
      allocate (tb(nvisi),ddates(mdates),stat=ier)
      if (ier.ne.0) then
        call map_message(seve%e,rname,'TB Memory allocation error')
        an_error = .true.
        exit
      endif
      !
      ! Count the dates first
      do iv=1,nvisi
        rti = dble(avisi(4,iv))+dble(avisi(5,iv))/86400.0d0
        if (rti.ge.0) then
          ti = int(rti)
        else
          ti = int(rti)-1
        endif
        !
        jt = 0
        do j=1,ndates
          if (ti.eq.ddates(j)) then
            jt = j
            exit
          endif
        enddo
        if (jt.eq.0) then
          if (ndates.gt.mdates) then
            call resize_dble_array(ddates,mdates,2*mdates)
            mdates = 2*mdates
          endif
          ndates = ndates+1
          ddates(ndates) = ti
          jt = ndates
        endif
        ! Compress the Dates by sequence to get times in Days 
        tb(iv) = dble(avisi(4,iv)-ddates(jt)+jt) + dble(avisi(5,iv))/86400.d0
      enddo
      !
      select case(ctype)
      ! tb(iv) is in Seconds
      case ('BASE')
        !
        maxdat = maxval(ddates(1:ndates))
        mindat = minval(ddates(1:ndates))
        spadat = (maxdat-mindat+1)
        !! Print *,'Date range ',mindat,maxdat,spadat
        !
        do iv=1,nvisi
          !
          ! Convert TB into Days, positive. The rescale to [0,1] interval
          tb(iv) = (tb(iv)-1)/(ndates+1)  ! After date compression
          if (tb(iv).lt.0 .or. tb(iv).gt.1) then
            Print *,'Programming error ',iv,tb(iv)
          endif
          ! Get the Baseline Number
          basenum = uvshort_basenum(avisi(6,iv),avisi(7,iv)) 
          ! Use the Baseline Number as major driver
          ! Times enter only in the decimal field
          ! We get enough precision here...
          ! 5 digits for the baseline numbers 
          ! 7 digits for a reasonable number of observing dates
          tb(iv) = basenum + tb(iv) 
        enddo
      case ('TIME')
        !
        do iv=1,nvisi
          ! Get the Baseline Number
          basenum = uvshort_basenum(avisi(6,iv),avisi(7,iv)) 
          ! Use the time as major driver
          ! We get enough precision here...
          ! 7 digits for a reasonable number of observing times in seconds
          ! 5 digits for the baseline numbers 
          tb(iv) = tb(iv)*86400.d0 + dble(basenum)/(256*256) 
        enddo
      end select
      !
      ! Verify if sorted
      sorted = .true.
      vmax = tb(1)
      do iv = 1,nvisi
        if (tb(iv).lt.vmax) then
          sorted = .false.
          exit
        endif
        vmax = tb(iv)
      enddo
      !
      ! Sort it if needed
      if (.not.sorted) then
        allocate(indx(nvisi),stat=ier)
        if (ier.ne.0) then
          call map_message(seve%e,rname,'Sort Memory allocation error')
          an_error = .true.
          exit 
        endif
        do iv = 1,nvisi
          indx(iv) = iv
        enddo
        call gr8_trie(tb,indx,nvisi,an_error)
        if (an_error) then
          call map_message(seve%e,rname,'Sorting error')
          deallocate(indx)
          exit
        endif
        do iv=1,nvisi
          kv = indx(iv)
          bvisi(:,iv) = avisi(:,kv)
        enddo
        !
        deallocate(indx)
      else
        bvisi = avisi
      endif
    else
      bvisi = avisi
    endif
    fvisi = lvisi+1 ! Prepare next field
    nullify(avisi)
    if (allocated(tb)) deallocate(tb,ddates,stat=ier)
  enddo
  !
  ! Clean up in case of error
  error = error.or.an_error
  !
  ! Finalize the image
  houv%gil%nvisi = fvisi-1
  houv%gil%dim(2) = fvisi-1
  houv%gil%ntrail = hiuv%gil%ntrail
  ! !Print *,'Returning with ', houv%gil%nvisi,' Visibilities of size ',houv%gil%dim(1), houv%gil%ntrail
end subroutine uvsort_mosaic_mem

subroutine uvsort_single_disk(hiuv,houv,ctype,error)
  use gkernel_types
  use field_type
  use imager_interfaces, except_this => uvsort_single_disk
  use gkernel_interfaces
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support for UV_SORT /FILE  
  ! Sort a Single Field UV table on disk
  !
  ! A more intelligent way of sorting that strictly follows
  ! the algorithm for the Mosaics.
  !
  ! 1) Define the number of input Blocks  
  ! 2) Define the Time and/or Base range of the input file
  !     and relative percentiles of the distribution...  
  ! 3) Partition the Time and/or Base range in a number
  !   of output files equal to the number of input Blocks  
  ! 4) Collect the temporary output files
  !!
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: hiuv       !! Input UV header
  type(gildas), intent(inout) :: houv       !! Output UV header
  character(len=*), intent(in) :: ctype     !! Type of sorting
  logical, intent(out) :: error             !! Error flag
  !
  ! Constants
  character(len=*), parameter :: rname='UV_SORT'
  !
  ! Local ---
  integer, allocatable :: iblc(:), itrc(:)  ! File pointers 
  integer :: vsize ! Visibility size
  integer :: nvisi, mvisi
  integer :: basenum
  integer(kind=index_length) :: mvis, kv
  integer :: if, iv, jv, ib, nf, of, jf, ik
  integer :: ier, nblock, mblock
  integer :: codes(4)
  type (field), allocatable :: fields(:)    ! Fields data
  !
  real(kind=8) :: ti,rti,vmax
  real(kind=8), allocatable :: ddates(:), valt(:)
  real(kind=8), allocatable, target :: tb(:)
  real(kind=8), pointer :: bt(:)
  real(kind=4), allocatable, target :: avisi(:,:), bvisi(:,:), din(:,:)
  integer(kind=4), allocatable :: indx(:), ifield(:), count(:)
  integer:: j,jt,mdates,ndates
  real(kind=8) :: maxdat, mindat, spadat
  logical :: sorted, an_error, no_error
  logical, allocatable :: occupied(:)
  integer :: maxant
  !
  character(len=120) :: mess
  character(len=filename_length) :: final_file
  !
  ! Code ----
  nblock = space_nitems('SPACE_IMAGER',hiuv,1)  ! Space Imager is large enough
  mdates = 10 ! A good starting number of dates...
  !
  final_file = houv%file ! Save 
  !
  !print *,'Input ',trim(hiuv%file)
  !print *,'Output ',trim(houv%file)
  !
  vsize = hiuv%gil%dim(1)
  nf = 0
  of = 0
  !
  ! We do not know in advance how to partition the file.
  ! How many baselines ? How many antennas ? How many time steps ?
  !
  ! So make a first pass to figure out this properly
  !
  ! Read the input file by block
  mvisi = nblock                                ! Block size
  mblock = (hiuv%gil%dim(2)+nblock-1)/nblock    ! Number of Blocks
  nvisi = hiuv%gil%nvisi
  ! 
  nf = mblock  ! Number of "fields" for analogy with the Mosaic case
  !
  allocate(hiuv%r2d(hiuv%gil%dim(1),mvisi),tb(nvisi),din(4,nvisi),& 
    & ddates(mdates),valt(nf),count(nf),ifield(mvisi),iblc(nf),itrc(nf),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Input Memory allocation error')
    error = .true.
    return
  endif
  codes(1:4) = [code_uvt_date, code_uvt_time, code_uvt_anti, code_uvt_antj]
  call gdf_read_uvonly_codes(hiuv, din, codes, 4, error)
  if (error) return
  !
  ndates = 0 ! Initialize
  !
  ! Initialize
  iblc = 0
  itrc = 0
  !
  select case(ctype)
  case ('TIME') 
    ! Count the dates first
    do iv=1,nvisi
      rti = dble(din(1,iv))+dble(din(2,iv))/86400.0d0
      if (rti.ge.0) then
        ti = int(rti)
      else
        ti = int(rti)-1
      endif
      !
      jt = 0
      do j=1,ndates
        if (ti.eq.ddates(j)) then
          jt = j
          exit
        endif
      enddo
      if (jt.eq.0) then
        if (ndates.gt.mdates) then
          call resize_dble_array(ddates,mdates,2*mdates)
          mdates = 2*mdates
        endif
        ndates = ndates+1
        ddates(ndates) = ti
        jt = ndates
      endif
      ! Compress the Dates by sequence to get times in Days 
      tb(iv) = dble(din(1,iv)-ddates(jt)+jt) + dble(din(2,iv))/86400.d0
    enddo
    !
    ! OK, here we have the distribution of TB(iv) in "Consecutive days"
    mindat = minval(tb)-1.d0/86400.d0
    maxdat = maxval(tb)+1.d0/86400.d0
    !
    ! It is reasonably evenly spaced, so equally divide the output.
    ! Set the thresholds
    do if=1,nf
      valt(if) = if*(maxdat-mindat)/nf + mindat
    enddo
    !!Print *,'TIME thresholds ',valt
  case ('BASE')
    maxant = 0
    do iv=1,nvisi
      ! Get the Baseline Number
      basenum = uvshort_basenum(din(3,iv),din(4,iv)) 
      ! Use the Baseline Number as major driver
      ! Times enter only in the decimal field
      ! We get enough precision here...
      ! 5 digits for the baseline numbers 
      ! 6 digits for a reasonable number of observing dates
      tb(iv) = dble(basenum) 
      maxant = max(maxant,nint(max(din(3,iv),din(4,iv))))
    enddo
    !
    ! Now we have MAXANT, the largest number of antennas.
    ! But the baselines are not well spaced because they go
    ! as MAXANT*(MAXANT-1)/2
    !
    ! Set the thresholds
    valt(nf) = maxant+1
    do if=nf-1,1,-1
      valt(if) = sqrt(valt(if+1))
    enddo
    valt = nint(256.0*valt)
    !Print *,'BASE thresholds ',valt
  case default
    call map_message(seve%e,rname,'Cannot handle '//ctype)
    error = .true.
    return
  end select
  !
  ! Verify if sorted
  sorted = .true.
  vmax = tb(1)
  do iv = 1,nvisi
    if (tb(iv).lt.vmax) then
      sorted = .false.
      !!Print *,'Unordered visibility ',iv,tb(iv),vmax
      exit
    endif
    vmax = tb(iv)
  enddo
  if (sorted) then
    call map_message(seve%e,rname,'Input file is already sorted')
    call gdf_close_image(hiuv,error) ! Close input file
    error = .true.
    return
  endif
  !
  ! Occupancy indicator
  allocate(occupied(nf))
  occupied = .false.
  !
  ! Now loop over the blocks
  !
  ik = 0
  do ib=1,hiuv%gil%dim(2),mvisi
    ik = ik+1 ! Block Kounter
    !
    ! Read the data
    write(mess,*) ib,' / ',hiuv%gil%dim(2),mvisi
    call map_message(seve%i,rname,mess)
    hiuv%blc(2) = ib
    hiuv%trc(2) = min(hiuv%gil%dim(2),ib-1+mvisi)
    nvisi = hiuv%trc(2)-hiuv%blc(2)+1
    call gdf_read_data(hiuv,hiuv%r2d,an_error)
    if (an_error) exit 
    !
    ! The sorting key is already known: point to the right place
    !!Print *,'BT range ',hiuv%blc(2),hiuv%trc(2)
    bt => tb(hiuv%blc(2):hiuv%trc(2))
    !
    ! Convert it to a file number index, and count size of output 
    count = 0
    do iv=1,nvisi
      do if = 1,nf ! == mblock
        if (bt(iv).le.valt(if)) then
          ifield(iv) = if
          count(if) = count(if)+1
          exit
        endif
      enddo
    enddo
    !
    ! Allocate work space
    allocate(fields(nf),stat=ier)
    do if=1,nf
      nvisi = count(if)
      if (nvisi.gt.0) then
        allocate(fields(if)%visi(vsize,nvisi),stat=ier)
        if (ier.ne.0) then
          call map_message(seve%e,rname,'Field Memory allocation error')
          an_error = .true.
          exit
        endif
        ! Increment the BLC / TRC
        iblc(if) = itrc(if)+1
        itrc(if) = itrc(if)+nvisi
      endif
      fields(if)%mvisi = nvisi
      fields(if)%nvisi = 0
    enddo
    !
    if (an_error) return 
    !
    ! Second pass, split into the workspaces
    nvisi = hiuv%trc(2)-hiuv%blc(2)+1
    do iv=1,nvisi
      if = ifield(iv)
      !
      fields(if)%nvisi = fields(if)%nvisi +1
      jv = fields(if)%nvisi
      !! write(iunit,*) 'Field ',if,' In visi ',iv,' outvisi ',jv
      fields(if)%visi(:,jv) = hiuv%r2d(:,iv)
    enddo
    !
    ! Write the workspaces to different files
    jf = 0
    do if=1,nf
      if (fields(if)%nvisi.gt.0) then
        occupied(if) = .true.
        write(houv%file,'(A,I0,A)') 'tmp-',if,'.uvt'
        !
        if (iblc(if).eq.1) then
          write(mess,'(A,I0,A)') 'Creating '//trim(houv%file)//' with ',fields(if)%nvisi,' visi...'
          call map_message(seve%i,rname,mess)
          ! Field must be created
          houv%blc = 0
          houv%trc = 0
          houv%gil%nvisi = fields(if)%nvisi
          houv%gil%dim(2) = houv%gil%nvisi
          call gdf_write_image(houv,fields(if)%visi,an_error)
          if (an_error) exit
        else
          ! Field already existed
          call gdf_read_header(houv,an_error)
          if (an_error) exit
          mvis = houv%gil%nvisi + fields(if)%nvisi
          !
          if (mvis.gt.houv%gil%dim(2)) then
            write(mess,'(A,I0,A,I0,A)') 'Extending '//trim(houv%file)//' from ', &
              & houv%gil%dim(2), ' to  ',mvis
            call map_message(seve%i,rname,mess)
            call gdf_close_image(houv,an_error)
            call gdf_extend_image(houv,mvis,an_error)
            if (an_error) exit
          endif
          houv%blc(2) = iblc(if)
          houv%trc(2) = itrc(if)
          call gdf_write_data (houv,fields(if)%visi,an_error)
          if (an_error) exit
          !
          ! Update header
          houv%gil%nvisi = houv%trc(2)
          houv%gil%dim(2) = houv%trc(2)
          call gdf_update_header(houv,an_error)
          if (an_error) exit
          call gdf_close_image(houv,an_error)
          if (an_error) exit
        endif
      endif
      jf = if
    enddo
    !
    ! De-Allocate work space and Set Blc/Trc again
    do if=1,nf
      if (fields(if)%nvisi.gt.0) then
        deallocate(fields(if)%visi,stat=ier)
      endif
    enddo
    deallocate(fields,stat=ier)
    !
    ! Clean up in case of error
    error = error.or.an_error
    if (error) exit
    !
  enddo
  !
  ! Clean up Input File and sorting arrays
  call gdf_close_image(hiuv,no_error)
  deallocate(tb,ddates)
  !
  if (error) then
    call map_message(seve%e,rname,'Error reading input file')
    do if=1,nf
      if (occupied(if)) then
        write(houv%file,'(A,I0,A)') 'tmp-',if,'.uvt'
        call gag_filrm(hiuv%file)
      endif
    enddo
    return
  endif
  !
  ! That part is strictly identical to the Mosaic case
  !
  ! at end, collect all output files :
  !   - sort them by Time or Baseline
  !   - and gather them together
  ! This can be done file by file.
  !
  houv%file = final_file
  houv%gil%nvisi = 0 
  houv%blc(2) = 1
  write(mess,'(A,I0,A)') 'Creating '//trim(houv%file)//' with initial size ',houv%gil%dim(2)
  call map_message(seve%i,rname,mess)
  call gdf_create_image(houv,error)
  if (error) return
  !
  houv%gil%nvisi = 0 
  houv%blc(2) = 1
  !
  jf = 0
  do if=1,nf    
    !
    ! File may be empty
    if (.not.occupied(if)) cycle
    write(hiuv%file,'(A,I0,A)') 'tmp-',if,'.uvt'
    !
    hiuv%blc = 0
    hiuv%trc = 0
    ndates = 0
    !
    ! No blocking factor here (we assume a region is small enough)
    call gdf_read_header(hiuv,an_error)
    if (an_error) exit 
    !
    allocate(avisi(hiuv%gil%dim(1),hiuv%gil%dim(2)),stat=ier)
    call gdf_read_data(hiuv,avisi,error)
    if (an_error) then
      write(mess,'(A,I0,1X,A)') 'Error reading field ',if,trim(hiuv%file)
      call map_message(seve%e,rname,mess)
      exit ! Abort 
    endif
    !
    ! Sort it by BASELINE or TIME
    if (ctype.ne.'FIELDS') then
      !
      ! Check the order
      nvisi = hiuv%gil%nvisi ! Current number of visibilities
      allocate (tb(nvisi),ddates(mdates),stat=ier)
      if (ier.ne.0) then
        call map_message(seve%e,rname,'TB Memory allocation error')
        an_error = .true.
        exit
      endif
      !
      ! Count the dates first
      do iv=1,nvisi
        rti = dble(avisi(4,iv))+dble(avisi(5,iv))/86400.0d0
        if (rti.ge.0) then
          ti = int(rti)
        else
          ti = int(rti)-1
        endif
        !
        jt = 0
        do j=1,ndates
          if (ti.eq.ddates(j)) then
            jt = j
            exit
          endif
        enddo
        if (jt.eq.0) then
          if (ndates.gt.mdates) then
            call resize_dble_array(ddates,mdates,2*mdates)
            mdates = 2*mdates
          endif
          ndates = ndates+1
          ddates(ndates) = ti
          jt = ndates
        endif
        ! Compress the Dates by sequence to get times in Days 
        tb(iv) = dble(avisi(4,iv)-ddates(jt)+jt) + dble(avisi(5,iv))/86400.d0
      enddo
      !
      select case(ctype)
      ! tb(iv) is in Seconds
      case ('BASE')
        !
        maxdat = maxval(ddates(1:ndates))
        mindat = minval(ddates(1:ndates))
        spadat = (maxdat-mindat+1)
        !! Print *,'Date range ',mindat,maxdat,spadat
        !
        do iv=1,nvisi
          !
          ! Convert TB into Days, positive. The rescale to [0,1] interval
          tb(iv) = (tb(iv)-1)/(ndates+1)  ! After date compression
          if (tb(iv).lt.0 .or. tb(iv).gt.1) then
            Print *,'Programming error ',iv,tb(iv)
          endif
          ! Get the Baseline Number
          basenum = uvshort_basenum(avisi(6,iv),avisi(7,iv)) 
          ! Use the Baseline Number as major driver
          ! Times enter only in the decimal field
          ! We get enough precision here...
          ! 5 digits for the baseline numbers 
          ! 6 digits for a reasonable number of observing dates
          tb(iv) = dble(basenum) + tb(iv) 
        enddo
      case ('TIME')
        !
        do iv=1,nvisi
          ! Get the Baseline Number
          basenum = uvshort_basenum(avisi(6,iv),avisi(7,iv)) 
          ! Use the time as major driver
          ! We get enough precision here...
          ! 6 digits for a reasonable number of observing times in seconds
          ! 5 digits for the baseline numbers 
          tb(iv) = tb(iv)*86400.d0 + dble(basenum)/(256*256)
        enddo
      end select
      !
      ! Verify if sorted
      sorted = .true.
      vmax = tb(1)
      do iv = 1,nvisi
        if (tb(iv).lt.vmax) then
          sorted = .false.
          exit
        endif
        vmax = tb(iv)
      enddo
      !
      ! Sort it if needed
      if (.not.sorted) then
        allocate(indx(nvisi),bvisi(hiuv%gil%dim(1),nvisi),stat=ier)
        if (ier.ne.0) then
          call map_message(seve%e,rname,'Sort Memory allocation error')
          an_error = .true.
          exit 
        endif
        do iv = 1,nvisi
          indx(iv) = iv
        enddo
        call gr8_trie(tb,indx,nvisi,an_error)
        if (an_error) then
          call map_message(seve%e,rname,'Sorting error')
          exit
        endif
        do iv=1,nvisi
          kv = indx(iv)
          bvisi(:,iv) = avisi(:,kv)
        enddo
        hiuv%r2d => bvisi
        !
        deallocate(indx)
      else
        Print *,'Data is already sorted ',if
        hiuv%r2d => avisi
      endif
    else
      hiuv%r2d => avisi
    endif
    !
    ! Write at appropriate place
    houv%blc(2) = houv%gil%nvisi+1
    houv%trc(2) = houv%blc(2)+hiuv%gil%nvisi-1
    mvis = houv%trc(2)
    !
    if (mvis.gt.houv%gil%dim(2)) then
      write(mess,'(A,I9,A,I9)') 'Extending '//trim(houv%file)//' from ',houv%gil%dim(2), ' to  ',mvis
      call map_message(seve%i,rname,mess)
      call gdf_close_image(houv,an_error)
      call gdf_extend_image(houv,mvis,an_error)
    else
      write(mess,'(A,I9)') 'Filling '//trim(houv%file)//' up to  ',mvis
      call map_message(seve%i,rname,mess)        
    endif
    houv%gil%nvisi = mvis
    call gdf_write_data (houv,hiuv%r2d,an_error)
    !
    deallocate(avisi,tb,ddates,stat=ier)
    if (allocated(bvisi)) deallocate(bvisi,stat=ier)
    !
    call gdf_close_image(hiuv,no_error)
    !
    jf = jf+1
  enddo
  !
  ! Remove temporary files in all cases
  do if=1,nf
    if (occupied(if)) then
      write(hiuv%file,'(A,I0,A)') 'tmp-',if,'.uvt'
      call gag_filrm(hiuv%file)
    endif
  enddo
  !
  ! Clean up in case of error
  error = error.or.an_error
  if (error) then
    call map_message(seve%e,rname,'Error collecting output file')
    call gag_filrm(houv%file)
    error = .true.
    return
  endif      
  !
  ! Finalize the image
  houv%gil%nvisi = houv%trc(2)
  houv%gil%dim(2) = houv%trc(2)
  call gdf_update_header(houv,error)
  call gdf_close_image(houv,error)
  if (error) then
    call map_message(seve%e,rname,'Error finishing output file')
    call gag_filrm(houv%file)
    error = .true.
    return
  endif      
  !
  ! In total, we will have read 2x the size of the initial
  ! input file, plus the key area (< 1x), and written also 2x its initial size
end subroutine uvsort_single_disk
!
integer function uvshort_basenum(iant,jant)
  ! @ private
  real, intent(in) :: iant  !! Starting antenna
  real, intent(in) :: jant  !! Ending antenna
  !! integer, intent(out) :: uvshort_basenum ! Baseline number
  !
  if (iant.lt.jant) then
    uvshort_basenum = 256*iant+jant
  else if (iant.gt.jant) then
    uvshort_basenum = 256*jant+iant
  else
    ! No Baseline code for Short spacings which have Iant = Jant
    uvshort_basenum = 0
  endif
end function uvshort_basenum
!
subroutine uvsort_frequency_file(nami,namo,error)
  use image_def
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Support for command   
  ! UV_SORT FREQUENCY /FILE FileIn FileOut
  !!
  !---------------------------------------------------------------------------------
  character(len=*), intent(inout) :: nami  !! Input file name
  character(len=*), intent(inout) :: namo  !! Output file name
  logical, intent(out) :: error            !! Error flah
  !
  character(len=*), parameter :: rname='UVSORT FREQUENCY'
  ! 
  ! Local ---
  type (gildas) :: hin, hou
  real(kind=4), allocatable :: din(:,:), dou(:,:)
  integer :: nif
  !
  integer :: stoke
  !
  integer :: iv, iloop, nblock, nvisi
  integer, allocatable :: indx(:)
  integer :: ic, kc, ier
  !
  ! Code ----
  error = .false.
  !
  ! Read Header of the UV table
  call gildas_null(hin, type= 'UVT')
  call sic_parsef (nami,hin%file,' ','.uvt')
  call gdf_read_header (hin,error)
  if (error) return
  !
  nif = hin%gil%nchan
  if (hin%gil%nstokes.gt.1) then
    call map_message(seve%e,rname,'UV table has more than 1 Stoke parameter')
    error = .true.
    return
  endif  
  ! Initialize the output one
  call gildas_null(hou, type='UVT')
  call gdf_copy_header (hin, hou, error)
  call sic_parsef (namo,hou%file,'  ','.uvt')
  !
  stoke = 0
  if (hin%gil%nstokes.eq.1) then
    if (associated(hin%gil%stokes)) stoke = hin%gil%stokes(1)
  endif
  !
  allocate(hou%gil%freqs(nif), hou%gil%stokes(nif), indx(nif), stat=ier)
  !
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif  
  !
  ! Sort the frequencies by increasing order
  hou%gil%freqs = hin%gil%freqs
  do ic = 1,nif
    indx(ic) = ic
  enddo
  call gr8_trie(hou%gil%freqs,indx,nif,error)
  hou%gil%stokes = stoke
  hou%gil%nstokes = 1
  hou%gil%nfreq = nif  
  !
  ! Reset the mean frequency in the header...
  hou%gil%freq = sum(hou%gil%freqs)/nif
  ! and in the first axis too
  hou%gil%val(1) = hou%gil%freq
  !
  call gdf_setuv(hou,error)
  !
  ! OK copy the whole stuff...
  call gdf_nitems('SPACE_GILDAS',nblock,hin%gil%dim(1))
  nblock = min(nblock,hin%gil%dim(2))
  !
  allocate (din(hin%gil%dim(1),nblock),dou(hin%gil%dim(1),nblock),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error ')
    error = .true.
    return
  endif
  !
  hin%blc = 0
  hin%trc = 0
  hou%blc = 0
  hou%trc = 0
  call gdf_create_image(hou,error)
  if (error) return
  !
  call map_message(seve%i,rname,'Copying UV data ')
  do iloop = 1,hin%gil%dim(2),nblock
    hin%blc(2) = iloop
    hin%trc(2) = min(iloop+nblock-1,hin%gil%dim(2))
    hou%blc(2) = iloop
    hou%trc(2) = hin%trc(2)
    call gdf_read_data (hin,din,error)
    if (error) return
    !
    nvisi = hin%trc(2)-iloop+1
    do iv=1,nvisi
      dou(1:7,iv) = din(1:7,iv)
      do ic=1,nif
        kc = indx(ic)
        dou(5+3*ic:7+3*ic,iv) = din(5+3*kc:7+3*kc,iv)
      enddo
      if (hou%gil%ntrail.gt.0) then
        dou(8+3*nif:,iv) = din(8+3*nif:,iv)
      endif
    enddo
    call gdf_write_data (hou, dou, error)
    if (error) return
  enddo
  call gdf_close_image(hou,error)
  call gdf_close_image(hin,error)
  !
end subroutine uvsort_frequency_file
!
subroutine uvsort_frequency_mem(huvl,visi,error)
  use image_def
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message
  !-------------------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Support for command   
  !     UV_SORT FREQUENCY in memory. Applies to UV data.
  !
  !   Only works for 1 Stokes parameter
  !!
  !-------------------------------------------------------------------------------
  type(gildas), intent(inout) :: huvl     !! UV Header
  real, intent(inout) :: visi(huvl%gil%dim(1),huvl%gil%dim(2))   !! UV data
  logical, intent(inout) :: error         !! Error flag
  !
  character(len=*), parameter :: rname='UV_SORT'
  !
  integer :: nif, stoke, ier
  integer, allocatable :: indx(:)
  integer :: ic,iv,kc
  logical :: ordered
  real(kind=8) :: freqs
  real, allocatable :: dtmp(:)
  real(kind=8), allocatable :: frequencies(:)
  !
  ! Code ----
  error = .false.
  if (huvl%gil%nfreq.le.1) then
    call map_message(seve%i,rname,'UV table is already ordered by Frequency',3)
    return
  endif  
  if (huvl%gil%nstokes.gt.1) then
    call map_message(seve%e,rname,'UV table has more than 1 Stoke parameter',1)
    error = .true.
    return
  endif  
  nif = huvl%gil%nchan
  !
  freqs = huvl%gil%freqs(1)
  ordered = .true.
  do ic=2,nif
    if (huvl%gil%freqs(ic).gt.freqs) then
      freqs = huvl%gil%freqs(ic)
    else
      ordered = .false.
      exit
    endif
  enddo
  if (ordered) then
    call map_message(seve%w,rname,'UV table is already ordered by Frequency',3)
    return
  endif  
  !
  stoke = 0
  if (huvl%gil%nstokes.eq.1) then
    if (associated(huvl%gil%stokes)) stoke = huvl%gil%stokes(1)
  endif
  !
  allocate(indx(nif), dtmp(huvl%gil%dim(1)), frequencies(nif), stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif  
  !
  ! Sort the frequencies by increasing order
  do ic = 1,nif
    indx(ic) = ic
  enddo
  call gr8_trie(huvl%gil%freqs,indx,nif,error)
  huvl%gil%nstokes = 1
  huvl%gil%nfreq = nif  
  !
  ! Reset the mean frequency in the header...
  huvl%gil%freq = sum(huvl%gil%freqs)/nif
  ! and in the first axis too
  huvl%gil%val(1) = huvl%gil%freq
  !
  ! Verify Header
  call gdf_setuv(huvl,error)
  !
  ! Sort the data visibility per visibility
  do iv=1,huvl%gil%nvisi
    dtmp(:) = visi(:,iv)
    do ic=1,nif
      kc = indx(ic)
      visi(5+3*ic:7+3*ic,iv) = dtmp(5+3*kc:7+3*kc)
    enddo
  enddo
  !
end subroutine uvsort_frequency_mem


