!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module uv_sort_codes
  integer(kind=4), parameter :: code_sort_bt=1     ! BASE then TIME
  integer(kind=4), parameter :: code_sort_tb=2     ! TIME then BASE
  integer(kind=4), parameter :: code_sort_ubtf=3   ! UNIQUE-BASE then TIME then FREQ
  integer(kind=4), parameter :: code_sort_ft=4     ! FREQ then TIME
  integer(kind=4), parameter :: code_sort_field=5  ! FIELD
  !
  integer(kind=4), parameter :: ncode_sort=5
  character(len=8), parameter :: sort_names(ncode_sort) = &
    (/ 'BASE    ','TIME    ','UNIQUE  ','FREQTIME','FIELD   ' /)
end module uv_sort_codes
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module uv_sort
  use gbl_message
  use gmath_quicksort_types
  !
  public :: uv_sort_comm
  public :: uv_tri,uv_findtb
  private
  !
  ! Type for sorting first by unique baseline, then by time and frequency
  type, extends(gi4_quicksort_t) :: uv_sort_ubtf_t
    real(kind=4), pointer :: uv(:,:)
    real(kind=8), pointer :: freq(:)
  contains
    procedure, public :: compare => uv_sort_compare_ubtf
  end type uv_sort_ubtf_t
  !
  ! Type for sorting first by frequency, then by time
  type, extends(gi4_quicksort_t) :: uv_sort_ft_t
    real(kind=4), pointer :: uv(:,:)
    real(kind=8), pointer :: freq(:)
  contains
    procedure, public :: compare => uv_sort_compare_ft
  end type uv_sort_ft_t
  !
contains
  !
  function uv_sort_compare_ubtf(self,m,l)
    !-------------------------------------------------------------------
    ! Compare first by unique baseline, then by time and frequency
    !-------------------------------------------------------------------
    integer(kind=4) :: uv_sort_compare_ubtf
    class(uv_sort_ubtf_t), intent(in) :: self
    integer(kind=4),       intent(in) :: m,l
    ! Local
    integer(kind=4), parameter :: datecol=4
    integer(kind=4), parameter :: timecol=5
    integer(kind=4), parameter :: anticol=6
    integer(kind=4), parameter :: antjcol=7
    integer(kind=4) :: antmi,antmj,antli,antlj
    integer(kind=4) :: antmmin,antmmax,antlmin,antlmax
    !
    antmi = nint(self%uv(anticol,m))
    antmj = nint(self%uv(antjcol,m))
    antli = nint(self%uv(anticol,l))
    antlj = nint(self%uv(antjcol,l))
    if (antmi.lt.antmj) then
      antmmin = antmi
      antmmax = antmj
    else
      antmmin = antmj
      antmmax = antmi
    endif
    if (antli.lt.antlj) then
      antlmin = antli
      antlmax = antlj
    else
      antlmin = antlj
      antlmax = antli
    endif
    if (antmmin.ne.antlmin) then
      if (antmmin.gt.antlmin) then
        uv_sort_compare_ubtf = 1
      else
        uv_sort_compare_ubtf = -1
      endif
      return
    endif
    if (antmmax.ne.antlmax) then
      if (antmmax.gt.antlmax) then
        uv_sort_compare_ubtf = 1
      else
        uv_sort_compare_ubtf = -1
      endif
      return
    endif
    if (self%uv(datecol,m).ne.self%uv(datecol,l)) then
      if (self%uv(datecol,m).gt.self%uv(datecol,l)) then
        uv_sort_compare_ubtf = 1
      else
        uv_sort_compare_ubtf = -1
      endif
      return
    endif
    if (self%uv(timecol,m).ne.self%uv(timecol,l)) then
      if (self%uv(timecol,m).gt.self%uv(timecol,l)) then
        uv_sort_compare_ubtf = 1
      else
        uv_sort_compare_ubtf = -1
      endif
      return
    endif
    if (self%freq(m).eq.self%freq(l)) then
      uv_sort_compare_ubtf = 0
    elseif (self%freq(m).gt.self%freq(l)) then
      uv_sort_compare_ubtf = 1
    else
      uv_sort_compare_ubtf = -1
    endif
  end function uv_sort_compare_ubtf
  !
  function uv_sort_compare_ft(self,m,l)
    !-------------------------------------------------------------------
    ! Compare first by frequency, then by time
    !-------------------------------------------------------------------
    integer(kind=4) :: uv_sort_compare_ft
    class(uv_sort_ft_t), intent(in) :: self
    integer(kind=4),     intent(in) :: m,l
    ! Local
    integer(kind=4), parameter :: datecol=4
    integer(kind=4), parameter :: timecol=5
    !
    if (self%freq(m).ne.self%freq(l)) then
      if (self%freq(m).gt.self%freq(l)) then
        uv_sort_compare_ft = 1
      else
        uv_sort_compare_ft = -1
      endif
      return
    endif
    if (self%uv(datecol,m).ne.self%uv(datecol,l)) then
      if (self%uv(datecol,m).gt.self%uv(datecol,l)) then
        uv_sort_compare_ft = 1
      else
        uv_sort_compare_ft = -1
      endif
      return
    endif
    if (self%uv(timecol,m).eq.self%uv(timecol,l)) then
      uv_sort_compare_ft = 0
    elseif (self%uv(timecol,m).gt.self%uv(timecol,l)) then
      uv_sort_compare_ft = 1
    else
      uv_sort_compare_ft = -1
    endif
  end function uv_sort_compare_ft
  !
  subroutine uv_sort_comm(line,error)
    use gkernel_interfaces
    use uv_sort_codes
    !----------------------------------------------------------------------
    ! UVSORT [TIME|BASE|FIELD]
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    integer(kind=4) :: code,na
    character(len=6) :: argu,vvoc
    !
    ! Parse input line. Default argument is TIME
    argu = 'TIME'
    call sic_ke(line,0,1,argu,na,.false.,error)
    if (error) return
    call sic_ambigs('UV_SORT',argu,vvoc,code,sort_names,ncode_sort,error)
    if (error) return
    !
    ! Sort uv buffer
    if (code.eq.code_sort_field) then
       call uv_fsort(error)
    else
       call uv_tri(code,error)
    endif
    if (error) return
  end subroutine uv_sort_comm
  !
  subroutine uv_fsort(error)
    use image_def
    use gkernel_interfaces
    use uvmosaic_tool, only: loadfiuv
    use uv_rotate_shift_and_sort_tool, only: sortuv,loaduv
    use uv_buffers
    use uvmap_buffers, only: uvmap_prog
    !-----------------------------------------------------------------
    ! Allows for sorting for fields using mosaic uv sorting routines
    !-----------------------------------------------------------------
    logical, intent(inout) :: error
    !
    logical :: warning,sorted
    logical, allocatable :: signv(:)
    integer(kind=4) :: ier,ncol,nv,nf,xoff,yoff,loff,moff,ixcol,iycol
    integer(kind=index_length) :: iv,ifi,fsize(1)
    integer(kind=4), allocatable :: it(:)
    real(kind=4) :: cs(2),uvmax,uvmin,xy(2)
    real(kind=4), allocatable :: uarr(:),varr(:),foff(:,:),newv(:)
    real(kind=8), allocatable :: farr(:)
    character(len=*), parameter :: rname='UV_SORT'
    !
    if (.not.associated(duv)) then
       call map_message(seve%e,rname,'No UV data')
       error = .true.
       return
    endif
    ! Do we find pointing offsets?
    xoff = huv%gil%column_pointer(code_uvt_xoff)
    yoff = huv%gil%column_pointer(code_uvt_yoff)
    if ((xoff.ne.0).or.(yoff.ne.0)) then
       ! Yes => This is a mosaic
       if (yoff.ne.xoff+1) then
          ! Ill-defined mosaic
          call map_message(seve%e,rname,'Mosaic Y column does not follow the X column')
          error = .true.
          return
       endif
       ixcol = xoff
       iycol = yoff
    else
       ! No => Do we find phase offsets?
       loff = huv%gil%column_pointer(code_uvt_loff)
       moff = huv%gil%column_pointer(code_uvt_moff)
       if ((loff.ne.0).or.(moff.ne.0)) then
          ! Yes => This is a mosaic
          if (moff.ne.loff+1) then
             ! Ill-defined mosaic
             call map_message(seve%e,rname,'Mosaic M column does not follow the L column')
             error = .true.
             return
          endif
          ixcol = loff
          iycol = moff
       else
          ! No => This is a single-field
          error = .true.
          call map_message(seve%e,rname,'UV table contains a single field, cannot sort it by field')
          return
       endif
    endif
    !
    ! Create Sorted UV data
    call sic_delvariable('UVS',.false.,warning)
    !
    ! Check if new UV Table (uvtb%data) is already allocated
    if (allocated(uvtb%data))  deallocate (uvtb%data)
    !
    ! Copy header information
    call gildas_null(uvtb%head)
    call gdf_copy_header(huv,uvtb%head,error)
    if (error) return
    !
    ! Allocate duvt
    allocate(uvtb%data(uvtb%head%gil%dim(1),uvtb%head%gil%dim(2)),stat=ier)
    if (ier.ne.0) then
       call map_message(seve%e,rname,'Error allocating secondary UV buffer')
       error = .true.
       return
    endif
    call sic_def_real('UVS',uvtb%data,uvtb%head%gil%ndim,uvtb%head%gil%dim,.false.,error)
    if (error) return
    !
    ! Start sorting using routines from Mosaic mode
    !
    nv = huv%gil%dim(2)
    ncol = huv%gil%dim(1)
    cs(1) = 1.0 ! no UV shift
    cs(2) = 0.0 ! no UV shift
    xy(1) = 0.0 ! no UV shift
    xy(2) = 0.0 ! no UV shift
    !
    allocate(uarr(nv), varr(nv), signv(nv), farr(nv), it(nv), stat=ier)
    if (ier.ne.0) then
       call map_message(seve%e,rname,'Error allocating work arrays')
       error = .true.
       return
    endif
    call loaduv(duv, ncol, nv, cs, uarr, varr, signv, uvmax, uvmin)
    ! Loading field numbers
    call loadfiuv(duv, ncol, nv, farr, it, sorted, ixcol, iycol, varr, nf, foff)
    !
    ! Proceed to sorting
    if (.not.sorted) then
       call gr8_trie (farr,it,nv,error) ! Actual sorting using quicksort
       deallocate (farr, stat=ier) ! Deallocate farr to save some memory
       allocate (newv(nv), stat=ier)
       if (ier.ne.0) then
          call map_message(seve%e,rname,'Error allocating work arrays')
          error = .true.
          return
       endif
       !
       ! v is sorted here so sortuv can be used later
       do iv=1,nv
          newv(iv) = varr(it(iv))
       enddo
       varr(:) = newv(:)
       deallocate (newv,stat=ier) ! Deallocate newv to save some memory
    else
       deallocate (farr,stat=ier) ! if data is already sorted dealocate farr since it will not be used
    endif
    ! Apply sorting to output visibilities
    call sortuv (duv, uvtb%data, ncol, nv, huv%gil%ntrail, xy, uarr, varr, signv, it)
    !
    ! Deallocate reamining arrays to avoid leaks
    deallocate(uarr, varr, signv, it)
    !
    ! Adding field start and end info to Fields variable
    if (allocated(uvmap_prog%ifields)) deallocate(uvmap_prog%ifields)
    allocate(uvmap_prog%ifields(nf+1))
    ifi = 1
    uvmap_prog%ifields(ifi) = 1
    do iv=1,nv
       if ( (foff(1,ifi).ne.uvtb%data(ixcol,iv)) .or. &
            &  (foff(2,ifi).ne.uvtb%data(iycol,iv)) ) then
          ifi = ifi+1
          uvmap_prog%ifields(ifi) = iv
       endif
    enddo
    uvmap_prog%ifields(nf+1) = nv+1
    fsize(1) = nf+1  
    call sic_def_inte("FIELDS%ifields",uvmap_prog%ifields,1,fsize,.true.,error)
    deallocate(foff)
    !
    error = .false.
  end subroutine uv_fsort
  !
  subroutine uv_tri(code,error)
    use gkernel_interfaces
    use uv_buffers
    !----------------------------------------------------------------------
    ! UVSORT [TIME|BASE|UNIQUE]
    !----------------------------------------------------------------------
    integer(kind=4), intent(in)    :: code  ! Sorting code
    logical,         intent(inout) :: error
    !
    integer(kind=4) :: ier,nd,nv,id,iv
    integer(kind=4), allocatable :: it(:),ot(:)
    real(kind=8), allocatable :: order(:)
    logical :: sorted, warning, alloc
    character(len=*), parameter :: rname='UV_SORT'
    !
    if (.not.associated(duv)) then
       call map_message(seve%e,rname,'No UV data')
       error = .true.
       return
    endif
    !
    ! Create Sorted UV data
    call sic_delvariable('UVS',.false.,warning)
    !
    ! Check first if UVT is already matching UV
    alloc = .false.
    if (allocated(uvtb%data)) then
       if ( (huv%gil%dim(2).ne.uvtb%head%gil%dim(1)) .or. &
            & (huv%gil%dim(1)+3.ne.uvtb%head%gil%dim(2)) ) then
          deallocate (uvtb%data)
       else
          alloc = .true.
       endif
    endif
    !
    call gildas_null (uvtb%head, type = 'TUV')
    call gdf_transpose_header(huv,uvtb%head,'21  ',error)
    if (error)  return
    nd = uvtb%head%gil%dim(2)
    nv = uvtb%head%gil%dim(1)
    uvtb%head%gil%dim(2) = nd+3
    !
    if (.not.alloc) then
       allocate(uvtb%data(uvtb%head%gil%dim(1),uvtb%head%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',uvtb%data,uvtb%head%gil%ndim,uvtb%head%gil%dim,.false.,error)
    if (error) return
    !
    allocate(order(nv),it(nv),ot(nv),stat=ier)
    if (ier.ne.0) then
       call map_message(seve%e,rname,'Error getting memory ')
       error = .true.
       return
    endif
    !
    call uv_findtb(code,duv,nv,nd,order,it,ot,sorted,error)
    if (error)  return
    if (sorted) then
       print *,'****  SHOW UV -- already sorted for code ',code
       do id=1,nd
          do iv=1,nv
             uvtb%data(iv,id) = duv(id,iv)
          enddo
       enddo
    else
       do id=1,nd
          do iv=1,nv
             uvtb%data(iv,id) = duv(id,it(iv))
          enddo
       enddo
    endif
    do iv=1,nv
       uvtb%data(iv,nd+1) = 1.0
    enddo
    deallocate(order,it,ot)
  end subroutine uv_tri
  !
  subroutine uv_findtb(code,uv,nv,nd,order,it,ot,sorted,error,freq)
    use gkernel_interfaces
    use uv_sort_codes
    !---------------------------------------------------------------
    ! Support for SHOW UV
    !---------------------------------------------------------------
    integer(kind=4),        intent(in)    :: code       ! Code for sort operation
    integer(kind=4),        intent(in)    :: nd,nv      ! Size of visibility table
    real(kind=4),           intent(in)    :: uv(nd,nv)  ! Input UV data
    real(kind=8),           intent(out)   :: order(nv)  ! Sorting array buffer (do not use)
    integer(kind=4),        intent(out)   :: it(nv)     ! Sort index
    integer(kind=4),        intent(out)   :: ot(nv)     ! Reverse order
    logical,                intent(out)   :: sorted     ! Is already sorted
    logical,                intent(inout) :: error      ! Logical error flag
    real(kind=8), optional, intent(in)    :: freq(nv)   ! [MHz] Freq. at visibility center
    !
    integer(kind=4), parameter :: datecol=4
    integer(kind=4), parameter :: timecol=5
    integer(kind=4), parameter :: anticol=6
    integer(kind=4), parameter :: antjcol=7
    real(kind=4) :: rdate
    real(kind=8) :: olast
    integer(kind=4) :: iv
    character(len=*), parameter :: rname='UV_SORT'
    !
    select case (code)
    case (code_sort_bt)
       ! Order BASE(primary) then TIME(secondary). Build float list as:
       !   Antenna I   x  100*10000*86400 [pseudo-sec]
       ! + Antenna J   x      10000*86400 [pseudo-sec]
       ! + OffsetDate  x            86400 [sec]
       ! + Time                           [sec]
       ! This assumes 'OffsetDate' is less then 10000, and 'Antenna J' is less
       ! than 100.
       rdate = uv(datecol,1)
       do iv=1,nv
          order(iv) = 10000.d0*86400.0d0*(100.d0*uv(anticol,iv)+uv(antjcol,iv)) +  &
               (uv(datecol,iv)-rdate)*86400.d0 + uv(timecol,iv)
       enddo
       !
    case (code_sort_ubtf)
      ! Order by UNIQUE-BASE then TIME then FREQ
      if (.not.present(freq)) then
        call map_message(seve%e,rname,'Internal error: frequency array missing')
        error = .true.
        return
      endif
      call uv_findtb_ubtf(uv,nv,nd,freq,it,ot,sorted,error)
      return  ! Always, subsequent code not needed.
      !
    case (code_sort_ft)
      ! Order by FREQ then TIME
      if (.not.present(freq)) then
        call map_message(seve%e,rname,'Internal error: frequency array missing')
        error = .true.
        return
      endif
      call uv_findtb_ft(uv,nv,nd,freq,it,ot,sorted,error)
      return  ! Always, subsequent code not needed.
      !
    case (code_sort_tb)
       ! Order TIME(primary) then BASE(secondary). Build float list as:
       !   OffsetDate  x  86400  [sec]
       ! + Time                  [sec]
       ! + Antenna I   x  0.01   [pseudo-sec]
       ! + Antenna J   x  0.0001 [pseudo-sec]
       ! This assumes 'Antenna I' and 'Antenna J' are less than 100.
       rdate = uv(datecol,1)
       do iv=1,nv
          order(iv) = (uv(datecol,iv)-rdate)*86400.d0 + uv(timecol,iv) +   &
               (100.0d0*uv(anticol,iv)+uv(antjcol,iv))*1.0d-4
       enddo
       !
    case default
       call map_message(seve%e,rname,'Code is not implemented')
       error = .true.
       return
    end select
    !
    ! 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) then
       do iv=1,nv
          it(iv) = iv
          ot(iv) = iv
       enddo
    else
       call gr8_trie(order,it,nv,error)
       if (error) return
       do iv=1,nv
          ot(it(iv)) = iv
       enddo
    endif
  end subroutine uv_findtb
  !
  subroutine uv_findtb_ubtf(uv,nv,nd,freq,it,ot,sorted,error)
    use gkernel_interfaces
    !---------------------------------------------------------------------
    ! Sort by:
    !  min-antenna, then
    !  max-antenna, then
    !  date, then
    !  time, then
    !  frequency
    !---------------------------------------------------------------------
    integer(kind=4),      intent(in)    :: nd,nv      ! Size of visibility table
    real(kind=4), target, intent(in)    :: uv(nd,nv)  ! Input UV data
    real(kind=8), target, intent(in)    :: freq(nv)   ! [MHz] Center frequency
    integer(kind=4),      intent(out)   :: it(nv)     ! Sort index
    integer(kind=4),      intent(out)   :: ot(nv)     ! Reverse order
    logical,              intent(out)   :: sorted     ! Is already sorted?
    logical,              intent(inout) :: error      ! Logical error flag
    ! Local
    integer(kind=4) :: iv,vlast
    type(uv_sort_ubtf_t) :: sorter
    !
    do iv=1,nv
      it(iv) = iv
    enddo
    !
    sorter%uv => uv
    sorter%freq => freq
    call sorter%sort(it,nv,error)
    if (error)  return
    !
    ! Set the already 'sorted' flag
    vlast = it(1)
    sorted = .true.
    do iv=1,nv
      if (it(iv).lt.vlast) then
        sorted = .false.
        exit
      endif
      vlast = it(iv)
    enddo
    !
    ! Set the reverse sorting array
    do iv=1,nv
      ot(it(iv)) = iv
    enddo
  end subroutine uv_findtb_ubtf
  !
  subroutine uv_findtb_ft(uv,nv,nd,freq,it,ot,sorted,error)
    use gkernel_interfaces
    !---------------------------------------------------------------------
    ! Sort by:
    !  frequency, then
    !  date, then
    !  time
    !---------------------------------------------------------------------
    integer(kind=4),      intent(in)    :: nd,nv      ! Size of visibility table
    real(kind=4), target, intent(in)    :: uv(nd,nv)  ! Input UV data
    real(kind=8), target, intent(in)    :: freq(nv)   ! [MHz] Center frequency
    integer(kind=4),      intent(out)   :: it(nv)     ! Sort index
    integer(kind=4),      intent(out)   :: ot(nv)     ! Reverse order
    logical,              intent(out)   :: sorted     ! Is already sorted?
    logical,              intent(inout) :: error      ! Logical error flag
    ! Local
    integer(kind=4) :: iv,vlast
    type(uv_sort_ft_t) :: sorter
    !
    do iv=1,nv
      it(iv) = iv
    enddo
    !
    sorter%uv => uv
    sorter%freq => freq
    call sorter%sort(it,nv,error)
    if (error)  return
    !
    ! Set the already 'sorted' flag
    vlast = it(1)
    sorted = .true.
    do iv=1,nv
      if (it(iv).lt.vlast) then
        sorted = .false.
        exit
      endif
      vlast = it(iv)
    enddo
    !
    ! Set the reverse sorting array
    do iv=1,nv
      ot(it(iv)) = iv
    enddo
  end subroutine uv_findtb_ft
  !
end module uv_sort
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
