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
  ! MAPPING
  !
  ! Give a brief summary of the content of an UV Table
  !-----------------------------------------------------
  type(gildas), intent(in) :: huv
  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)) ! Visbilities
  real(8), intent(in) :: freq       ! Observing frequency
  !
  character(len=14) :: ch
  logical error
  integer jt,ti,co,i,j,k
  integer(kind=index_length) :: iv
  integer count(mt)
  real bmin(mt), bmax(mt), bm, bp, 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)
  !
  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
      jt = nt
    else
      count(jt) = count(jt)+1
    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)
  !
  !
  ! A simple sort
  if (.false.) then
    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)
        co = count(j)
        bp = bmax(j)
        bm = bmin(j)
        do i = j+1,k
          tf(i-1) = tf(i)
          count(i-1) = count(i)
          bmax(i-1) = bmax(i)
          bmin(i-1) = bmin(i)
        enddo
        tf(k) = ti
        count(k) = co
        bmax(k) = bp
        bmin(k) = bm
      endif
    enddo
  endif
  !
  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      Visibilities     Minimun    & Maximum Baselines')
  call map_message(seve%r,'HEADER', &
       & '                              (m)  (kWave)    (m)    (kWave)')
  do i=1,nt
    call gag_todate(tf(i),ch,error)
    write(chain,100) ch,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,I8,3X,F7.1,1x,F7.1,2X,F8.1,1X,F7.1)
end subroutine uv_listheader
!
subroutine uniform_beam (map_name,uv_taper,map_size,map_cell,   &
        &    uniform,wcol,mcol,work,error,mode,                 &
        &    beams,mbeam,start,step,uvmax,result,huv,duv)
  use imager_interfaces, except_this=>uniform_beam
  use gildas_def
  use image_def
  use gbl_message
  use gkernel_interfaces
  !------------------------------------------------------------------------
  ! @ public
  !
  ! MAPPING
  !   UV_STAT Compute a map from a CLIC UV Sorted Table
  !   by Gridding and Fast Fourier Transform, with
  !   one single beam for all channels.
  !
  ! Input :
  ! a precessed UV table, sorted in V, ordered in
  ! (U,V,W,D,T,iant,jant,nchan(real,imag,weig))
  ! Output :
  ! a beam image
  ! a VLM cube
  ! Work space :
  ! a  VLM complex Fourier cube (first V value is for beam)
  !------------------------------------------------------------------------
  type(gildas), intent(in) :: huv               ! UV Table Header
  real, intent(inout) :: duv(:,:)               ! Visibility Array
  character(len=*), intent(in) :: map_name      ! Name of image (void)
  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
  real :: work(*)                   ! Work array
  logical :: error                  ! Error flag
  real, intent(out) :: beams(map_size(1),map_size(2),mbeam)
  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(10,8) ! Resulting beam characteristics
  !
  ! Global variables:
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  real ubias,vbias,ubuff(4096),vbuff(4096)
  common /conv/ ubias,vbias,ubuff,vbuff
  !
  real(8), parameter :: clight=299792458d-6  ! Frequency in MHz
  !
  integer ctype               ! Convolution mode, local value
  real(8) freq,rcol,convert(6)
  integer nx,ny,nc,nv,nd,lx,ly,nu
  integer ctypx,ctypy,lcol,fcol
  real uv_cell(2)
  real xparm(10),yparm(10),support(2)
  real vref,voff,vinc,lambda
  integer ndim, nn(2), i
  real, allocatable :: ipxc(:), ipyc(:)
  real, allocatable :: ipw(:,:), ipv(:), ipg(:)
  complex, allocatable :: ipf(:)
  complex, allocatable :: ipft(:)
  integer :: ier
  !
  integer, parameter :: nuni=10
  real wnat, noise, mn
  integer ix_patch, iy_patch, icol, ib
  real(4) major_axis(nuni), minor_axis(nuni), pos_angle(nuni),knoise(nuni)
  real(4) sidelobe(2,nuni),utaper(nuni), unif(nuni),wuni(nuni)
  real(4) sec,zero(3),thre,rms,rmk,vmax
  character(len=8) chain(nuni)
  character(len=32) unit
  character(len=10) jyunit
  character(len=16) kunit
  character(len=message_length) string
  character(len=7) :: rname = 'UV_STAT'
  !
  real cpu0,cpu1,pixel_per_beam,bmax
  !
  data zero/3*0/
  data pixel_per_beam /2.0/
  !------------------------------------------------------------------------
  call gag_cpu(cpu0)
  xparm(1:10) = 0
  yparm(1:10) = 0
  !
  if (mode.eq.'TAPER') then
    if (step.eq.0.0) step = sqrt(2.0)
    if (start.eq.0.0) start = 50.0
  elseif (mode.eq.'WEIGHT') then
    if (step.eq.0.0) step = 10.0**0.25
    if (start.eq.0.0) start = 1.0/step**4
  elseif (mode.eq.'CELL' ) then
    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    
  elseif (mode.eq.'BRIGGS') then
    continue
  else
    string = 'Unsupported mode '//mode
    call map_message(seve%e,rname,string)
    error = .true.
    return
  endif
  !
  ! Code:
  nx = map_size(1)
  ny = map_size(2)
  nd = nx*ny
  nu = huv%gil%dim(1)
  nv = huv%gil%nvisi   !! NOT huv%gil%dim(2)
  !
  ! This must be a patch for some old stuff
  if (huv%gil%dim(1).ne.3) then
    ! nc = (huv%gil%dim(1)-7)/3
    nc = huv%gil%nchan
  else
    nc = 1
  endif
  write(string,100) 'Found ',nv,' visibilities, ',nc,' channels'
  call map_message(seve%i,rname,string)
  if (nv.eq.0) return ! Just in case
  !
  ! Get work space at once, for memory contiguity reasons.
  !
  allocate (ipxc(nx),ipyc(ny),ipw(nv,nuni),ipv(nv),ipg(nd),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation failure')
    error = .true.
    return
  endif
  !
  vref = huv%gil%convert(1,1)
  voff = huv%gil%voff
  vinc = huv%gil%vres
  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(huv,rcol)
  !
  if (wcol.lt.0) then
    ! WCOL negative is used to avoid examining the Dates 
    fcol = -wcol
  else if (wcol.eq.0) then
    icol = min(max(1,mcol(1)),nc)  ! First channel
    fcol = min(mcol(2),nc)
    if (fcol.eq.0) fcol = nc
    fcol = (icol+fcol)/3           ! Avoid middle channel
  else
    fcol = wcol
  endif
  fcol = min(fcol,nc)
  fcol = max(1,fcol)
  icol = fcol*3+7
  !
  ! 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, ubuff, ubias)
  call convfn (ctypy, yparm, vbuff, 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,duv,4,5)
  if ( (mode.ne.'TAPER') .or.   &
     &    (uniform(2).gt.0.and.uniform(1).gt.0) ) then
    !
    ! Safety belt & Airbag...
    vmax = duv(2,1)
    do i=1,nv
      if (duv(2,i).lt.vmax) then
        call map_message(seve%f,rname,'Programming error, UV data not sorted')
        error = .true.
        return
      endif
      vmax = duv(2,i)
    enddo
  endif
  !
  ! Load V values
  ! Here, we will ignore the output in IPW,
  ! so we can use ICOL even if wrong, but ICOL is used later
  call dovisi (nu,nv,duv,ipv,ipw, icol)
  call gag_cpu(cpu1)
  write(string,102) 'Start Weighting ',cpu1-cpu0
  call map_message(seve%i,rname,string)
  !
  ! Compute weights
  if (mode.eq.'TAPER') then
    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,  &
     &      duv,          &    ! 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,  &
     &      ipv)
  elseif (mode.eq.'WEIGHT') then
    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,  &
     &      duv,          &    ! 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,  &
     &      ipv)
  elseif (mode.eq.'BRIGGS') then
    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,  &
     &      duv,          &    ! 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,  &
     &      ipv)
  elseif (mode.eq.'CELL') then
    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,  &
     &      duv,          &    ! Visibilities
     &      1,2,          &    ! U, V pointers
     &      icol,         &    ! Weight channel
     &      unif,         &    ! Uniform UV cell size
     &      ipw,          &    ! Weight array
     &      wuni,nuni,    &    ! Fraction of weight
     &      utaper,wnat,  &
     &      ipv)
  endif
  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 (ipf(nd),ipft(lx*ly*nuni),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
     &    duv,          &      ! 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 Weighting ',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)
  !
  convert = (/dble(nx/2+1),0.d0,-dble(map_cell(1)),   &
     &    dble(ny/2+1),0.d0,dble(map_cell(2))/)
  !
  ! Compute grid correction,
  ! Normalization factor is applied to grid correction, for further
  ! use on channel maps. Use IPF and IPF+NX for work space.
  !
!  call grdtab (ny, vbuff, vbias, ipxc)
!  call grdtab (nx, ubuff, ubias, ipyc)
  !
  ! Loop on Uniform parameters
  ipw(:,:) = max(0.0,ipw) ! Flagged data have negative weights
  !
  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,work)
    call cmtore (ipf,beams(1,1,ib),nx,ny)
!    call dogrid (ipg,ipxc,ipyc,nx,ny,beams(1,1,ib))
    !
    ! Normalize and Free beam
!    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.
    call fibeam (' ',beams(1,1,ib),nx,ny,   &
     &      ix_patch,iy_patch,thre,   &
     &      major_axis(i),minor_axis(i),pos_angle(i),   &
     &      convert,error)
    !
    ! Subtract main beam
    call sidelo (beams(1,1,ib),nx,ny,sidelobe(1,i),   &
     &      major_axis(i),minor_axis(i),pos_angle(i),   &
     &      convert)
    !
  enddo
  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 dsensitivity
  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 = sqrt(1.0/wuni)*lambda**2*4*log(2.0)*1e-3/ &
     &      (2.0*1.38e3*major_axis*minor_axis*pi)
  rmk = sqrt(minval(knoise)*maxval(knoise))
  !
  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),106) 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'
    do i=2,nuni
      write(chain(i),106) unif(i)
    enddo
  elseif  (mode.eq.'WEIGHT') then
    call gagout('Robust      Major    Minor     PA            Noise      Sidelobe')
    call gagout('              (")      (")     (deg)    '//unit)
    do i=1,nuni-1
      write(chain(i),106) unif(i)
    enddo
    chain(nuni) = '  None'
  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'
  endif
  !
  do i=1,nuni
    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(i,1) = unif(i)
    result(i,2) = major_axis(i)*sec
    result(i,3) = minor_axis(i)*sec
    result(i,4) = pos_angle(i)
    result(i,5) = sqrt(1.0/wuni(i))*1e-3
    result(i,6) = knoise(i)
    result(i,7) = sidelobe(1,i)*100.0
    result(i,8) = sidelobe(2,i)*100.0
  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
  !
  100   format(a,i10,a,i5,a)
  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(f7.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,vv)
  use gildas_def
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, except_this => do2weig
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Compute weights of the visibility points.
  !   Explore here the robust parameters.
  !----------------------------------------------------------------------
  integer, intent(in) :: nv  ! Size of a visibility
  integer, intent(in) :: jc  ! 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)
  real, intent(in) :: vv(nv)       ! V values
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  character(len=*), parameter :: rname='DO2WEIG'
  !
  integer i,kw
  real u,v,weight,wmax,wmin
  real cx,sx,cy,sy,staper
  real ss(10),s2(10),ww,st,u2
  logical do_taper, briggs
  real umin,umax,vmin,vmax
  real wfact
  integer nbcv,  nbv
  !
  ! 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
  vmin = visi(jy,1)
  vmax = visi(jy,nv)
  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
  enddo
  !
  call do0weig (jc,nv,visi,jx,jy,iw,unif,we(1,nw),vv,nbv, &
      &   umin,umax,vmin,vmax,nbcv)
  !
  ! Define robustness - generic
  weight = 0.0
  wmax = 0.0
  wmin = 1.e36  
  do i=1,nv
    if (we(i,nw).gt.0.0) then
      wmin = min(we(i,nw),wmin)
      wmax = max(we(i,nw),wmax)
      weight = weight+we(i,nw)
    endif
  enddo
  weight = weight/nv
  wfact = sqrt(wmin*wmax)
  do kw = 1,nw-1
    !    wm(kw) = wm(kw)*sqrt(wmin*wmax)
  enddo
  !
  ! Apply robustness
  do kw=1,nw-1
    ss(kw) = 0.0
    s2(kw) = 0.0
  enddo
  ss(nw) = 1.0
  s2(nw) = 1.0
  !
  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,nw) = 0.0
    else
      we(i,nw) = staper*visi(iw,i)
    endif
    !
    ! Compute the new weights 
    if (briggs) then
      ! Briggs way
      do kw=1,nw-1
        ! s = 5*10^(-Briggs)  with (typically) -2 < Briggs < 2
        ! Here we use an input range [-4,0] so shift by 2
        u2  = 5*10**(-(2+wm(kw)))    ! s
        u2 = u2*u2                   ! s^2
        !
        if (ww.gt.0) then
          st = staper/(u2*ww/wfact+1.0)
          we(i,kw) = visi(iw,i)*st
          ss(kw) = ss(kw) + we(i,kw)
          s2(kw) = s2(kw) + we(i,kw)*st
        else
          we(i,kw) = 0.0
        endif
      enddo
    else
      ! GILDAS way
      do kw=1,nw-1
        !! if (ww.gt.wm(kw)) then
        if (ww.gt.wm(kw)*wfact) then
          st = staper/ww*wm(kw)*wfact
          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
    endif
  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 do2weig
!
function minimum(n,a)
  integer n,i
  real a(*)
  real minimum
  !
  minimum = a(1)
  do i=2,n
    minimum = min(minimum,a(i))
  enddo
end function minimum
!
subroutine do3weig (jc,nv,visi,jx,jy,iw,cunif,we,cwm,nw,taper,s,vv)
  use gildas_def
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, except_this => do3weig
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Compute weights of the visibility points.
  !   TAPER mode
  !----------------------------------------------------------------------
  integer, intent(in) :: nv  ! Size of a visibility
  integer, intent(in) :: jc  ! 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)
  real, intent(in) :: vv(nv)       ! V values
  !
  character(len=*), parameter :: rname='DO3WEIG'
  integer i,kw
  real u,v,weight,wmax,wmin
  real staper
  real ss(10),s2(10),ww,st
  !
  real umin,umax,vmin,vmax,vstep,vimin,vimax
  real vcmin, vcmax,unif,wm
  integer nbcv, ivmin, ivmax, icv, nbv, new
  character(len=message_length) :: chain
  !
  ! 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
    !
    ! 1) Compute VMIN, VMAX, UMIN, UMAX
    vmin = visi(jy,1)
    vmax = visi(jy,nv)
    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
    enddo
    !
    ! Symmetry ?...
    if (-umin.gt.umax) then
      umax = -umin
    else
      umin = -umax
    endif
    vmin = 1.001*vmin          ! Allow small margin
    umax = 1.001*umax
    umin = 1.001*umin
    !
    ! Some speed up factor
    nbcv = 8
    vstep = -vmin/nbcv
    !
    ! Adjust the number of cells. A cell must be > 2*UNIF, and > 4*UNIF is more
    ! than sufficient to get speed up.
    !
    if (vstep.lt.4*unif) then
      nbcv = -vmin/(4*unif)
      if (mod(nbcv,2).ne.0) nbcv = nbcv-1
      if (nbcv.eq.0) nbcv = 1
      vstep = -vmin/nbcv
    endif
    write(chain,'(A,I2,A)') 'Using ',nbcv,' sub-grids'
    call map_message(seve%i,rname,chain)
    !
    ! Loop on U,V cells
    nbv = 0
    ivmin = 1
    do icv = 1,nbcv
      vcmin = (icv-1)*vstep+vmin
      vimin = vcmin-unif
      vcmax = icv*vstep+vmin
      vimax = vcmax+unif
      call findp (nv,vv,vimin,ivmin)
      ivmax = ivmin
      call findp (nv,vv,vimax,ivmax)
      ivmax = min(nv,ivmax+1)
      new = ivmax-ivmin+1
      if (icv.eq.nbcv) then
        vimin = -unif
        call findp (nv,vv,vimin,ivmin)
        new = new + (nv-ivmin+1)
      endif
      nbv = max(new,nbv)
    enddo
    !
    call do0weig (jc,nv,visi,jx,jy,iw,unif,we(1,nw),vv,nbv,   &
      &      umin,umax,vmin,vmax,nbcv)
    !
    ! Define robustness
    weight = 0.0
    wmax = 0.0
    wmin = 1.e36
    do i=1,nv
      if (we(i,nw).gt.0.0) then
        wmin = min(we(i,nw),wmin)
        wmax = max(we(i,nw),wmax)
        weight = weight+we(i,nw)
      endif
    enddo
    weight = weight/nv
    weight = wm*sqrt(wmin*wmax)
  else
    do i=1,nv
      weight = max(weight,we(i,nw))
    enddo
  endif
  !
  ! Apply robustness
  do kw=1,nw
    ss(kw) = 0.0
    s2(kw) = 0.0
  enddo
  !
  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
  !-----------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   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)
  !
  character(len=*), parameter :: rname='DODATE'
  character(len=78) ch
  logical error
  integer maxt,nt
  parameter (maxt=100)
  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,vv)
  use gkernel_interfaces
  use gbl_message
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Support for UV_STAT
  !   Compute weights of the visibility points.
  !   CELL mode
  !----------------------------------------------------------------------
  integer, intent(in) :: nv  ! Size of a visibility
  integer, intent(in) :: jc  ! 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)
  real, intent(in) :: vv(nv)       ! Sorted V<0 values
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  character(len=*), parameter :: rname='DO4WEIG'
  integer i,kw,jold
  real u,v,wmax,wmin
  real cx,sx,cy,sy,staper
  real ss(10),s2(10),ww,st
  real :: cpu1,cpu0,dcpu,cpul
  !
  real, allocatable :: suu(:), svv(:), sww(:), swe(:), wt(:)
  real :: umin, umax, vmin, vmax
  real :: sizecell
  integer :: ier, mv, nbv, ivmin, icode
  integer :: kcode(10)
  logical :: error
  character(len=64) :: string
  !
  ! Natural weights & Compute VMIN, VMAX, UMIN, UMAX
  vmin = visi(jy,1)
  vmax = visi(jy,nv)
  umin = 0.0
  umax = 0.0
  !
  call gag_cpu(cpu0)
  s = 0.
  do i=1,nv
    if (visi(iw,i).gt.0.0) then
      we(i,1) = visi(iw,i)
      if (visi(jx,i).lt.umin) then
        umin = visi(jx,i)
      elseif  (visi(jx,i).gt.umax) then
        umax = visi(jx,i)
      endif
    else
      we(i,1) = 0.0
    endif
    s = s+we(i,1)
  enddo
  if (s.eq.0) return
  !
  ! 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
  !
  ! Find the location of -unif
  ivmin = 1
  call findp (nv,vv,-unif,ivmin)
  !
  mv = 2*nv-ivmin+1
  allocate(suu(mv),svv(mv),sww(mv),swe(mv),stat=ier)
  !
  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)
  !
  kcode    = 15  ! A reasonable value in most cases, except the large cells
  kcode(8) = 22
  kcode(9) = 30
  kcode(10)= 40
  !
  cpul = cpu0
  do kw=nw,2,-1
    call dowei_icode(umax,umin,vmax,vmin,unif(kw),mv,icode)
    sizecell = unif(kw)/icode
    call gridless_density(nbv,sizecell,unif(kw),suu,svv,sww,swe, &
    &  umin,umax,vmin,unif(kw),error)
    if (error) return
    !
    we(:,kw) = swe(1:nv) * wt(1:nv)  ! Apply taper
    call gag_cpu(cpu1)
    dcpu = cpu1-cpul
    if (dcpu.gt.2) then
      write(string,'(A,I2,F9.3,A)') 'Finished weighting # ',kw,cpu1-cpu0
      call map_message(seve%i,rname,string)
      cpul = cpu1
    endif
  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
  !
  ! MAPPING
  !   Compute sidelobes
  !------------------------------------------------------------
  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)        ! Pos and Neg sidelobe
  real(8), intent(in) :: convert(3,2) ! Conversion formula
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  real pang,oang,ca,sa,ma,mi,xs,ys,d,g,sln2
  integer i,j
  !
  sln2 = 2.0*sqrt(log(2.0))
  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,vv,   &
     &    lv,umin,umax,vmin,vmax,nbcv)
  use gkernel_interfaces
  use gildas_def
  use gbl_message
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Support for UV_STAT
  !   Compute weights of the visibility points.
  !----------------------------------------------------------------------
  integer, intent(in) :: nv  ! Size of a visibility
  integer, intent(in) :: jc  ! 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
  real, intent(in) :: vv(nv)       ! V values
  !
  integer, intent(in) :: lv        ! Unused
  real, intent(in) ::  umin,umax,vmin,vmax
  integer, intent(in) :: nbcv       ! Unused here
  !
  real, allocatable :: suu(:), svv(:), sww(:), swe(:)
  real :: sizecell
  integer :: ier, mv, nbv, i, ivmin, icode
  character(len=*), parameter :: rname='DO0WEIG'
  !
  logical :: error
  !
  ! Find the location of -unif
  ivmin = 1
  call findp (nv,vv,-unif,ivmin)
  !
  mv = 2*nv-ivmin+1
  allocate(suu(mv),svv(mv),sww(mv),swe(mv),stat=ier)
  !
  suu(1:nv) = visi(jx,:)
  svv(1:nv) = visi(jy,:)
  sww(1:nv) = visi(jw,:)
  !
  ! Apply symmetry
  nbv = nv
  do i=ivmin,nv
    nbv = nbv+1
    suu(nbv) = -visi(jx,i)
    svv(nbv) = -visi(jy,i)
    sww(nbv) = visi(jw,i)
  enddo
  !
  call dowei_icode(umax,umin,vmax,vmin,unif,mv,icode)
  sizecell = unif/icode
  call gridless_density(mv,sizecell,unif,suu,svv,sww,swe, &
    umin,umax,vmin,unif,error)
  if (error) return
  !
  we(:) = swe(1:nv)
end subroutine do0weig
!
subroutine do2fft (np,nv,visi,jx,jy   &
     &    ,nx,ny,nw,map,mapx,mapy,we) 
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Support for UV_STAT
  !   Compute FFT of image by gridding UV data for several weights
  !   at once. Uses simple in-cell gridding
  !
  ! Input UV data must be sorted by increasing V < 0
  !----------------------------------------------------------------------
  ! Call
  integer, intent(in) :: nv                   ! number of values
  integer, intent(in) :: np                   ! Number of "visibilities", 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)             ! values
  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
  !
  ! Initialize
  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
  !
  ! the UV data is such that all V are negative...
  !
  ! Start with loop on observed visibilities
  do i=1,nv
    u = visi(jx,i)
    v = visi(jy,i)
    !
    ! 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
      do iw=1,nw
        map (iw,ix,iy) = map (iw,ix,iy) + we(i,iw)
      enddo
    endif
  enddo
  !
  ! 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
  !
  ! MAPPING
  !   Printout the 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              ! Unit of noise
  !
  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 is ', 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
  !
  ! MAPPING
  !   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
  !----------------------------------------------------------------------
  ! Call
  integer, intent(in) :: nv                   ! number of values
  integer, intent(in) :: np                   ! Number of "visibilities", 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)             ! values
  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
