subroutine douvext(jc,nv,visi,jx,jy,umin,umax,vmin,vmax)
  !---------------------------------------------------------------------
  !*
  ! IMAGER -- Utility routine
  !
  !   Compute extrema of UV coverage. No assumption,
  !   but may return 0 if all Negative or all Positive
  !!
  !---------------------------------------------------------------------
  integer, intent(in) :: jc         !! Size of a visibility
  integer, intent(in) :: nv         !! Number of visibilities
  integer, intent(in) :: jx         !! X coordinate pointer
  integer, intent(in) :: jy         !! Y coordinate pointer
  real, intent(in) :: visi(jc,nv)   !! Visibilities
  real, intent(out) :: umin,umax    !! U extrema
  real, intent(out) :: vmin,vmax    !! V extrema
  !
  ! Local ---
  integer :: i
  !
  ! Code ----
  vmin = 0
  vmax = 0 
  umin = 0.0
  umax = 0.0
  do i=1,nv
    if (visi(jx,i).lt.umin) then
      umin = visi(jx,i)
    elseif  (visi(jx,i).gt.umax) then
      umax = visi(jx,i)
    endif
    if (visi(jy,i).lt.vmin) then
      vmin = visi(jy,i)
    elseif  (visi(jy,i).gt.vmax) then
      vmax = visi(jy,i)
    endif
  enddo
  if (-vmin.gt.vmax) then
    vmax = -vmin
  else
    vmin = -vmax
  endif
end subroutine douvext
!
subroutine uv_listheader(huv,visi,mt,tf,nt,freq)
  use gkernel_interfaces
  use image_def
  use gbl_message
  use imager_interfaces, except_this => uv_listheader
  !-----------------------------------------------------
  ! @ private
  !*
  ! IMAGER - Utility routine
  !
  ! Give a brief summary of the content of an UV Table
  !!
  !-----------------------------------------------------
  type(gildas), intent(in) :: huv     !! UV header
  integer, intent(in) :: mt           !! Maximum number of dates
  integer, intent(out) :: nt          !! Number of dates
  integer, intent(out) :: tf(mt)      !! Dates (in Gildas code)
  real(4), intent(in) :: visi(huv%gil%dim(1),huv%gil%dim(2))   !! Visibilities
  real(8), intent(in) :: freq         !! Observing frequency
  !
  ! Local ---
  character(len=14) :: ch
  logical error
  integer jt,ti,i,j
  integer(kind=index_length) :: iv
  integer count(mt)
  real :: mintim(mt), maxtim(mt)
  real bmin(mt), bmax(mt), base, scale
  character(len=message_length) :: chain
  real(8) :: rti
  integer(4) :: iant, jant, ia, ja, nant
  integer(4) :: ka(-1:256),la(-1:256)
  !
  ! Code ----
  call map_message(seve%r,'HEADER','Summary of observations')
  scale = freq/299792458.d-6*1e-3
  write(chain,'(I6,A,I2,A,A,F13.3,A)') huv%gil%nchan,' Channels, ', &
    &   huv%gil%nstokes,' Stokes, ','  Rest Frequency ',freq,' MHz'
  call map_message(seve%r,'HEADER',chain)
  !
  nt = 0
  tf(:) = 0
  bmin(:) = 1E20
  bmax(:) = 0
  iant = 257
  jant = 0
  nant = 0
  ka = 0
  la = 0
  !
  do iv=1,huv%gil%nvisi
    rti = dble(visi(4,iv))+dble(visi(5,iv))/86400.0d0
    if (rti.ge.0) then
      ti = int(rti)
    else
      ti = int(rti)-1
    endif
    !
    jt = 0
    do j=1,nt
      if (ti.eq.tf(j)) then
        jt = j
        exit
      endif
    enddo
    if (jt.eq.0) then
      if (nt.gt.mt) return
      nt = nt+1
      tf(nt) = ti
      count(nt) = 1
      mintim(nt) = rti-ti
      maxtim(nt) = rti-ti
      jt = nt
    else
      count(jt) = count(jt)+1
      mintim(jt) = min(rti-ti,mintim(jt))
      maxtim(nt) = max(rti-ti,maxtim(jt))
    endif
    !
    ! Build the antenna pointer list
    ia = nint(visi(6,iv))
    if (ia.ne.0) then
      if (la(ia).eq.0) then
      nant = nant+1
      la(ia) = nant
      ka(nant) = ia
      endif
    endif
    ja = nint(visi(7,iv))
    if (ja.ne.0) then
      if (la(ja).eq.0) then
        nant = nant+1
        la(ja) = nant
        ka(nant) = ja
      endif
    endif
    if (ia.ne.0 .and. ja.ne.0) then
      iant = min(iant,ia,ja)
      jant = max(jant,ia,ja)
      !
      ! Valid antenna : compute baseline length
      base = visi(1,iv)**2+visi(2,iv)**2
      bmin(jt) = min(base,bmin(jt))
      bmax(jt) = max(base,bmax(jt))
    endif
  enddo
  !
  ! Go to baseline
  bmin = sqrt(bmin)
  bmax = sqrt(bmax)
  !
  mintim(1:nt) = mintim(1:nt)*24.0
  maxtim(1:nt) = maxtim(1:nt)*24.0
  !
  if (huv%gil%version_uv .ge. code_version_uvt_syst) then
    call map_message(seve%r,'HEADER','Has fine Doppler correction')
  else if (huv%gil%version_uv .eq. code_version_uvt_freq) then
    call map_message(seve%r,'HEADER','Has no Doppler information')
  else if (huv%gil%version_uv .eq. code_version_uvt_dopp) then
    call map_message(seve%r,'HEADER','Has coarse Doppler information')
  endif
  call map_message(seve%r,'HEADER', &
       & '   Dates -       Times     Visibilities      Minimun    & Maximum Baselines')
  call map_message(seve%r,'HEADER', &
       & '                  (hr)                       (m)  (kWave)    (m)    (kWave)')
  do i=1,nt
    call gag_todate(tf(i),ch,error)
    write(chain,100) ch,mintim(i),maxtim(i),count(i),bmin(i),bmin(i)*scale,bmax(i),bmax(i)*scale
    call map_message(seve%r,'HEADER',chain)
  enddo
  write(chain,'(I4,A,I4,I4)') nant, ' Antennas,  in range ',iant,jant
  call map_message(seve%r,'HEADER',chain)
  write(*,'(20I4)') ka(1:nant)
100 format (1X,A,F6.2,F6.2,I12,3X,F7.1,1x,F7.1,2X,F8.1,1X,F7.1)
end subroutine uv_listheader
!
!<FF>
subroutine uniform_beam (uv_taper,map_size,map_cell,   &
        &    uniform,wcol,mcol,error,mode,                 &
        &    beams,mbeam,start,step,uvmax,result,huvl,duvl)
  use imager_interfaces, except_this=>uniform_beam
  use gildas_def
  use image_def
  use clean_def
  use gbl_message
  use gkernel_interfaces
  use omp_control
  !$ use omp_lib
  !------------------------------------------------------------------------
  ! @ private-mandatory
  !*
  ! IMAGER -- Support for command UV_STAT 
  !
  !     Compute dirty beams from a UV Table by Gridding and Fast Fourier 
  !   Transform, with one single beam for all channels.
  !!
  !------------------------------------------------------------------------
  type(gildas), intent(in) :: huvl                !! UV Table Header
  real, intent(inout) :: duvl(:,:)                !! Visibility Array
  character(len=*), intent(in) :: mode            !! Mode of statistics
  real, intent(in) :: uv_taper(3)                 !! UV Taper
  integer, intent(in) :: map_size(2)              !! Number of pixels
  real, intent(in) :: map_cell(2)                 !! Pixel size
  real, intent(in) :: uniform(2)                  !! Robust parameter
  integer, intent(inout) :: wcol                  !! Weight column
  integer, intent(inout) :: mcol(2)               !! Channel range
  integer, intent(in) :: mbeam                    !! Number of beams
  logical :: error                    !! Logical Error flag
  real, intent(out) :: beams(map_size(1),map_size(2),mbeam)  !! Beam array
  real, intent(inout) :: start        !! Starting value for range
  real, intent(inout) :: step         !! Step for range
  real, intent(in) :: uvmax           !! Max UV distance
  real, intent(out) :: result(:,:)    !! Resulting beam characteristics
  !
  ! Constants
  character(len=7) :: rname = 'UV_STAT'
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: clight=299792458d-6  ! Frequency in MHz
  integer, parameter :: muni=18   ! Do not change
  !
  ! Local ---
  integer :: inner_threads, kthread
  logical :: omp_nested
  type (gridding) :: conv
  integer ctype               ! Convolution mode, local value
  real(8) freq,convert(6)
  integer nx,ny,nc,nd,lx,ly,nu,nv
  integer ctypx,ctypy,fcol
  real uv_cell(2)
  real xparm(10),yparm(10),support(2)
  real vref,voff,vinc,lambda
  integer ndim, nn(2), i, j
  real, allocatable :: ipxc(:), ipyc(:)
  real, allocatable :: ipw(:,:), ipv(:), ipg(:)
  complex, allocatable :: ipf(:)
  complex, allocatable :: ipft(:)
  real, allocatable :: wfft(:)
  integer :: ier
  !
  integer :: nuni
  real wnat, noise, mn, vunif
  integer ix_patch, iy_patch, icol, ib
  real(4) major_axis(muni), minor_axis(muni), pos_angle(muni), knoise(muni)
  real(4) sidelobe(2,muni), utaper(muni), unif(muni), wuni(muni), ouni(muni)
  integer :: idx(muni)
  real(4) sec,zero(3),thre,rms,rmk
  character(len=8) chain(muni)
  character(len=32) unit
  character(len=10) jyunit
  character(len=16) kunit
  character(len=message_length) string
  !
  real cpu0,cpu1,pixel_per_beam,bmax
  !
  data zero/3*0/
  data pixel_per_beam /2.0/
  !
  ! Code ---
  call gag_cpu(cpu0)
  xparm(1:10) = 0
  yparm(1:10) = 0
  !
  select case (mode)
  case ('TAPER') 
    if (step.eq.0.0) step = sqrt(2.0)
    if (start.eq.0.0) start = 50.0
  case ('WEIGHT','ROBUST')
    if (step.eq.0.0) step = 10.0**0.25
    if (start.eq.0.0) start = 1.0/step**4
  case ('CELL' ) 
    if (step.eq.0.0) step = sqrt(2.0)
    if (start.eq.0.0) start = uniform(1)/step**4
    if (start.eq.0.0) start = 7.5/step**4 ! NOEMA default    
  case ('BRIGGS') 
    continue
  case default
    string = 'Unsupported mode '//mode
    call map_message(seve%e,rname,string)
    error = .true.
    return
  end select
  !
  nx = map_size(1)
  ny = map_size(2)
  nd = nx*ny
  nu = huvl%gil%dim(1)
  nv = huvl%gil%nvisi   !! NOT huvl%gil%dim(2)
  if (nv.ne.huvl%gil%nvisi) then
    call map_message(seve%e,rname,'more than 2^32 visibilities')
    error = .true.
    return
  endif
  !
  ! This must be a patch for some old stuff
  if (huvl%gil%dim(1).ne.3) then
    nc = huvl%gil%nchan
  else
    nc = 1
  endif
  if (nv.gt.10E6) then
    write(string,'(A,F12.6,A,I0,A)') 'Found ',nv*1D-6, ' Mega-Visibilities, ',nc,' channels'
  else if (nv.gt.10E3) then
    write(string,'(A,F9.3,A,I0,A)') 'Found ',nv*1D-3, ' kilo-Visibilities, ',nc,' channels'
  else
    write(string,'(A,I0,A,I0,A)') 'Found ',nv,' Visibilities, ',nc,' channels'
  endif
  call map_message(seve%i,rname,string)
  if (nv.eq.0) return ! Just in case
  !
  ! Get work space at once, for memory contiguity reasons.
  !
  nuni = 10
  if (mode.eq.'WEIGHT') nuni = muni
  !
  allocate (ipxc(nx),ipyc(ny),ipw(nv,nuni),ipg(nd),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation failure')
    error = .true.
    return
  endif
  !
  vref = huvl%gil%convert(1,1)
  voff = huvl%gil%voff
  vinc = huvl%gil%vres
  !
  call uv_get_cols(rname,huvl,duvl,nc,mcol,wcol, fcol, freq, error)
  if (error) return
  !
  icol = fcol*3+7 ! Convert Channel number to Column pointer
  !
  ! Compute gridding function
  ctype = 1                    ! Force it for the FAST gridding.
  ctypx = ctype
  ctypy = ctype
  call grdflt (ctypx, ctypy, xparm, yparm)
  call convfn (ctypx, xparm, conv%ubuff, conv%ubias)
  call convfn (ctypy, yparm, conv%vbuff, conv%vbias)
  uv_cell(1) = clight/freq/(map_cell(1)*map_size(1))
  uv_cell(2) = clight/freq/(map_cell(2)*map_size(2))
  support(1) = xparm(1)*uv_cell(1) ! In meters
  support(2) = yparm(1)*uv_cell(2)
  !
  lx = (uvmax+support(1))/uv_cell(1) + 2
  ly = (uvmax+support(2))/uv_cell(2) + 2
  lx = 2*lx
  ly = 2*ly
  call docoor (lx,-uv_cell(1),ipxc) 
  call docoor (ly,uv_cell(2),ipyc) 
  !
  if (wcol.ge.0) call dodate (nu,nv,duvl,4,5)
  !
  call gag_cpu(cpu1)
  write(string,102) 'Start Weighting ',cpu1-cpu0
  call map_message(seve%i,rname,string)
  !
  ! This is a non-Parallel Section, set Outer Thread Nesting to (1)
  ! and inner to (Max)
  !$ kthread = 1      
  !$ inner_threads = omp_get_max_threads()
  !$ call ompset_thread_nesting(rname, kthread, inner_threads, omp_nested)
  !
  ! Compute weights
  wuni = 0.
  select case(mode)
  case ('TAPER')
    wuni(1) = uniform(2)
    utaper(1) = start
    do i=2,nuni-1
      utaper(i) = utaper(i-1)*step
    enddo
    utaper(nuni) = 0.0
    call do3weig (nu,nv,  &
     &      duvl,         &    ! Visibilities
     &      1,2,          &    ! U, V pointers
     &      icol,         &    ! Weight channel
     &      uniform(1),   &    ! Uniform UV cell size
     &      ipw,          &    ! Weight array
     &      wuni,nuni,    &    ! Fraction of weight
     &      utaper,wnat)
     ouni(1:nuni) = utaper(1:nuni)
  case ('ROBUST')
    unif(1) = start
    unif(nuni) = 0.0
    do i = 2,nuni-1
      unif(i) = unif(i-1)*step
    enddo
    wuni(1:nuni) = unif(1:nuni)
    utaper(1:3) = uv_taper(1:3)
    call do2weig (nu,nv,  &
     &      duvl,         &    ! Visibilities
     &      1,2,          &    ! U, V pointers
     &      icol,         &    ! Weight channel
     &      uniform(1),   &    ! Uniform UV cell size
     &      ipw,          &    ! Weight array
     &      wuni,nuni,    &    ! Fraction of weight
     &      utaper,wnat)
     ouni(1:nuni) = unif(1:nuni)
  case ('BRIGGS')
    do i = 1,nuni
      unif(i) = -4.0+(i-1)*0.50 !! nuni)/(nuni-1)
    enddo
    unif(nuni) = 0.0
    wuni(1:nuni) = unif(1:nuni)
    utaper(1:3) = uv_taper(1:3)
    call do2weig (nu,nv,  &
     &      duvl,         &    ! Visibilities
     &      1,2,          &    ! U, V pointers
     &      icol,         &    ! Weight channel
     &      uniform(1),   &    ! Uniform UV cell size
     &      ipw,          &    ! Weight array
     &      wuni,nuni,    &    ! Fraction of weight
     &      utaper,wnat)
     ouni(1:nuni) = unif(1:nuni)
  case ('WEIGHT')
    nuni = 10
    unif(1) = start
    do i = 2,nuni-1
      unif(i) = unif(i-1)*step
    enddo
    unif(nuni) = 0.0
    wuni(1:nuni) = unif(1:nuni)
    utaper(1:3) = uv_taper(1:3)
    call do2weig (nu,nv,  &
     &      duvl,         &    ! Visibilities
     &      1,2,          &    ! U, V pointers
     &      icol,         &    ! Weight channel
     &      uniform(1),   &    ! Uniform UV cell size
     &      ipw,          &    ! Weight array
     &      wuni,nuni,    &    ! Fraction of weight
     &      utaper,wnat)
    !
    do i = nuni+1,muni
      unif(i) = -(muni-i+1)*0.50 
    enddo
    !
    vunif = 2*uniform(1) ! This is the convention
    wuni(nuni+1:muni) = unif(nuni+1:muni)
    utaper(1:3) = uv_taper(1:3)
    call do2weig (nu,nv,  &
     &      duvl,         &    ! Visibilities
     &      1,2,          &    ! U, V pointers
     &      icol,         &    ! Weight channel
     &      vunif,        &    ! Uniform UV cell size
     &      ipw(:,nuni+1:muni),             &    ! Weight array
     &      wuni(nuni+1:muni),muni-nuni,    &    ! Fraction of weight
     &      utaper,wnat)
     !
     nuni = muni
  case ('CELL')
    if (uniform(2).eq.0) then
      call map_message(seve%e,rname,'Null MAP_ROBUST factor, cannot use MAP_UVCELL')
      error = .true.
      return
    endif
    unif(1) = start
    do i = 2,nuni
      unif(i) = unif(i-1)*step
    enddo
    wuni(1) = uniform(2)
    wuni(2:nuni) = unif(2:nuni)
    utaper(1:3) = uv_taper(1:3)
    call do4weig (nu,nv,  &
     &      duvl,         &    ! Visibilities
     &      1,2,          &    ! U, V pointers
     &      icol,         &    ! Weight channel
     &      unif,         &    ! Uniform UV cell size
     &      ipw,          &    ! Weight array
     &      wuni,nuni,    &    ! Fraction of weight
     &      utaper,wnat)
     ouni(1:nuni) = unif(1:nuni)
  case default 
    call map_message(seve%e,rname,'Invalid mode '//mode)
    error = .true.
    return
  end select
  call gag_cpu(cpu1)
  write(string,102) 'Finished Weighting ',cpu1-cpu0
  call map_message(seve%i,rname,string)
  if (wnat.eq.0.0) then
    write(string,101) 'Plane ',fcol,' has Zero weight'
    call map_message(seve%e,rname,string)
    deallocate (ipxc,ipyc,ipw,ipv,ipg,stat=ier)
    error = .true.
    return
  endif
  !
  noise = 1e-3/sqrt(wnat)
  call prnoise(rname,'Natural',noise,rms)
  !
  ! Get FFTs work space
  allocate (ipft(lx*ly*nuni),ipf(nx*ny),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation failure')
    deallocate (ipxc,ipyc,ipw,ipv,ipg,stat=ier)
    error = .true.
    return
  endif
  !
  ! Compute FFTs
  call do2fft (nu,nv,   &      ! Size of visibility array
     &    duvl,         &      ! Visibilities
     &    1,2,          &      ! U, V pointers
     &    lx,ly,nuni,   &      ! Cube size
     &    ipft,         &      ! FFT cube
     &    ipxc, ipyc,   &      ! U and V grid coordinates
     &    ipw)                 ! Weight array 
  call gag_cpu(cpu1)
  write(string,102) 'Finished Gridding ',cpu1-cpu0
  call map_message(seve%i,rname,string)
  !
  ! Make beam, not normalized
  ndim = 2
  nn(1) = nx
  nn(2) = ny
  call fourt_plan(ipf,nn,ndim,-1,1)
  deallocate(ipf)
  !
  convert = (/dble(nx/2+1),0.d0,-dble(map_cell(1)),   &
     &    dble(ny/2+1),0.d0,dble(map_cell(2))/)
  !
  ! No grid correction 
  !
  !NOGRID!  call grdtab (ny, conv%vbuff, conv%vbias, ipxc)
  !NOGRID!  call grdtab (nx, conv%ubuff, conv%ubias, ipyc)
  !
  ! Loop on Uniform parameters
  ipw(:,:) = max(0.0,ipw) ! Flagged data have negative weights
  !
  !$OMP PARALLEL if (mbeam.ge.nuni) DEFAULT(NONE) &
  !$OMP SHARED(nv,nuni,mbeam,nx,ny,lx,ly,nn,ndim, ipft,ipw, beams,wuni,sidelobe) &
  !$OMP SHARED(major_axis, minor_axis, pos_angle, ix_patch, iy_patch, convert) &
  !$OMP PRIVATE(i,ib,bmax, ier,ipf,wfft, thre,error)
  allocate(ipf(nx*ny),wfft(2*max(nx,ny)),stat=ier)
  if (ier.ne.0) then
    Print *,'F-UV_STAT, Memory allocation failure in thread '
    read(*,*) ier
  endif
  !$OMP DO
  do i = 1,nuni
    ib = min(i,mbeam)
    call extracs(nuni,nx,ny,i,ipft,ipf,lx,ly)
    call fourt  (ipf,nn,ndim,-1,1,wfft)
    call cmtore (ipf,beams(1,1,ib),nx,ny)
    !NOGRID!    call dogrid (ipg,ipxc,ipyc,nx,ny,beams(1,1,ib))
    !
    ! Normalize and Free beam
    !NOGRID!    call docorr (beams(1,1,ib),ipg,nd)
    bmax = beams(nx/2+1,ny/2+1,ib)
    beams(:,:,ib) = beams(:,:,ib)/bmax
    !
    ! Get noise & Sidelobes
    wuni(i) = sum(ipw(1:nv,i))
    sidelobe(1,i) = minval(beams(:,:,ib)) !! minimum(nd,beams(1,1,ib))
    thre = max(min(abs(-1.5*sidelobe(1,i)),0.7),0.3)
    !
    ! Fit beam
    ix_patch = nx/2
    iy_patch = ny/2
    major_axis(i) = 0.
    minor_axis(i) = 0.
    pos_angle(i) = 0.
    !$OMP CRITICAL
    ! FIBEAM is not easily re-entrant, so No parallelism here
    ! Print *,'Calling FIBEAM'
    call fibeam (' ',beams(1,1,ib),nx,ny,   &
     &      ix_patch,iy_patch,thre,   &
     &      major_axis(i),minor_axis(i),pos_angle(i),   &
     &      convert,error)
    !$OMP END CRITICAL
    !
    ! Subtract main beam
    ! Print *,'Calling SIDELO'
    call sidelo (beams(1,1,ib),nx,ny,sidelobe(1,i),   &
     &      major_axis(i),minor_axis(i),pos_angle(i),   &
     &      convert)
    !
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  !
  call gag_cpu(cpu1)
  write(string,102) 'Finished FFTs ',cpu1-cpu0
  call map_message(seve%i,rname,string)
  !
  ! Delete scratch space
  deallocate (ipxc,ipyc,ipw,ipv,ipg,stat=ier)
  deallocate (ipf,ipft,stat=ier)
  !
  ! Printout results
  sec = 180.*3600./pi
  lambda =  clight/freq
  call gagout(' ')
  ! Define the unit for Flux density
  if (rms.le.2.0) then
    jyunit = '(Jy)      '
  else if (rms.le.2e3) then
    jyunit = '(mJy)     '
  else
    jyunit = '(microJy) '
  endif
  rms = rms*1e-3 ! As frequencies are in MHz
  !
  ! Define the scale factor for
  knoise(1:nuni) = sqrt(1.0/wuni(1:nuni))*lambda**2*4*log(2.0)*1e-3/ &
     &      (2.0*1.38e3*major_axis(1:nuni)*minor_axis(1:nuni)*pi)
  rmk = sqrt(minval(knoise(1:nuni))*maxval(knoise(1:nuni)))
  !
  if (rmk.gt.0.05) then
    rmk = 1
    kunit = ' (K)        % '
  elseif (rmk.gt.0.1e-3) then
    rmk = 1e3
    kunit = '(mK)        % '
  else
    rmk = 1e6
    kunit = '(microK)    % '
  endif
  unit = jyunit//kunit
  !
  if (mode.eq.'TAPER') then
    call gagout('  Taper      Major    Minor     PA            Noise      Sidelobe')
    call gagout('   (m)        (")      (")     (deg)     '//unit)
    do i=1,nuni-1
      write(chain(i),'(F8.1)') utaper(i)
    enddo
    chain(nuni) = '  None'
  elseif  (mode.eq.'CELL') then
    call gagout('  Cell       Major    Minor     PA            Noise      Sidelobe')
    call gagout('   (m)        (")      (")     (deg)     '//unit)
    chain(1) = ' None 0.'
    do i=2,nuni
      write(chain(i),106) unif(i)
    enddo
  elseif  ((mode.eq.'WEIGHT').or.(mode.eq.'ROBUST')) then
    call gagout(' Robust      Major    Minor     PA            Noise      Sidelobe')
    call gagout('              (")      (")     (deg)     '//unit)
    do i=1,nuni
      write(chain(i),106) unif(i)
      if (unif(i).eq.0) chain(i) = ' None 0.'
    enddo
  elseif  (mode.eq.'BRIGGS') then
    call gagout(' Briggs      Major    Minor     PA            Noise      Sidelobe')
    call gagout('              (")      (")     (deg)      '//unit)
    do i=1,nuni-1
      write(chain(i),106) unif(i)
    enddo
    chain(nuni) = ' None 0.'
  endif
  !
  ! Sort by increasing values of unif()
  do i=1,nuni
    idx(i) = i
  enddo
  if (nuni.eq.muni) then
    do i=1,muni
      if (unif(i).gt.0) then
        ouni(i) = 1./unif(i)
      else
        ouni(i) = unif(i)
      endif
    enddo
    call gr4_trie(ouni,idx,nuni,error)
  else
    unif(1:nuni) = ouni(1:nuni)
  endif
  !
  do j=1,nuni
    i = idx(j)
    write(string,105) chain(i),major_axis(i)*sec,minor_axis(i)*sec   &
     &      ,pos_angle(i),sqrt(1.0/wuni(i))*rms,knoise(i)*rmk &
     &      ,sidelobe(1,i)*100.0,sidelobe(2,i)*100.0
    call gagout(string)
    result(j,1) = unif(i)
    result(j,2) = major_axis(i)*sec
    result(j,3) = minor_axis(i)*sec
    result(j,4) = pos_angle(i)
    result(j,5) = sqrt(1.0/wuni(i))*1e-3
    result(j,6) = knoise(i)
    result(j,7) = sidelobe(1,i)*100.0
    result(j,8) = sidelobe(2,i)*100.0
    result(i,9) = j
  enddo
  call gagout(' ')
  !
  ! Recommend pixel size
  mn = minor_axis(1)
  do i=2,nuni
    mn = min(mn,minor_axis(i))
  enddo
  if (mn.ge.0.1*sec) then
    mn = 0.02*nint(50.0*mn*sec/pixel_per_beam)
  else
    mn = 0.002*nint(500.0*mn*sec/pixel_per_beam)
  endif
  write(string,107) map_cell(1)*sec, mn
  call map_message(seve%i,rname,string)
  error = .false.
  return
  !
  101   format(a,i6,a)
  102   format(a,f9.3,a)
  105   format(a,1x,f9.3,f9.3,f9.1,1x,f9.2,f9.2,1x,f6.1,f6.1)
  106   format(f8.2)
  107   format('Recommended pixel size is ',f6.3,' - ',f6.3,'"')
end subroutine uniform_beam
!
subroutine do2weig (jc,nv,visi,jx,jy,iw,unif,we,wm,nw,taper,s)
  use gildas_def
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, except_this => do2weig
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support for command UV_STAT
  !
  !   Compute weights of the visibility points.
  !   Explore here the robust parameters.
  !!
  !----------------------------------------------------------------------
  integer, intent(in) :: jc    !! Size of a visibility
  integer, intent(in) :: nv    !! Number of visibilities
  integer, intent(in) :: jx    !! X coordinate pointer
  integer, intent(in) :: jy    !! Y coordinate pointer
  integer, intent(in) :: iw    !! Weight pointer
  integer, intent(in) :: nw    !! Number of weighting schemes
  real, intent(in) :: visi(jc,nv)    !! Visibilities
  real, intent(in) :: unif           !! Cell size in meters
  real, intent(out) :: we(nv,nw)     !! Weight arrays
  real, intent(inout) :: wm(nw)      !! on input: robust factors
  real, intent(in) :: taper(3)       !! Taper
  real, intent(out) :: s             !! Sum of weights (natural noise)
  !
  ! Constants
  real(8), parameter :: pi=3.14159265358979323846d0
  character(len=*), parameter :: rname='DO2WEIG'
  !
  ! Local ---
  real ss(nw),s2(nw),uw(nw)       ! Small automatic arrays
  integer i,kw
  real u,v
  real cx,sx,cy,sy,staper
  real ww,st,u2
  logical do_taper, briggs
  real umin,umax,vmin,vmax
  real wfact
  !
  ! GILDAS robust parameter ranges from [0,infty] (in practice 10)
  briggs = wm(1).lt.0   ! Briggs parameters range from [-4,0] 
  ! re-mapped to true Briggs by shifting in the [-2,2] range
  !
  ! Natural weights
  s = 0.
  do i=1,nv
    if (visi(iw,i).gt.0.0) then
      we(i,nw) = visi(iw,i)
      s = s+we(i,nw)
    else
      we(i,nw) = 0.0
    endif
  enddo
  if (s.eq.0) return
  !
  ! Define taper
  staper = taper(3)*pi/180.0
  do_taper = .false.
  if (taper(1).ne.0) then
    cx = cos(staper)/taper(1)
    sy = sin(staper)/taper(1)
    do_taper = .true.
  else
    cx = 0.0
    sy = 0.0
  endif
  if (taper(2).ne.0) then
    cy = cos(staper)/taper(2)
    sx = sin(staper)/taper(2)
    do_taper = .true.
  else
    cy = 0.0
    sx = 0.0
  endif
  !
  ! 1) Compute VMIN, VMAX, UMIN, UMAX
  call douvext(jc,nv,visi,jx,jy,umin,umax,vmin,vmax)
  !
  call do0weig(jc,nv,visi,jx,jy,iw,unif,we(1,nw))
  !
  ! Define robustness - generic
  call dowfact (nv,we(:,nw),wfact)
  !
  ! Apply robustness
  do kw=1,nw-1
    ss(kw) = 0.0
    s2(kw) = 0.0
  enddo
  ss(nw) = 1.0
  s2(nw) = 1.0
  !
  if (briggs) then
    ! s = 5*10^(-Briggs)  with (typically) -2 < Briggs < 2
    ! Here we use an input range [-4,0] so shift by 2
    do kw=1,nw-1
      u2  = 5*10**(-(2+wm(kw)))    ! s
      u2 = u2*u2                   ! s^2
      uw(kw) = u2/wfact
    enddo
  else
    do kw=1,nw-1
      uw(kw) = wm(kw)*wfact
    enddo
  endif
  !
  !$OMP PARALLEL DEFAULT(NONE) &
  !$OMP SHARED(nv,do_taper,briggs,cx,cy,sx,sy, jx,jy,iw,nw) &
  !$OMP SHARED(we, visi, uw) REDUCTION(+:ss,s2) &
  !$OMP PRIVATE(i, kw, ww,staper,st, u,v)
  !$OMP DO
  do i=1,nv
    ww = we(i,nw)
    if (do_taper) then
      v = visi(jy,i)
      u = visi(jx,i)
      staper = (u*cx + v*sy)**2 + (-u*sx + v*cy)**2
      if (staper.gt.64.0) then
        staper = 0.0
      else
        staper = exp(-staper)
      endif
    else
      staper = 1.0
    endif
    !
    ! Get the natural weighting correct now
    if (ww.le.0.0) then
      we(i,1:nw) = 0.0
    else
      we(i,nw) = staper*visi(iw,i)
      !
      ! Compute the new weights
      if (briggs) then
        ! Briggs way
        do kw=1,nw-1
          !
          st = staper/(uw(kw)*ww+1.0)
          we(i,kw) = visi(iw,i)*st
          ss(kw) = ss(kw) + we(i,kw)
          s2(kw) = s2(kw) + we(i,kw)*st
        enddo
      else
        ! GILDAS way
        do kw=1,nw-1
          if (ww.gt.uw(kw)) then
            st = staper/ww*uw(kw)
          else
            st = staper
          endif
          we(i,kw) = visi(iw,i)*st
          ss(kw) = ss(kw) + we(i,kw)
          s2(kw) = s2(kw) + we(i,kw)*st
        enddo
      endif
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  !
  ! Renormalize weights to get proper noise
  do kw=1,nw-1
    st = ss(kw)/s2(kw)
    do i=1,nv
      we(i,kw) = st*we(i,kw)
    enddo
  enddo
end subroutine do2weig
!
subroutine do3weig (jc,nv,visi,jx,jy,iw,cunif,we,cwm,nw,taper,s)
  use gildas_def
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, except_this => do3weig
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support for command UV_STAT 
  !
  !   Compute weights of the visibility points.
  !   TAPER mode
  !!
  !----------------------------------------------------------------------
  integer, intent(in) :: jc    !! Size of a visibility
  integer, intent(in) :: nv    !! Number of visibilities
  integer, intent(in) :: jx    !! X coordinate pointer
  integer, intent(in) :: jy    !! Y coordinate pointer
  integer, intent(in) :: iw    !! Weight pointer
  integer, intent(in) :: nw    !! Number of weighting schemes
  real, intent(in) :: visi(jc,nv)    !! Visibilities
  real, intent(in) :: cunif(1)       !! Cell size in meters
  real, intent(out) :: we(nv,nw)     !! Weight arrays
  real, intent(in) :: cwm(1)         !! on input: robust factors
  real, intent(in) :: taper(nw)      !! Tapers
  real, intent(out) :: s             !! Sum of weights (natural noise)
  !
  character(len=*), parameter :: rname='DO3WEIG'
  !
  ! Local ---
  integer i,kw
  real u,v,weight,wfact,unif,wm
  real staper
  real ss(10),s2(10),ww,st
  !
  ! Code ----
  !
  ! Natural weights
  unif = cunif(1)
  wm = cwm(1)
  !
  s = 0.
  do i=1,nv
    if (visi(iw,i).gt.0.0) then
      we(i,nw) = visi(iw,i)
      s = s+we(i,nw)
    else
      we(i,nw) = 0.0
    endif
  enddo
  if (s.eq.0) return
  !
  if (unif*wm.ne.0.0) then
    !
    call do0weig (jc,nv,visi,jx,jy,iw,unif,we(1,nw))
    !
    ! Define robustness
    call dowfact(nv,we(:,nw),wfact)
    weight = wm*sqrt(wfact)
  else
    weight = 0.0
    do i=1,nv
      weight = max(weight,we(i,nw))
    enddo
  endif
  !
  ! Apply robustness
  ss = 0.
  s2 = 0.
  !
  do i=1,nv
    v = visi(jy,i)
    u = visi(jx,i)
    do kw=1,nw
      if (kw.eq.nw) then
        staper = 1.0
      else
        staper = (u**2+v**2)/taper(kw)**2
        if (staper.gt.64.0) then
          staper = 0.0
        else
          staper = exp(-staper)
        endif
      endif
      ww = we(i,nw)
      if (ww.gt.weight) then
        st = staper/ww*weight
        we(i,kw) = visi(iw,i)*st
        ss(kw) = ss(kw) + we(i,kw)
        s2(kw) = s2(kw) + we(i,kw)*st
      elseif (ww.gt.0.0) then
        we(i,kw) = visi(iw,i)*staper
        ss(kw) = ss(kw) + we(i,kw)
        s2(kw) = s2(kw) + we(i,kw)*staper
      else
        we(i,kw) = 0.0
      endif
    enddo
  enddo
  !
  ! Renormalize weights to get proper noise
  do kw=1,nw
    st = ss(kw)/s2(kw)
    do i=1,nv
      we(i,kw) = st * we(i,kw)
    enddo
  enddo
end subroutine do3weig
!
subroutine dodate(nc,nv,visi,id,it)
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message
  !-----------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support for command UV_STAT 
  !
  !   List the dates
  !!
  !-----------------------------------------------------
  integer, intent(in) :: id       !! Date pointer
  integer, intent(in) :: it       !! Time pointer
  integer, intent(in) :: nc       !! Size of a visibility
  integer, intent(in) :: nv       !! Number of visibilities
  real, intent(in) :: visi(nc,nv) !! Visibilities
  !
  character(len=*), parameter :: rname='DODATE'
  integer, parameter :: maxt=100
  !
  ! Local ---
  character(len=78) ch
  logical error
  integer nt
  integer ti,tf(maxt),i,j,k,jt
  real(8) :: rti
  !
  nt = 0
  do i=1,nv
    rti = dble(visi(id,i))+dble(visi(it,i))/86400.0d0
    if (rti.ge.0) then
      ti = int(rti)
    else
      ti = int(rti)-1
    endif
    !
    jt = 0
    do j=1,nt
      if (ti.eq.tf(j)) then
        jt = j
        exit
      endif
    enddo
    if (jt.eq.0) then
      if (nt.gt.maxt) return
      nt = nt+1
      tf(nt) = ti
      jt = nt
    endif
  enddo
  !
  ! Simple sort
  do j = nt-1,1,-1
    k = j
    do i = j+1,nt
      if (tf(j).le.tf(i)) exit
      k = i
    enddo
    if (k.ne.j) then
      ti = tf(j)
      do i = j+1,k
        tf(i-1) = tf(i)
      enddo
      tf(k) = ti
    endif
  enddo
  !
  call map_message(seve%i,rname,'Observing dates are:')
  k = 5
  ch = ' '
  do i=1,nt
    call gag_todate(tf(i),ch(k:),error)
    k = k+20
    if (k.gt.80) then
      call gagout(ch)
      k = 5
    endif
  enddo
  if (k.gt.5) call gagout(ch)
end subroutine dodate
!
subroutine do4weig (jc,nv,visi,jx,jy,iw,unif,we,wm,nw,taper,s)
  use gkernel_interfaces
  use gbl_message
  use grid_control
  use imager_interfaces, except_this => do4weig
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER --  Support for UV_STAT
  !
  !   Compute weights of the visibility points.  CELL mode
  !
  !----------------------------------------------------------------------
  integer, intent(in) :: jc    !! Size of a visibility
  integer, intent(in) :: nv    !! Number of visibilities
  integer, intent(in) :: jx    !! X coordinate pointer
  integer, intent(in) :: jy    !! Y coordinate pointer
  integer, intent(in) :: iw    !! Weight pointer
  integer, intent(in) :: nw    !! Number of weighting schemes
  real, intent(in) :: visi(jc,nv)    !! Visibilities
  real, intent(in) :: unif(nw)       !! Cell size in meters
  real, intent(out) :: we(nv,nw)     !! Weight arrays
  real, intent(inout) :: wm(nw)      !! on input: robust factors
  real, intent(in) :: taper(3)       !! Tapers
  real, intent(out) :: s             !! Sum of weights (natural noise)
  !
  ! Constants
  real(8), parameter :: pi=3.14159265358979323846d0
  character(len=*), parameter :: rname='DO4WEIG'
  !
  ! Local ---
  integer i,kw,jold
  real u,v,wmax,wmin
  real cx,sx,cy,sy,staper
  real ss(10),s2(10),ww,st
  !
  real, allocatable :: suu(:), svv(:), sww(:), swe(:), wt(:)
  real :: umin, umax, vmin, vmax
  real :: sizecell
  integer :: ier, mv, nbv, ivmin, icode
  logical :: error
  !
  s = 0.
  do i=1,nv
    if (visi(iw,i).gt.0.0) then
      we(i,1) = visi(iw,i)
    else
      we(i,1) = 0.0
    endif
    s = s+we(i,1)
  enddo
  if (s.eq.0) return
  !
  ! Natural weights & Compute VMIN, VMAX, UMIN, UMAX
  call douvext(jc,nv,visi,jx,jy,umin,umax,vmin,vmax)
  !
  ! Define taper
  staper = taper(3)*pi/180.0
  if (taper(1).ne.0) then
    cx = cos(staper)/taper(1)
    sy = sin(staper)/taper(1)
  else
    cx = 0.0
    sy = 0.0
  endif
  if (taper(2).ne.0) then
    cy = cos(staper)/taper(2)
    sx = sin(staper)/taper(2)
  else
    cy = 0.0
    sx = 0.0
  endif
  !
  ! Uniform weights next
  jold = 0
  !
  ! First compute the taper
  allocate(wt(nv),stat=ier)
  do i=1,nv
    if (visi(iw,i).le.0.0) then
      wt(i) = 0.0
    else
      v = visi(jy,i)
      u = visi(jx,i)
      staper = (u*cx + v*sy)**2 +(-u*sx + v*cy)**2
      if (staper.gt.64.0) then
        staper = 0.0
      else
        staper = exp(-staper)
      endif
      wt(i) = staper
    endif
  enddo
  !
  ! Then apply robustness
  !
  ivmin = 1
  mv = 2*nv-ivmin+1
  allocate(suu(mv),svv(mv),sww(mv),swe(mv),stat=ier)
  if (ier.ne.0) then
    Print *,'Major failure in DO4WEI -- Allocation error MV ',mv
    return
  endif
  !
  suu(1:nv) = visi(jx,:)
  svv(1:nv) = visi(jy,:)
  sww(1:nv) = max(0.0,visi(iw,:))
  !
  ! Apply symmetry
  nbv = nv
  do i=ivmin,nv
    if (visi(iw,i).gt.0) then
      nbv = nbv+1
      suu(nbv) = -visi(jx,i)
      svv(nbv) = -visi(jy,i)
      sww(nbv) = visi(iw,i)
    endif
  enddo
  !
  we(:,1) = sww(1:nv) * wt(1:nv)
  !
  do kw=nw,2,-1
    !
    swe(:) = 0
    if (nbv.lt.grid_bigvisi) then
      icode = 0
      call dowei_icode(umax,umin,vmax,vmin,unif(kw),nbv,icode)
      sizecell = unif(kw)/icode
      call gridless_density(nbv,sizecell,unif(kw),suu,svv,sww,swe, &
        &  umin,umax,vmin,vmax,error)   
      if (error) return
    else
      call doweig_grid (jc,nv,visi,jx,jy,iw,unif(kw),swe,error) 
      if (error) return    
    endif
    !
    we(:,kw) = swe(1:nv) * wt(1:nv)  ! Apply taper
  enddo
  !
  ! Define Robust parameter & Apply Robustness
  ss(2:nw) = 0.0
  s2(2:nw) = 0.0
  ss(1) = 1.0
  s2(1) = 1.0
  !
  do kw = 2,nw
    wmax = 0.0
    wmin = 1.e36
    do i=1,nv
      if (we(i,kw).ne.0.0) then
        wmin = min(we(i,kw),wmin)
        wmax = max(we(i,kw),wmax)
      endif
    enddo
    wm(kw) = wm(1)*sqrt(wmin*wmax)
    !
    do i=1,nv
      staper = wt(i)
      ww = we(i,kw)
      if (ww.gt.wm(kw)) then
        st = staper/ww*wm(kw)
        we(i,kw) = visi(iw,i)*st ! On peut optimiser en utilisant sww(i)
        ss(kw) = ss(kw) + we(i,kw)
        s2(kw) = s2(kw) + we(i,kw)*st
      elseif (we(i,kw).gt.0.0) then
        we(i,kw) = visi(iw,i)*staper
        ss(kw) = ss(kw) + we(i,kw)
        s2(kw) = s2(kw) + we(i,kw)*staper
      else
        we(i,kw) = 0.0
      endif
    enddo
    !
    ! Re-normalize weight to compute noise
    st = ss(kw)/s2(kw)
    do i=1,nv
      we(i,kw) = st * we(i,kw)
    enddo
  enddo
end subroutine do4weig
!
subroutine sidelo (map,nx,ny,thre,majo,mino,pa,convert)
  !------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER --  Support for UV_STAT 
  !
  !   Compute sidelobes level
  !!
  !------------------------------------------------------------
  integer, intent(in) :: nx,ny          !! X,Y sizes
  real, intent(in) :: map(nx,ny)        !! Beam map
  real, intent(in) :: majo              !! Major axis
  real, intent(in) :: mino              !! Minor axis
  real, intent(in) :: pa                !! PA
  real, intent(out) :: thre(2)          !! Positive and Negative sidelobe
  real(8), intent(in) :: convert(3,2)   !! Axis Conversion formula
  !
  ! Constants
  real(8), parameter :: pi=3.14159265358979323846d0
  real(4), parameter :: sln2 = 2.0*sqrt(log(2.0))
  !
  ! Local ---
  real pang,oang,ca,sa,ma,mi,xs,ys,d,g
  integer i,j
  !
  ! Code ----
  pang = pa-90.0
  oang = pi*pang/180.0
  ca = cos(oang)
  sa = sin(oang)
  ma = majo/convert(3,1)/sln2
  mi = mino/convert(3,2)/sln2
  !
  thre(1) = 0.0
  thre(2) = 0.0
  !
  do j=ny/4+1,3*ny/4
    ys = j-convert(1,2)
    do i=nx/4+1,3*nx/4
      xs = i-convert(1,1)
      g = ((ca*xs + sa*ys)/ma)**2 + ((-sa*xs+ca*ys)/mi)**2
      d = map(i,j)
      thre(1) = min(thre(1),d)
      if (g.le.40.) then
        d = map(i,j)-exp(-g)
      endif
      thre(2) = max(thre(2),d)
    enddo
  enddo
end subroutine sidelo
!
subroutine do0weig (jc,nv,visi,jx,jy,jw,unif,we)
  use gkernel_interfaces
  use gildas_def
  use gbl_message
  use grid_control
  use imager_interfaces, only : doweig_sph 
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER --   Support for UV_STAT
  !
  !   Compute weights of the visibility points.
  !   Use gridded or non-gridded version according to 
  !   grid_bigvisi, i.e. Gridding%Big
  !!
  !----------------------------------------------------------------------
  integer, intent(in) :: jc    !! Size of a visibility
  integer, intent(in) :: nv    !! Number of visibilities
  integer, intent(in) :: jx    !! X coordinate pointer
  integer, intent(in) :: jy    !! Y coordinate pointer
  integer, intent(in) :: jw    !! Weight pointer
  real, intent(in) :: visi(jc,nv)    !! Visibilities
  real, intent(in) :: unif           !! Cell size in meters
  real, intent(out) :: we(nv)        !! Weight arrays
  !
  ! Local ---
  integer icode
  logical error
  !
  ! Code ----
  icode = 0
  error = .false.
  error = .false.
  if (nv.gt.grid_bigvisi) then
    ! Gridded version 
    call doweig_grid (jc,nv,visi,jx,jy,jw,unif,we,error)
  else
    call doweig_sph (jc,nv,visi,jx,jy,jw,unif,we,error,icode)
  endif
end subroutine do0weig
!
!
subroutine do2fft (np,nv,visi,jx,jy,nx,ny,nw,map,mapx,mapy,we) 
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support for UV_STAT
  !
  !   Compute FFT of image by gridding UV data for several weights
  !   at once. Uses simple in-cell gridding
  !!
  !----------------------------------------------------------------------
  integer, intent(in) :: nv                     !! number of visibilities
  integer, intent(in) :: np                     !! Size of a visibility, normally => 7+3*nc
  integer, intent(in) :: nw                     !! number of weight schemes
  integer, intent(in) :: nx,ny                  !! map size
  integer, intent(in) :: jx,jy                  !! X coord, Y coord location in VISI
  real, intent(in) :: visi(np,nv)               !! visibilities
  complex, intent(out) :: map(nw,nx,ny)         !! gridded visibilities
  real, intent(in) :: mapx(nx),mapy(ny)         !! Coordinates of grid
  real, intent(in) :: we(nv,nw)                 !! Weight array
  !
  ! Local ---
  integer :: ix,iy,iw,i,my,ky,kx
  real :: u,v
  real(8) :: xinc,xref,yinc,yref
  !
  ! Code ----
  map = 0.0
  xinc = mapx(2)-mapx(1)
  xref = nx/2+1
  yinc = mapy(2)-mapy(1)
  yref = ny/2+1
  my = ny/2+1
  !
  ! Start with loop on observed visibilities
  !! Print *,'Filling Negative side '
  do i=1,nv
    u = visi(jx,i)
    v = visi(jy,i)
    !
    if (v.gt.0) then
      u = -u
      v = -v
    endif
    !
    ! Define map cell
    ix = nint(u/xinc+xref)
    iy = nint(v/yinc+yref)
    do iw=1,nw
      map (iw,ix,iy) = map (iw,ix,iy) + we(i,iw)
    enddo
    !
    ix = nint(-u/xinc+xref)
    iy = nint(-v/yinc+yref)
    if (iy.eq.my) then
	  !! Print *,'Intrinsic symmetry at MY ',my,ny,i,visi(1:2,i)
      do iw=1,nw
        map (iw,ix,iy) = map (iw,ix,iy) + we(i,iw)
      enddo
    endif
  enddo
  !! Print *,'Finished 1 side -- applying symmetry'
  !
  ! Apply symmetry
  do iy=my+1,ny
    ky = ny+2-iy
    do ix=2,nx
      kx = nx+2-ix
      do iw=1,nw
        map(iw,ix,iy) = map(iw,kx,ky)
      enddo
    enddo
  enddo
end subroutine do2fft
!
subroutine prnoise(prog,which,noise,rms)
  use gbl_message
  use imager_interfaces, only : map_message
  !--------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Printout the estimated noise value
  !!
  !--------------------------------------------------
  character(len=*), intent(in) :: prog    !! Caller name
  character(len=*), intent(in) :: which   !! Type of image
  real, intent(in) :: noise               !! Noise value
  real, intent(out) :: rms                !! Scale factor for noise
  !
  ! Local ---
  character(len=message_length) :: string
  character(len=16) :: unit
  !
  ! It comes in Jy/beam
  if (noise.gt.0.05) then
    rms = 1
    unit = ' Jy/beam'
  elseif (noise.gt.0.1e-3) then
    rms = 1e3
    unit = ' mJy/beam'
  else
    rms = 1e6
    unit = ' microJy/beam'
  endif
  write(string,'(a,a,f9.3,a)')  which,' rms noise ', rms*noise, unit
  call map_message(seve%i,prog,string)
end subroutine prnoise
!
subroutine doqfft (np,nv,visi,jx,jy,jw   &
     &    ,nx,ny,map,weight,uvcell)
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support for UV_STAT    
  !
  ! (Quick Gridding)  
  !   Compute FFT of beam by gridding UV data for Natural
  !   weighting only. Uses simple in-cell gridding for speed
  !!
  !----------------------------------------------------------------------
  integer, intent(in) :: nv                     !! number of visibilities
  integer, intent(in) :: np                     !! Size of a visibility, normally 7+3*nc
  integer, intent(in) :: nx,ny                  !! map size
  integer, intent(in) :: jx,jy,jw               !! X coord, Y coord & Weight location in VISI
  real, intent(in) :: visi(np,nv)               !! visibilities
  complex, intent(out) :: map(nx,ny)            !! gridded visibilities
  real, intent(in) :: weight(nv)                !! Weights
  real, intent(in) :: uvcell                    !! UV cell size 
  !
  ! Local ---
  integer :: ix,iy,iv,my,ky,kx
  real :: u,v
  real(8) :: xinc,xref,yinc,yref
  !
  ! Initialize
  map = 0.0
  xinc = -uvcell 
  xref = nx/2+1
  yinc =  uvcell 
  yref = ny/2+1
  my = ny/2+1
  !
  ! Start with loop on observed visibilities
  do iv=1,nv
    u = visi(jx,iv)
    v = visi(jy,iv)
    ! Make sure V is < 0
    if (v.gt.0) then
      u = -u
      v = -v
    endif
    !
    ! Define map cell
    ix = nint(u/xinc+xref)
    iy = nint(v/yinc+yref)
    map (ix,iy) = map (ix,iy) + weight(iv) 
    !
    iy = nint(-v/yinc+yref)
    if (iy.eq.my) then
      ix = nint(-u/xinc+xref)
      map (ix,iy) = map (ix,iy) + weight(iv) 
    endif
  enddo
  !
  ! Apply symmetry
  do iy=my+1,ny
    ky = ny+2-iy
    do ix=2,nx
      kx = nx+2-ix
      map(ix,iy) = map(kx,ky)
    enddo
  enddo
end subroutine doqfft
!
subroutine uv_get_cols(rname,huvin,visi,nc,mcol,wcol, fcol, freq, error)
  use image_def
  use imager_interfaces, only : map_message
  use gkernel_interfaces
  use gbl_message
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER --   Support for UV_STAT (and others if needed)
  !
  !     Find a suitable Weight channel and setup the reference frequency
  !!
  !----------------------------------------------------------------------
  character(len=*), intent(in) :: rname   !! Calling command
  type(gildas), intent(in) :: huvin       !! UV Header
  real, intent(in) :: visi(:,:)           !! UV data
  integer, intent(inout) :: mcol(2)       !! Channel range (intent OUT ?)
  integer, intent(in) :: nc               !! Number of channels
  integer, intent(in) :: wcol             !! Weight channel (0 == Automatic)
  integer, intent(out) :: fcol            !! Selected Weight channel
  real(8), intent(out) :: freq            !! Observing frequency
  logical, intent(out) :: error           !! Error flag
  !
  ! Local ---
  integer(kind=8) :: iv,nv
  integer :: lcol,icol,jcol,kcol
  real(8) :: rcol
  real(8) :: ww
  !
  ! Code ----
  nv = huvin%gil%nvisi
  error = .false.
  !
  if (mcol(1).eq.0) then
    mcol(1) = 1
  else
    mcol(1) = max(1,min(mcol(1),nc))
  endif
  if (mcol(2).eq.0) then
    mcol(2) = nc
  else
    mcol(2) = max(1,min(mcol(2),nc))
  endif
  fcol = min(mcol(1),mcol(2))
  lcol = max(mcol(1),mcol(2))
  !
  ! Compute observing sky frequency for U,V cell size
  rcol = 0.5*(fcol+lcol)
  freq = gdf_uv_frequency(huvin,rcol)
  !
  if (wcol.eq.0) then
    ! Automatic choice of Weight channel
    icol = min(max(1,mcol(1)),nc)  ! First channel
    fcol = min(mcol(2),nc)         ! Last channel
    if (fcol.eq.0) fcol = nc
    !
    jcol = (icol+fcol)/3           ! Avoid middle channel
    ! Ensure this is a valid Weight channel
    jcol = max(1,jcol)
    ww = 0 
    kcol = 7+3*jcol
    do iv=1,nv
      ww = ww+max(0.,visi(kcol,iv))
    enddo
    ! If not, scan for at least one...
    if (ww.eq.0) then
      if (nc.eq.1) then
        call map_message(seve%e,rname,'All channels are flagged')
        error = .true.
        return
      endif
      do jcol=1,nc,max(1,nc/10)
        kcol = 7+3*jcol
        do iv=1,nv
          ww = ww+max(0.,visi(kcol,iv))
        enddo
        if (ww.ne.0) exit
      enddo
      if (ww.eq.0) jcol = (icol+fcol)/2+1
      do while (ww.eq.0)
        jcol = jcol-1
        if (jcol.lt.1) exit
        kcol = 7+3*jcol
        do iv=1,nv
          ww = ww+max(0.,visi(kcol,iv))
        enddo
      enddo
      if (ww.eq.0) jcol = (icol+fcol)/2
      do while (ww.eq.0)
        jcol = jcol+1
        if (jcol.gt.nc) then
          call map_message(seve%e,rname,'All channels are flagged')
          error = .true.
          return
        endif
        kcol = 7+3*jcol
        do iv=1,nv
          ww = ww+max(0.,visi(kcol,iv))
        enddo
      enddo
    endif
    fcol = jcol
    !
  else
    ! User specified choice of Weight channel
    fcol = abs(wcol) ! WCOL negative is used to avoid examining the Dates
    fcol = min(fcol,nc)
    fcol = max(1,fcol)
    !
    ww = 0
    kcol = 7+3*fcol
    do iv=1,nv
      ww = ww+max(0.,visi(kcol,iv))
    enddo
    if (ww.eq.0) then
      call map_message(seve%e,rname,'Weight channel specified by WCOL is flagged')
      error = .true.
      return
    endif
  endif
end subroutine uv_get_cols
