subroutine dowfact(nv,we,wfact)
  use gildas_def
  use grid_control
  use gkernel_interfaces, only : gr4_median
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- UV_MAP Weight handling routine
  !
  !   Compute renormalisation factor WFACT for Robust Weighting
  !
  !---------------------------------------------------------------------
  integer , intent(in) :: nv      !! Number of visibilities
  real, intent(inout)  :: we(nv)  !! Weights
  real, intent(out) :: wfact      !! Normalisation factor
  !
  ! Local ---
  integer(kind=index_length) :: nv8
  integer :: i, mv
  real :: weight, wmin, wmax, wmed, winf
  logical :: error
  !
  ! Code ----
  weight = 0.0
  wmax = 0.0
  wmin = 1.e36  
  mv = 0
  do i=1,nv
    if (we(i).gt.0.0) then
      wmin = min(we(i),wmin)
      wmax = max(we(i),wmax)
      weight = weight+we(i)
      mv = mv+1
    else if (we(i).lt.0) then
      print *,'Non null ',i     ! This should not occur
      we(i) = 0
    endif
  enddo
  !
  if (grid_weighting.eq.0) then
    ! Historical Min based estimate
    winf = wmin
  else if (grid_weighting.lt.0) then
    ! Mean based estimate
    weight = weight/mv ! Mean weight, but avoiding Flagged visibilities
    winf = weight / sqrt(wmax/weight) 
  else if (grid_weighting.gt.0) then
    ! Median based estimate
    error = .false.
    nv8 = nv
    !Print *,MV,' valid visibilities, ',nv-mv,' flagged'
    call gr4_median(we,nv8,0.0,0.0,wmed,error) 
    winf = wmed / sqrt(wmax/wmed) 
  endif
  wfact = sqrt(winf*wmax)
end subroutine dowfact
!
subroutine dogrid_smooth (nx,ny,mapn,maps,unif)!
  !$ use omp_lib
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER  -- UV_MAP Weight handling routine
  !
  !   Smooth the natural weights to get the local weight density.
  !!
  !----------------------------------------------------------------------
  integer, intent(in) :: nx         !! X size
  integer, intent(in) :: ny         !! Y size
  real, intent(in)  :: mapn(nx,ny)  !! Initial weights
  real, intent(out) :: maps(nx,ny)  !! Smoothed weights
  real, intent(in) :: unif          !! Smoothing length, in pixel units
  !
  ! Local ---
  integer :: ix,iy, ixl, ixu, iyl, iyu, ir, jx, jy
  real(4) :: r2, u2
  !
  ! Code ----
  maps = 0
  u2 = unif**2
  !
  ir = int(unif/2)+1
  ixl = int(unif/2)+2
  ixu = int(nx-unif/2)-1
  iyl = ixl
  iyu = int(ny-unif/2)-1
  !
  ! This region is guaranteed to be smoothable
  !$OMP PARALLEL DEFAULT(NONE) &
  !$OMP & SHARED  (ixl,ixu,iyl,iyu,ir,u2, maps, mapn) &
  !$OMP & PRIVATE (ix,iy,jx,jy,r2)
  !$OMP DO COLLAPSE(2)
  do iy=iyl,iyu
    do ix=ixl,ixu
      !
      maps(ix,iy) = 0.0
      do jy=iy-ir,iy+ir
        do jx=ix-ir,ix+ir
          r2 = (jx-ix)**2 + (iy-jy)**2
          if (r2.le.u2) maps(ix,iy) = maps(ix,iy) + mapn(jx,jy)
        enddo
      enddo
    enddo
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
end subroutine dogrid_smooth
!
subroutine doweig_robust(jc,nv,visi,jw,we,wm)
  use imager_interfaces, only : map_message
  use gbl_message
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER  -- UV_MAP Weight handling routine
  !
  !   Correct the weights from the local density according to the
  !   Robustness factor.
  !!
  !----------------------------------------------------------------------
  integer, intent(in) :: jc        !! Size of a visibility
  integer, intent(in) :: nv        !! Number of visibilities
  real, intent(in) :: visi(jc,nv)  !! Visibilities
  integer, intent(in) :: jw        !! Weight column
  real, intent(inout) :: we(nv)    !! Weights
  real, intent(in) :: wm           !! Robust factor
  !
  character(len=*), parameter :: rname='DOWEIG'
  !
  ! Local ---
  real(4) :: weight, s2
  integer :: i
  !
  ! Code ----
  call dowfact(nv,we,weight)
  !
  if (wm.lt.0) then
    !
    ! Briggs solution
    ! s = 5*10^(-Briggs)  with (typically) -2 < Briggs < 2
    ! Here we use an input range [-4,0] for "wm" so shift "wm" by 2
    !
    ! Experimentally, not as flexible as our default solution
    s2 = 5*10**(-2-wm)    ! s^2
    s2 = s2*s2
    !$OMP PARALLEL DEFAULT(NONE) &
    !$OMP & SHARED  (visi, we, jw,weight,s2,nv)  &
    !$OMP & PRIVATE (i)
    !$OMP DO
    do i=1,nv
      if (visi(jw,i).gt.0) then
        we(i) = visi(jw,i)/(s2*we(i)/weight+1.0)
      else
        we(i) = 0.0
      endif
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
  else
    !
    ! S.Guilloteau solution
    weight = wm*weight
    !$OMP PARALLEL DEFAULT(NONE) &
    !$OMP & SHARED  (visi, we, jw,weight,nv)  &
    !$OMP & PRIVATE (i)
    !$OMP DO
    do i=1,nv
      if (visi(jw,i).gt.0.0) then
        if (we(i).gt.weight) then
          we(i) = visi(jw,i)/we(i)*weight
        else
          we(i) = visi(jw,i)
        endif
      else
        we(i) = 0.0
      endif
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
  endif
  !
end subroutine doweig_robust
!
subroutine dogrid_fast (np,nv,visi,jx,jy   &
     &    ,nx,ny,map,mapx,mapy,we)
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER  -- UV_MAP Weight handling routine
  !
  !   Grid the weights. Do not apply taper. 
  !   Only for "visibility in cell" gridding.
  !   Uses symmetry
  !----------------------------------------------------------------------
  integer, intent(in) :: nv                   !! Number of visibilies
  integer, intent(in) :: np                   !! Size of a visibility 
  real, intent(in) :: visi(np,nv)             !! values
  integer, intent(in) :: jx                   !! X coord location in VISI
  integer, intent(in) :: jy                   !! Y coord location in VISI
  integer, intent(in) :: nx                   !! X map size
  integer, intent(in) :: ny                   !! Y map size
  real, intent(out) :: map(nx,ny)             !! gridded visibilities
  real, intent(in) :: mapx(nx)                !! X Coordinates of grid
  real, intent(in) :: mapy(ny)                !! Y Coordinates of grid
  real, intent(in) :: we(nv)                  !! Weight array
  !
  ! Constants
  real(8), parameter :: pi=3.141592653589793d0
  !
  ! Local ---
  integer :: ix,iy,i,my,kx,ky
  real :: result,resima
  real :: u,v
  real(8) :: xinc,xref,yinc,yref
  !
  ! Code ----
  my = ny/2+1
  !
  xinc = mapx(2)-mapx(1)
  xref = nx/2+1
  yinc = mapy(2)-mapy(1)
  yref = ny/2+1
  !
  ! Start with loop on observed visibilities.
  ! Loop cannot be efficiently parallelized, as different visibilities
  ! may end up in the same pixel.
  do i=1,nv
    !
    ! Weight 
    result = we(i)
    if (result.le.0) cycle ! Skipped flagged visibilities
    !
    u = visi(jx,i)
    v = visi(jy,i)
    ! Define map cell
    if (v.gt.0) then
      ix = nint(-u/xinc+xref)
      iy = nint(-v/yinc+yref)
      resima = -result
    else
      ix = nint(u/xinc+xref)
      iy = nint(v/yinc+yref)
      resima = result
    endif
    if (ix.lt.1.or.ix.gt.nx.or.iy.lt.1.or.iy.gt.my) then
      print *,'Visi ',i,' pixels ',ix,iy,my,v
    else
      map (ix,iy) = map(ix,iy) + result
    endif
    !
    iy = nint(-v/yinc+yref)
    if (iy.eq.my) then
      ix = nint(-u/xinc+xref)
      map (ix,iy) = map(ix,iy) + result
    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)  ! Beam
    enddo
  enddo
  !
  ! Missing row is left empty (assume proper coverage of the UV plane)
  do iy = 1,ny
    if (map(1,iy).ne.0) then
      print *,'Invalid beam ',iy
    endif
  enddo
end subroutine dogrid_fast
!
subroutine doweig_grid (jc,nv,visi,jx,jy,jw,unif,we,error,code)
  use gildas_def
  use gkernel_interfaces
  use grid_control
  use imager_interfaces, except_this => doweig_grid
  use gbl_message
  !----------------------------------------------------------------------
  ! @ public
  !*
  ! IMAGER -- UV_MAP Weight handling routine
  !
  !     Compute weights of the visibility points.
  !      Pure Gridded method
  !
  !   Pass 1:   Natural Gridding of the weights  
  !   Pass 2:   Smoothing of the Grid   
  !   Pass 3:   Correction of initial weights by Smoothed values
  !!
  !----------------------------------------------------------------------
  integer, intent(in) ::  nv          !! number of visibilities
  integer, intent(in) ::  jc          !! Size of a visibilities
  integer, intent(in) ::  jx          !! X coord location in VISI
  integer, intent(in) ::  jy          !! Y coord location in VISI
  integer, intent(in) ::  jw          !! Location of weights. If .LE.0, uniform weight
  real, intent(in) ::  visi(jc,nv)    !! Visibilities
  real, intent(in) ::  unif           !! uniform cell size in Meters
  real, intent(inout) ::  we(nv)      !! Weight array
  logical, intent(inout) :: error     !! Error code
  integer, intent(in), optional :: code  !! Number of sub-cells per UV uniform cell size
  !
  character(len=*), parameter :: rname='DOWEIG'
  !
  ! Local ---
  real, allocatable :: w_mapu(:), w_mapv(:), mapn(:,:), maps(:,:)
  real :: umin, umax, vmin, vmax
  real :: sizecell, punif
  integer :: ier, i
  integer :: nx,ny,kw
  !
  ! Code 
  error = .true.
  call imager_tree('DOWEIG_GRID',.false.)
  !
  ! Step 1: define Grid extent
  ! Assume data is unsorted in U.
  vmin = 0.0
  vmax = 0.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 (-umin.gt.umax) then
    umax = -umin
  else
    umin = -umax
  endif
  if (-vmin.gt.vmax) then
    vmax = -vmin
  else
    vmin = -vmax
  endif
  vmax = 1.1*vmax            ! Allow safe margin
  umax = 1.1*umax
  !
  ! Define a cell size sufficiently smaller than the Uniform cell size
   sizecell  = unif/grid_subcell
  !
  ! Define the Grid now
  nx = 2*umax/sizecell
  ny = 2*vmax/sizecell
  !
  ! 2)  Grid with Natural weighting
  allocate (w_mapu(nx), w_mapv(ny), mapn(nx,ny), maps(nx,ny), stat=ier)
  if (ier.ne.0) return
  !
  error = .false.
  call docoor (nx,-sizecell,w_mapu)
  call docoor (ny,sizecell,w_mapv)
  kw = jw
  we(:) = visi(kw,:)
  !
  write(*,'(A,I0,A,I0,A)',advance='NO') 'Doing Fast gridding (',nx,',',ny,') ... '
  mapn = 0.
  call dogrid_fast (jc,nv,visi,jx,jy,nx,ny,mapn,w_mapu,w_mapv,we) 
  !
  ! 3) Smooth the Weights by Circles
  punif = unif/sizecell ! In pixel units
  write(*,'(A)',advance='NO') ' Smoothing ... '
  call dogrid_smooth (nx,ny,mapn,maps,punif)
  !
  ! 4) Assign a summed weight to each visbility
  write(*,'(A)',advance='NO') ' Summing... '
  call doweig_getsum (jc,nv,visi,jx,jy,nx,ny,w_mapu,w_mapv,maps,we)
  write(*,'(A)') ' Done'
  call imager_tree('DOWEIG_GRID',.true.)
  !
end subroutine doweig_grid
!
subroutine doweig_getsum (jc,nv,visi,jx,jy,nx,ny,w_mapu,w_mapv,maps,we)
  ! @ private
  integer, intent(in) ::  nv          !! number of visibilities
  integer, intent(in) ::  jc          !! Size of a visibilities
  integer, intent(in) ::  jx          !! X coord location in VISI
  integer, intent(in) ::  jy          !! Y coord location in VISI
  integer, intent(in) ::  nx          !! Grid size in X
  integer, intent(in) ::  ny          !! Grid size in Y
  real, intent(in) ::  visi(jc,nv)    !! Visibilities
  real, intent(in) :: w_mapu(nx)      !! X coordinates
  real, intent(in) :: w_mapv(ny)      !! Y coordinates
  real, intent(in) :: maps(nx,ny)     !! Smoothed gridded weights
  real, intent(inout) ::  we(nv)      !! Weight array
  !
  ! Local ---
  integer :: iu,iv
  integer :: jv
  real :: xinc,xref,yinc,yref,u,v
  real :: aplus, amoin, azero, afin, xr, yr
  !
  ! Code ----
  xref = nx/2+1
  yref = ny/2+1
  xinc = w_mapu(2)-w_mapu(1)
  yinc = w_mapv(2)-w_mapv(1)
  !
  !$OMP PARALLEL DEFAULT(NONE) &
  !$OMP & SHARED(nv, we, visi, maps, xinc,xref, yinc,yref, jx,jy, nx,ny) &
  !$OMP & PRIVATE(jv, u,v,iu,iv,xr,yr,aplus,amoin,azero,afin)
  !$OMP DO
  do jv=1,nv
    if (we(jv).le.0) then
      we(jv) = 0.
      cycle          ! Ignore flagged visibilities 
    endif
    !
    we(jv) = 0. ! In case of bad call, protect.
    !
    u = visi(jx,jv)
    u = u/xinc+xref
    iu = int(u)
    if (iu.le.1 .or. iu.ge.nx) cycle
    v = visi(jy,jv)
    v = v/yinc+yref
    iv = int(v)
    if (iv.le.1 .or. iv.ge.ny) cycle
    !
    ! Interpolate weight from Neighbours.
    xr = u-iu
    yr = v-iv
    !
    ! Bi-parabolic interpolation
    ! Interpolate (X or Y first, does not matter in this case)
    aplus = ( (maps(iu+1,iv+1)+maps(iu-1,iv+1)   &
   &          - 2.d0*maps(iu,iv+1) )*xr   &
   &          + maps(iu+1,iv+1)-maps(iu-1,iv+1) )*xr*0.5d0   &
   &          + maps(iu,iv+1)
      azero = ( (maps(iu+1,iv)+maps(iu-1,iv)   &
   &          - 2.d0*maps(iu,iv) )*xr   &
   &          + maps(iu+1,iv)-maps(iu-1,iv) )*xr*0.5d0   &
   &          + maps(iu,iv)
      amoin = ( (maps(iu+1,iv-1)+maps(iu-1,iv-1)   &
   &          - 2.d0*maps(iu,iv-1) )*xr   &
   &          + maps(iu+1,iv-1)-maps(iu-1,iv-1) )*xr*0.5d0   &
   &          + maps(iu,iv-1)
    ! Then Y (or X)
    afin = ( (aplus+amoin-2.d0*azero)   &
   &          *yr + aplus-amoin )*yr*0.5d0 + azero
    !
    ! Bi-parabolic interpolation may lead to negative results, 
    !   despite all data being positive 
    if (afin.lt.0) then
      !
      ! Bi-linear does not have this issue
      aplus = maps(iu+1,iv+1)*xr + maps(iu,iv+1)*(1.0-xr)
      amoin = maps(iu+1,iv)*xr + maps(iu,iv)*(1.0-xr)
      afin = aplus*yr + amoin*(1.0-yr)
    endif
    if (afin.le.0) then 
      Print *,jv,' Interpolation issue ',amoin,azero,aplus,afin,yr
      afin = maps(iu,iv)
    endif
    we(jv) = afin
    !
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
end subroutine doweig_getsum
!
subroutine dotape (jc,nv,visi,jx,jy,taper,we)
  use gildas_def
  !----------------------------------------------------------------------
  ! @ public
  !*
  ! IMAGER -- UV_MAP Weight handling routine
  !
  !     Apply taper to the weights of the visibility points.
  !!
  !----------------------------------------------------------------------
  integer, intent(in) :: nv          !! number of values
  integer, intent(in) :: jc          !! Size of a visibility
  integer, intent(in) :: jx          !! X coord location in VISI
  integer, intent(in) :: jy          !! Y coord location in VISI
  real, intent(in) :: visi(jc,nv)    !! Visibilities
  real, intent(in) :: taper(4)       !! Taper definition
  real, intent(inout) :: we(nv)      !! Weights
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  !
  ! Local ---
  integer iv
  real staper,etaper
  real u,v
  real cx,cy,sx,sy
  !
  ! Code ----
  if (taper(1).eq.0. .and. taper(2).eq.0.) return
  !
  call imager_tree('DOTAPE',.false.)
  !
  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
  if (taper(4).ne.0.) then
    etaper = taper(4)/2.0
  else
    etaper = 1
  endif
  !
  do iv=1,nv
    u = visi(jx,iv)
    v = visi(jy,iv)
    !
    staper = (u*cx + v*sy)**2 + (-u*sx + v*cy)**2
    if (etaper.ne.1) staper = staper**etaper
    if (staper.gt.64.0) then
      staper = 0.0
    else
      staper = exp(-staper)
    endif
    we(iv) = we(iv)*staper
  enddo
  call imager_tree('DOTAPE',.true.)
end subroutine dotape
!
subroutine doweig (jc,nv,visi,jx,jy,iw,unif,we,wm,error,code)
  !$ use omp_lib
  use gildas_def
  use gkernel_interfaces
  use grid_control
  use imager_interfaces, except_this => doweig
  use gbl_message
  !----------------------------------------------------------------------
  ! @ public-mandatory
  !*
  ! IMAGER  -- Support for UV_MAP
  !
  !     Compute weights of the visibility points.
  !!
  !----------------------------------------------------------------------
  integer, intent(in) ::  nv          !! number of values
  integer, intent(in) ::  jc          !! Number of "visibilities"
  integer, intent(in) ::  jx          !! X coord location in VISI
  integer, intent(in) ::  jy          !! Y coord location in VISI
  integer, intent(in) ::  iw          !! Weight channel. If .LE.0, uniform weight
  real, intent(in) ::  visi(jc,nv)    !! Visibilities
  real, intent(in) ::  unif           !! uniform cell size in Meters
  real, intent(inout) ::  we(nv)      !! Weight array
  real, intent(in) ::  wm             !! on input: % of uniformity
  logical, intent(inout) :: error     !! Logical error flag
  integer, intent(in), optional :: code   !! Code controlling the method
  !
  character(len=*), parameter :: rname='DOWEIG'
  !
  ! Local ---
  integer i,jw
  real umin,umax,vmin,vmax,vstep,vimin,vimax
  real vcmin, vcmax
  integer nbcv, ivmin, ivmax, icv, nbv, new, nflag
  integer icode, ier
  character(len=message_length) :: chain
  real(8) :: elapsed_s, elapsed_e, elapsed
  real(4) :: cpu0, cpu1
  real, allocatable ::  vv(:)         ! V values, pre-sorted
  !
  ! Code ---
  call imager_tree('DOWEIG',.false.)
  error = .false.
  nflag = 0
  !
  if (unif.le.0.0 .or. wm.eq.0.0) then
    !
    ! Natural weighting
    if (iw.gt.0) then
      jw =7+3*iw
      do i=1,nv
        if (visi(jw,i).gt.0.0) then
          we(i) = visi(jw,i)
        else
          nflag = nflag+1
          we(i) = 0.0
        endif
      enddo
      if (nflag.ne.0) then
        write(chain,'(I0,A)') nflag,' flagged visibilities ignored'
        call map_message(seve%i,rname,chain)
      endif
    else
      we(1:nv) = 1.
    endif
    return
  endif
  !
  elapsed_e = 0.
  elapsed_s = 0.
  elapsed = 0.
  !
  ! Robust weighting
  if (present(code)) then
    !
    ! Control the method by selecting the algorithm
    icode = code
  else
    ! Used for old code, as a strict reference to MAPPING
    ! This is essentially for comparative tests. 
    icode = -1    
  endif
  !
  if ((icode.ge.0) .and. (nv.lt.grid_bigvisi)) then
    jw = 7+3*iw
    !
    call gag_cpu(cpu0)
    !$ elapsed_s = omp_get_wtime()
    call doweig_sph (jc,nv,visi,jx,jy,jw,unif,we,error,icode)
    call doweig_robust (jc,nv,visi,jw,we,wm)
    call gag_cpu(cpu1)
    !$ elapsed_e = omp_get_wtime()
    !$ elapsed = elapsed_e - elapsed_s
    write(chain,'(a,f9.2,a,f9.2)') 'Finished Robust computation CPU: ',cpu1-cpu0, &
      & ' elapsed ',elapsed
    call map_message(seve%i,rname,chain)
  else if ((icode.ne.-1).or.(nv.ge.grid_bigvisi)) then
    !
    ! Gridded version 
    jw = 7+3*iw
    !
    call doweig_grid (jc,nv,visi,jx,jy,jw,unif,we,error,icode)
    call doweig_robust (jc,nv,visi,jw,we,wm)
  else if (icode.eq.-1) then
    !
    ! Uniform weight
    allocate(vv(nv),stat=ier)
    vv = visi(jy,:)
    !
    ! 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 = 128
    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 = int(-vmin/(4*unif))
      !Print *,'Vmin ',vmin,'Unif ',unif,' NBCV ',nbcv
      if (mod(nbcv,2).ne.0) nbcv = nbcv-1
      nbcv = max(1,nbcv)
      vstep = -vmin/nbcv
    endif
    !
    ! 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
    !
    !Print *,'OLD before Unif ',unif,' WM ',wm
    ! Here this is really the Channel Number
    call doweig_quick (jc,nv,visi,jx,jy,iw,unif,we,wm,vv,nbv,   &
       &    umin,umax,vmin,vmax,nbcv)
    !Print *,'OLD after Unif ',unif,' WM ',wm
  endif
  call imager_tree('DOWEIG',.true.)
  !
end subroutine doweig
!
subroutine doweig_sph (jc,nv,visi,jx,jy,jw,unif,we,error,code)
  use gildas_def
  use gkernel_interfaces
  use imager_interfaces, except_this => doweig_sph
  use gbl_message
  !----------------------------------------------------------------------
  ! @ public
  !
  ! IMAGER  -- Support for UV_MAP
  !
  !     Compute weights of the visibility points.
  !----------------------------------------------------------------------
  integer, intent(in) ::  nv          !! number of values
  integer, intent(in) ::  jc          !! Number of "visibilities"
  integer, intent(in) ::  jx          !! X coord location in VISI
  integer, intent(in) ::  jy          !! Y coord location in VISI
  integer, intent(in) ::  jw          !! Location of weights. If .LE.0, uniform weight
  real, intent(in) ::  visi(jc,nv)    !! Visibilities
  real, intent(in) ::  unif           !! uniform cell size in Meters
  real, intent(inout) ::  we(nv)      !! Weight array
  logical, intent(inout) :: error
  integer, intent(in), optional :: code  !! Number of sub-cells per UV uniform cell size
  !
  character(len=*), parameter :: rname='DOWEIG'
  !
  ! Local ---
  real, allocatable :: suu(:), svv(:), sww(:), swe(:)
  integer, allocatable :: spi(:)
  real :: umin, umax, vmin, vmax
  real :: sizecell
  integer :: ier, mv, nbv, i, icode
  character(len=120) :: mess
  !
  ! Code ----
  error = .false.
  call imager_tree('DOWEIG_SPH',.false.)
  !
  mv = 2*nv
  allocate(suu(mv),svv(mv),sww(mv),swe(mv),spi(nv),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%f,'DOWEIG_SPH','Memory allocation error')
    return
  endif
  !
  spi = 0
  nbv = 0
  do i=1,nv
    if (visi(jw,i).gt.0) then
      nbv = nbv+1
      suu(nbv) = visi(jx,i)
      svv(nbv) = visi(jy,i)
      sww(nbv) = visi(jw,i) 
      spi(i) = nbv
      nbv = nbv+1
      suu(nbv) = -visi(jx,i)
      svv(nbv) = -visi(jy,i)
      sww(nbv) = visi(jw,i) 
    endif
  enddo
  ! Find out extrema
  vmin = minval(svv(1:nbv))
  vmax = maxval(svv(1:nbv))
  umin = minval(suu(1:nbv))
  umax = maxval(suu(1:nbv))
  error = .false.
  !
  ! Sub-divide the uniform cell size into sub-cells for speed
  ! The optimal depends on the density of UV points.
  !
  if (present(code).and.code.gt.0) then
    ! This is for test only
    icode = max(2,code)
    write(mess,'(A,I0)')  'User requested ICODE ',icode
  else
    icode = 0
    call dowei_icode(umax,umin,vmax,vmin,unif,nbv,icode)
  endif
  sizecell = unif/icode
  !
  if (mv.lt.10000) then
    write(mess,'(A,I0,A,F6.1,F6.1,A)') "Gridding for ", mv,' Visibilities, cell sizes ', &
      & sizecell, unif, " m"
  else if (mv.lt.2000000) then
    write(mess,'(A,I0,A,F6.1,F6.1,A)') "Gridding for ", mv/1000,' kilo Visibilities, cell sizes ', &
      & sizecell, unif, " m"
  else 
    write(mess,'(A,F8.1,A,F6.1,F6.1,A)') "Gridding for ", real(mv)*1E-6,' Mega Visibilities, cell sizes ', &
      & sizecell, unif, " m"
  endif
  call map_message(seve%i,rname,mess)
  write(mess,'(A,4F8.1)') "  and UV range ", umin, umax, vmin, vmax
  call map_message(seve%i,rname,mess)
  !
  call gridless_density(nbv,sizecell,unif,suu,svv,sww,swe, &
    umin,umax,vmin,vmax,error)
  if (error) return
  !
  ! Put in place with the Indirect pointer
  do i=1,nv
    if (spi(i).gt.0) then
      we(i) = swe(spi(i))
    else
      we(i) = 0
    endif
  enddo
  call imager_tree('DOWEIG_SPH',.true.)
end subroutine doweig_sph
!
subroutine gridless_density (npts,sizecell,distmax,evex,evey,eveweight,&
  & evesumweight,xmin,xmax,ymin,ymax,error)
  use gildas_def
  use gbl_message
  use imager_interfaces, except_this => gridless_density
  !$ use omp_lib
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER --  Support routine for Robust weighting
  !
  ! Stephane Paulin   OASU CNRS / U.Bordeaux  2016
  !
  ! Algorithm to compute the weighted neighborhood of each point in a large
  ! catalog. This algorithm was described, among other sources, by Daniel Briggs in
  ! his thesis. The idea is to avoid npts**2 calculations of the distance between
  ! each pair of points (npts is the # points). For that, one defines a grid only used
  ! to speed-up computation (result is independent of the grid).  
  ! Step 1: In a given cell of the grid, all events are linked and the total weight
  !   of the cell is computed and kept in memory.  
  ! Step 2: a pattern is computed, that is the same all over the field, whose radius
  !   is the maximum distance. Grid boxes can have 3 states: entirely inside the
  !   maximum distance, entirely outside, or in between (boxes noted 'intermediate'
  !   or 'mixed').
  !
  ! The idea is to compute the distances only for events in these intermediate boxes.
  ! For other events, or the total weight of the box is added (if the box is inside),
  ! or the box is ignored (if outside). Next, the main loop consists on a loop on every
  ! event. For a given event, all boxes in the pattern are checked and treated accordingly.
  ! With this algorithm, one can have CPU times prop. to factor*npts*log(npts) with
  ! factor~2 (ie. when npts is multiplied by 10, the CPU is multiplied by ~45-50)
  !
  ! Remarks/notes:
  ! - this is a preliminary approach for testing, where symmetries are not
  !   taken into account ==> a given couple of coordinates (evex,evey) corresponds
  !   to one event
  !
  ! Changes by S.Guilloteau:  
  !   Parallel programming Mar-2019   
  !   Optimize parallel programming Oct-2022  
  !!
  !----------------------------------------------------------------------
  real, intent(in) :: sizecell                !! size of a cell.
  !! this is a control parameter that does not change the result but
  !! change the calculation time: to minimize the CPU, the larger the
  !! event density, the smaller sizecell. ex: sizecell~20 (10, 5 resp.)
  !! for a catalog of 10**5 (10**6, 3x10**7) events
  integer, intent(in) :: npts                 !! total # of events
  real, intent(in) :: distmax                 !! maximum distance
  real(kind=4), intent(in) :: evex(npts)      !! X coordinates
  real(kind=4), intent(in) :: evey(npts)      !! Y coordinates
  real(kind=4), intent(in) :: eveweight(npts) !! Weight of event
  real(kind=4), intent(out) :: evesumweight(npts) !! Sum of the weights of all
  !! the events closer nearer than the maximum distance from the current event.
  real(kind=4), intent(in) :: xmin,ymin,xmax,ymax !! Min Max
  logical, intent(out) :: error               !! Error flag
  !
  ! Constants
  character(len=*), parameter :: rname='DOWEIG'
  !$ logical, external :: ompget_debug_code
  !
  ! Local ---
  integer(kind=4) :: nbboxx,nbboxy,nbbox,i,j,indice1,indice2,ii
  integer :: xbox_cur,ybox_cur,nbcellmaxx,nbcellmaxy
  integer :: nbcellx,nbcelly,nbcellquartx,nbcellquarty
  real :: distmaxsq,temp
  real(kind=4) :: llx_cur,lly_cur,urx_cur,ury_cur,ulx_cen
  real(kind=4) :: llx_cen,lly_cen,lrx_cen,lry_cen,urx_cen,ury_cen,uly_cen
  real(kind=4) :: longest,shortest
  integer :: ier
  !
  ! Dynamic variables used by the gridless algorithm:
  ! each analysis has given # of events (npts) & size of the grid (sizecell==>nbbox)
  !
  real(kind=4), allocatable :: boxx(:),boxy(:)    ! Coordinates along box axis
  real, allocatable :: boxtotweight(:,:)          ! Total weight in boxes
  integer(kind=4), allocatable :: nextevent(:)    ! Chained pointer
  integer(kind=4), allocatable :: eveindx(:)      ! why not kind=8 ? if very large grid
  integer(kind=4), allocatable :: eveindy(:)      ! why not kind=8 ? if very large grid
  integer(kind=4), allocatable :: last(:,:)       ! Work array
  integer(kind=4), allocatable :: firstevent(:,:) ! First pointer of box
  integer(kind=4), allocatable :: boxnbevent(:,:) ! Number of events in box
  integer(kind=4), allocatable :: statebox(:,:)   ! Box status
  !
  integer :: ithread, jthread, nthread
  real(kind=4), allocatable :: sumwe(:,:)
  !
  integer :: nval, ival, mval, nbad
  integer, allocatable :: kval(:)
  !
  real :: MegaByte
  real(8) :: elapsed_s, elapsed_e, elapsed
  real(4) :: cpu0
  logical :: do_report
  !
  ! Code ----
  error = .false.
  elapsed_e = 0.
  elapsed_s = 0.
  elapsed = 0.
  !
  distmaxsq = distmax*distmax
  evesumweight = 0
  !
  nbboxx = ceiling( (xmax-xmin) / sizecell)
  nbboxy = ceiling( (ymax-ymin) / sizecell)
  nbbox = nbboxx * nbboxy
  !
  ! Required elements
  error = .true.
  MegaByte = ((nbboxx+nbboxy)/1024./1024.+(nbboxx/1024.)*(nbboxy/1024.))*4.
  if (MegaByte.gt.1000) then
    write(6,'(A,F8.1,A)') 'W-GRIDDING,  Allocating 4 x ',MegaByte*1D-3,' GBytes for cells'
    write(6,'(A,F8.1,A)') '             Plus 4 x ',npts*4.d0/1024./1024.,' MBytes for weights'
    if (MegaByte.gt.3000) then
      write(6,'(A,F9.1,A)') 'Grid too big, change map_uvcell'
      return
    endif
  endif
  allocate(boxx(nbboxx),boxy(nbboxy),boxtotweight(nbboxx,nbboxy),stat=ier)
  if (ier.ne.0) return
!  if (MegaByte.gt.1000) Print *,'First one OK'
  allocate(firstevent(nbboxx,nbboxy),nextevent(npts),stat=ier)
  if (ier.ne.0) return
!  if (MegaByte.gt.1000) Print *,'Second one OK'
  ! Potentially avoidable arrays
  allocate(eveindx(npts),eveindy(npts),boxnbevent(nbboxx,nbboxy),stat=ier)
  if (ier.ne.0) return
!  if (MegaByte.gt.1000) Print *,'Third one OK'
  ! Work array
  allocate(last(nbboxx,nbboxy),stat=ier)
  if (ier.ne.0) return
!  if (MegaByte.gt.1000) Print *,'Last one OK'
  error = .false.
  !
  call gag_cpu(cpu0)
  !
  ! Basic initialisations
  do i = 1, nbboxy
    boxy(i) = (i-0.5)*sizecell + ymin
  enddo
  do i = 1, nbboxx
    boxx(i) = (i-0.5)*sizecell + xmin
  enddo
  boxnbevent = 0   
  boxtotweight = 0
  last = 0
  !
  ! chaining the events
  eveindx(:) = INT((evex-xmin)/sizecell) + 1  ! could be optimised/avoided, 
  ! but convenient in this preliminary version
  eveindy(:) = INT((evey-ymin)/sizecell) + 1  ! idem
  !
  do i = 1, npts
    !
    ! could be optimised/avoided, but convenient in this preliminary version
    boxnbevent(eveindx(i),eveindy(i)) = boxnbevent(eveindx(i),eveindy(i)) + 1
    if (eveweight(i).gt.0) boxtotweight(eveindx(i),eveindy(i)) &
      & = boxtotweight(eveindx(i),eveindy(i)) + eveweight(i)
    !
    if (last(eveindx(i),eveindy(i)).EQ.0) then
      firstevent(eveindx(i),eveindy(i)) = i
    else
      nextevent(last(eveindx(i),eveindy(i))) = i
    endif
    last(eveindx(i),eveindy(i)) = i
  enddo
  deallocate(last)
  if (MegaByte.gt.1000) write(6,'(A,I0)') 'I-GRIDDING, finished initialization ',npts
  !
  ! defining the pattern
  !
  ! nbcellquart is the integer # of boxes in a quadrant excluding the axes
  temp = distmax / sizecell
  nbcellquartx = ceiling(temp)
  nbcellquarty = nbcellquartx ! working assumption: symmetry ==>
  ! in this preliminary version, only euclidian distances with 
  ! x<==>y (no ellipse but this would very simple to add this feature)
  !
  !nbcellmax is the maximum distance tolerated from 0, expressed in integer # of boxes
  nbcellmaxx = nbcellquartx
  nbcellmaxy = nbcellquarty
  !
  !nbcell is the # of boxes in the pattern
  nbcellx = nbcellmaxx*2
  nbcelly = nbcellmaxy*2
  !
  ! statebox specifies the status of a box : 1 <==> good ; 2 <==> mixed ; 3 <==> bad
  MegaByte = (nbcellmaxx*nbcellmaxy)*4./1024/1024
  if (MegaByte.gt.1000) then
    write(6,'(A,F6.1,A)') 'W-GRIDDING,  Allocating ',MegaByte*1D-3,' GBytes for Cells'
  endif
  allocate(statebox(nbcellmaxx,nbcellmaxy),stat=ier)
  if (ier.ne.0) then
    write(6,'(A)') 'E-GRIDDING, Memory allocation error '
    error = .true.
    return
  endif
  statebox = 0
  statebox(1,1) = 1
  !
  ! Assumption: symmetry. For the moment we will assume all quarters are equivalent.
  ! Historically, the distance tests are performed considering the lower-left corner
  ! (so are the coordinates llx, lly, urx, ury... of the 'cur' pixel)
  ! but in the arrays indice 1 corresponds to the center and indice max corresponds
  ! to the outside, like an upper-right corner
  !
  llx_cen = 0
  lly_cen = 0
  urx_cen = sizecell
  ury_cen = sizecell
  lrx_cen = urx_cen
  lry_cen = lly_cen
  ulx_cen = llx_cen
  uly_cen = ury_cen
  !
  !call gag_cpu(cpu1)
  !write(chain,'(a,f9.2,a,f9.2)') 'Finished Robust setup CPU: ',cpu1-cpu0 
  !write(*,*) chain
  !
  do indice1=1,nbcellquartx
    do indice2=1,nbcellquarty
      if (indice1.NE.1 .OR. indice2.NE.1) then
        ! there must be 2 loops:
        ! with indice2==1 & indice1>1 and shortest computed according to lr_cen ;
        ! with indice2>1 and shortest computed according to ur_cen
        !
        ! here the central pixel is refered with the suffix 'cen' while
        ! the floating pixel is refered by 'cur'
        !update 161017 cen is the upper-right pixel touching 0
        !
        urx_cur = indice1*sizecell
        ury_cur = indice2*sizecell
        !
        longest = calcdistsq(llx_cen,urx_cur,lly_cen,ury_cur)
        !
        if (longest.LE.distmaxsq) then
          statebox(indice1,indice2) = 1 ! reminder: 1 <==> good ; 2 <==> mixed ; 3 <==> bad
        else
          llx_cur = urx_cur - sizecell
          lly_cur = ury_cur - sizecell
          if (indice2.EQ.1) then
            shortest = calcdistsq(lrx_cen,llx_cur,lry_cen,lly_cur)
          else if (indice1.EQ.1) then
            shortest = calcdistsq(ulx_cen,llx_cur,uly_cen,lly_cur)
          else
            shortest = calcdistsq(urx_cen,llx_cur,ury_cen,lly_cur)
          endif
          if (shortest.LT.distmaxsq) then
            statebox(indice1,indice2) = 2
        !2 following lines are only for debugging (useless and slowing down the process)
        !else
        !  statebox(indice1,indice2) = 3 ! useless, was used for debugging but could be
          endif
        endif
      endif
    enddo
  enddo
  ! call gag_cpu(cpu1)
  ! write(chain,'(a,f9.2,a,f9.2)') 'Finished Robust init CPU: ',cpu1-cpu0
  ! write(*,*) chain
  !
  ! main loop
  !
  ! For OMP programming, only evesumweight is updated here, so
  ! each Thread may get a copy, and we sum them later.
  ! All the rest can be shared arrays on input, and local variables
  ! for the loop indices or dependent intermediate variables
  !
  nthread = 1
  ithread = 1
  do_report = npts.gt.1000000
  nbad = 0
  ! !$ do_report = do_report .and. (ompget_outer_threads().eq.1) 
  !$ nthread = ompget_inner_threads() 
  !$ if (ompget_debug_code()) Print *,'GRIDLESS_DENSITY OMP Already parallel ', &
  !$   &      omp_in_parallel(),' Nesting ',omp_get_nested(), 'Nthread ',nthread
  allocate(sumwe(npts,nthread),stat=ier)
  !! Print *,'Thread allocation ',ier,npts*nthread*4/1024./1024.,' Mbytes'
  sumwe = 0
  !
  ! The original code lead to very unbalanced load
  !  do j=1,nbboxy
  !   do i=1,nbboxx
  !    if (boxnbevent(i,j).GT.0) then
  !      CODE
  !    endif
  !   enddo
  !  enddo
  !
  ! Replace by an array of valid indices
  nval = 0
  mval = 0
  allocate (kval(nbboxx*nbboxy),stat=ier)
  do j=1,nbboxy
    do i=1,nbboxx
      if (boxnbevent(i,j).GT.0) then
        nval = nval+1
        kval(nval) = (j-1)*nbboxx+i
        if (boxnbevent(i,j).ge.mval) then
          mval = boxnbevent(i,j)
!          Print *,'Max at ',i,j,nval,mval
        endif
      endif
    enddo
  enddo
  !
  if (do_report) call progress_report('Gridded ',1,1,nval,10)
  ii = 1
  !
  !$OMP PARALLEL DEFAULT(NONE) NUM_THREADS(nthread) &
  !$OMP & SHARED(nval,mval,kval) PRIVATE(ival) &
  !$OMP & SHARED(sumwe,boxnbevent,firstevent,boxtotweight,nextevent) &
  !$OMP & SHARED(statebox, eveweight, evex, evey, distmax, distmaxsq) & 
  !$OMP & SHARED(nbboxx,nbboxy,nbcellmaxx, nbcellmaxy, nthread) &
  !$OMP & PRIVATE(i,j,ithread,jthread,indice1,indice2,xbox_cur,ybox_cur) &
  !$OMP & PRIVATE(elapsed_s,elapsed_e) SHARED(elapsed,npts) &
  !$OMP & SHARED(ii,do_report) REDUCTION(+:nbad) ! Counter for progress report
  !
  !$ ithread = omp_get_thread_num()+1
  !$ elapsed_s = omp_get_wtime()
  !$OMP DO SCHEDULE(DYNAMIC,1)   
  do ival =1,nval
    i = mod(kval(ival)-1,nbboxx)+1
    j = (kval(ival)-i)/nbboxx+1
    !
    if (boxnbevent(i,j).LE.0) then
      nbad = nbad+1
      cycle
    endif
    !
    call linkidenticalbox(boxnbevent(i,j),firstevent(i,j),boxtotweight(i,j), &
    & sumwe(:,ithread),nextevent)
    !Print *,'Done linkidentical box  ',i,j,ithread
    do indice1 = 1, nbcellmaxx
      do indice2 = 1, nbcellmaxy
        if (indice1.NE.1 .OR. indice2.NE.1) then
          xbox_cur = i-1+indice1
          ybox_cur = j-1+indice2
          if (xbox_cur.GT.0 .AND. ybox_cur.GT.0 .AND. xbox_cur.LE.nbboxx &
          & .AND.ybox_cur.LE.nbboxy) then
            if (boxnbevent(xbox_cur,ybox_cur).GT.0) then
              if (statebox(indice1,indice2).EQ.1) then
                call linkgoodbox(boxnbevent(i,j),boxnbevent(xbox_cur,ybox_cur), &
                  & firstevent(i,j),firstevent(xbox_cur,ybox_cur), &
                  & boxtotweight(i,j),boxtotweight(xbox_cur,ybox_cur), &
                  & sumwe(:,ithread),nextevent)
              else if (statebox(indice1,indice2).EQ.2) then
                call linkmixedbox(boxnbevent(i,j),boxnbevent(xbox_cur,ybox_cur), &
                  & firstevent(i,j),firstevent(xbox_cur,ybox_cur), &
                  & sumwe(:,ithread), eveweight, evex, evey, nextevent, &
                  & distmax, distmaxsq)
              endif
            endif
          endif
        endif
        !
        if (indice1.LT.nbcellmaxx .AND. indice2.GT.1) then
          ! warning: left side of the horizontal line is excluded
          xbox_cur = i-indice1 ! warning: symmetry broken since the pattern is not centered
          ybox_cur = j-1+indice2
          if (xbox_cur.GT.0 .AND. ybox_cur.GT.0 .AND. &
              xbox_cur.LE.nbboxx .AND. ybox_cur.LE.nbboxy) then
            if (boxnbevent(xbox_cur,ybox_cur).GT.0) then
              if (statebox(indice1+1,indice2).EQ.1) then
                call linkgoodbox(boxnbevent(i,j),boxnbevent(xbox_cur,ybox_cur), &
                  & firstevent(i,j),firstevent(xbox_cur,ybox_cur), &
                  & boxtotweight(i,j),boxtotweight(xbox_cur,ybox_cur), &
                  & sumwe(:,ithread),nextevent)
              else if (statebox(indice1+1,indice2).EQ.2) then
                call linkmixedbox(boxnbevent(i,j),boxnbevent(xbox_cur,ybox_cur), &
                  & firstevent(i,j),firstevent(xbox_cur,ybox_cur), &
                  & sumwe(:,ithread), eveweight, evex, evey, nextevent, &
                  & distmax, distmaxsq)
              endif
            endif
          endif
        endif
      enddo
    enddo
    !$OMP CRITICAL
    ii = ii+1
    if (do_report) call progress_report('Gridded ',ii,1,nval,10)
    !$OMP END CRITICAL
  enddo 
  !$OMP ENDDO
  !$ elapsed_e = omp_get_wtime()
  !$ if (ithread.eq.1) elapsed = elapsed_e - elapsed_s
  !$OMP END PARALLEL
  !
  evesumweight(:) = sumwe(:,1)
  do ithread=2,nthread
    evesumweight(:) = evesumweight(:) + sumwe(:,ithread)
  enddo
  if (do_report) write(*,*) 'Done !'
  if (nbad.ne.0) write(*,*) '--- Programming Error in GRIDLESS Weighting ',nbad
  !
  deallocate(statebox)
  deallocate(boxx,boxy,boxtotweight)
  deallocate(firstevent,nextevent)
  deallocate(eveindx,eveindy,boxnbevent)
  !
contains
!
pure function calcdistsq(x1,x2,y1,y2)
  ! @ private
  real(kind=4) calcdistsq ! intent(out)
  real(kind=4), intent(in) :: x1,y1,x2,y2
  !
  calcdistsq = (x1-x2)*(x1-x2) + (y1-y2)*(y1-y2)
end function calcdistsq
!
subroutine linkidenticalbox(nb, ind_init, boxtotweight, evesumweight, nextevent)
  use gildas_def
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER --  Support routine for Robust Weighting
  !
  !   Build the chain list of pixels in the same cell with
  !   the same status
  !!
  !----------------------------------------------------------------------
  real, intent(in) :: boxtotweight                    !! Box total weight
  integer(kind=4), intent(in) :: nb                   !! Size of chain
  integer(kind=4), intent(in) :: ind_init             !! Starting index in each box
  real(kind=4), intent(inout) :: evesumweight(:)      !! Sum of weight at each event
  integer(kind=4), intent(in) :: nextevent(:)         !! Chained pointers
  !
  integer(kind=4) :: ind, i
  !
  ! reminder: at the beginning, ind==firstevent of the box
  ind = ind_init
  do i = 1, nb
    evesumweight(ind) = evesumweight(ind) + boxtotweight
    ind = nextevent(ind)
  enddo
end subroutine linkidenticalbox
!
subroutine linkgoodbox(nb1, nb2, ind1_init, ind2_init, &
  & boxtotweight1, boxtotweight2, evesumweight, nextevent)
  use gildas_def
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER --  Support routine for Robust Weighting
  !
  !   Build the chain list of pixels in the same cell with
  !   the same status
  !!
  !----------------------------------------------------------------------
  real, intent(in) :: boxtotweight1, boxtotweight2    !! Total weight of each box
  integer(kind=4), intent(in) :: nb1, nb2             !! Box sizes
  integer(kind=4), intent(in) :: ind1_init, ind2_init !! Starting index in each box
  real(kind=4), intent(inout) :: evesumweight(:)      !! Sum of weight at each event
  integer(kind=4), intent(in) :: nextevent(:)         !! Chained pointers
  !
  integer(kind=4) :: ind1, ind2, i
  !
  ! reminder: at the beginning, ind==firstevent of the box
  ind1 = ind1_init
  ind2 = ind2_init
  !
  do i = 1, nb1
    evesumweight(ind1) = evesumweight(ind1) + boxtotweight2
    ind1 = nextevent(ind1)
  enddo
  do i = 1, nb2
    evesumweight(ind2) = evesumweight(ind2) + boxtotweight1
    ind2 = nextevent(ind2)
  enddo
  !
end subroutine linkgoodbox
!
subroutine linkmixedbox(nb1, nb2, ind1_init, ind2_init, evesumweight, &
  & eveweight, evex, evey, nextevent, distmax, distmaxsq)
  use gildas_def
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER --  Support routine for Robust Weighting
  !
  !   Build chain list of different types
  !!
  !----------------------------------------------------------------------
  integer(kind=4), intent(in) :: nb1, nb2             !! Box sizes
  integer(kind=4), intent(in) :: ind1_init, ind2_init !! Starting index in each box
  real, intent(in) :: distmax, distmaxsq              !! Averaging radius
  real(4), intent(in) :: eveweight(:)                 !! Initial weights
  real(4), intent(in) :: evex(:)                      !! Event X coordinates
  real(4), intent(in) :: evey(:)                      !! Event Y coordinates
  real(kind=4), intent(inout) :: evesumweight(:)      !! Sum of weight at each event
  integer(kind=4), intent(in) :: nextevent(:)         !! Chained pointers
  !
  integer(kind=4) :: ind1, ind2, i, j
  !
  ind1 = ind1_init
  ind2 = ind2_init
  !
  do i =1,nb1
    do j = 1,nb2
      if (abs(evex(ind1)-evex(ind2)).LE.distmax) then
        if (abs(evey(ind1)-evey(ind2)).LE.distmax) then
          if (calcdistsq(evex(ind1),evex(ind2),evey(ind1),evey(ind2)).LE.distmaxsq) then
            evesumweight(ind1) = evesumweight(ind1) + eveweight(ind2)
            evesumweight(ind2) = evesumweight(ind2) + eveweight(ind1)
          endif
        endif
      endif
      ind2 = nextevent(ind2)
    enddo
    ind1 = nextevent(ind1)
    ind2 = ind2_init
  enddo
  !
end subroutine linkmixedbox
!
end subroutine gridless_density
!
subroutine scawei (nv,uni,ori,wall)
  !---------------------------------------------------------
  ! @ public
  !
  !! IMAGER --  Scale the visibility weights
  !---------------------------------------------------------
  integer, intent(in) :: nv     !! Number of visibilities
  real, intent(out) :: uni(nv)  !! Re-weighted weights
  real, intent(in)  :: ori(nv)  !! Original weights
  real, intent(out) :: wall     !! Sum of weights
  !!
  integer i
  real(kind=8) a, s, s2
  !
  s = 0   ! Sum of scaling factors
  s2 = 0  ! Sum of square of scaling factors
  do i=1,nv
    if (uni(i).gt.0) then
      a = uni(i)/ori(i)
      s = s+uni(i)        ! s+a
      s2 = s2+uni(i)*a    ! s2+a*a
    endif
  enddo
  !
  ! Like UV_STAT, better result
  a = s / s2
  uni(1:nv) = uni(1:nv)*a
  wall = a*s
end subroutine scawei
!
subroutine chkfft (a,nx,ny,error)
  !---------------------------------------------------------
  ! @ private
  !
  !! IMAGER -- Check if FFT is centered...
  !---------------------------------------------------------
  integer, intent(in)  ::  nx,ny   !! X,Y size
  logical, intent(out)  ::  error  !! Error flag
  real, intent(in)  ::  a(nx,ny)   !! Array
  !
  error = a(nx/2+1,ny/2+1).eq.0.0
end subroutine chkfft
!
subroutine doweig_quick (jc,nv,visi,jx,jy,jw,unif,we,wm,vv,mv, &
     &     umin,umax,vmin,vmax,nbcv)
  use gkernel_interfaces
  use imager_interfaces, only : map_message
  use gildas_def
  use gbl_message
  !----------------------------------------------------------------------
  ! @ private
  !
  !! IMAGER -- Compute weights of the visibility points.
  !----------------------------------------------------------------------
  integer, intent(in) ::  nv          !! number of values
  integer, intent(in) ::  jc          !! Number of "visibilities"
  integer, intent(in) ::  jx          !! X coord location in VISI
  integer, intent(in) ::  jy          !! Y coord location in VISI
  integer, intent(in) ::  jw          !! Location of weights. If .LE.0, uniform weight
  integer, intent(in) ::  mv          !! Size of work arrays
  integer, intent(in) ::  nbcv        !! Buffering factor
  real, intent(in) ::  visi(jc,nv)    !! Visibilities
  real, intent(in) ::  unif           !! uniform cell size in Meters
  real, intent(inout) ::  we(nv)      !! Weight array
  real, intent(in) ::  wm             !! on input: % of uniformity
  real, intent(in) ::  vv(nv)         !! V values, pre-sorted
  real, intent(in) :: umin,umax,vmin,vmax !! UV boundaries
  !
  character(len=*), parameter :: rname='DOWEIG'
  !
  ! Local ---
  integer, allocatable :: ipv(:)
  real, allocatable :: utmp(:), vtmp(:), wtmp(:), rtmp(:)
  integer i,iw
  real u,v,weight,wfact
  real vstep,ustep,vimin,vimax,uimin,uimax
  real ucmin, ucmax, vcmin, vcmax
  integer nbcu, ivmin, ivmax, icu, icv, nbv, isub, ier
  character(len=message_length) :: chain
  !
  ! Code ---
  allocate (utmp(mv), vtmp(mv), wtmp(mv), rtmp(mv), ipv(mv), stat=ier)
  !
  we(1:nv) = -1.0
  isub = 0
  !
  ! Some speed up factor
  nbcu = 2*nbcv
  vstep = -vmin/nbcv
  ustep = (umax-umin)/nbcu
  !
  ! Adjust the number of cells. A cell must be > 2*UNIF, and > 4*UNIF is more
  ! than sufficient to get speed up.  -- Current coding guarantees the
  ! situation below never happens in GILDAS, so allow a fatal crash
  ! in case somebody else breaks the rule...
  if (vstep.lt.4*unif) then
    write (chain,*) 'Vstep is too small',vstep,unif,vmin,nbcv
    call map_message(seve%w,rname,chain)
    if (nbcv.ne.1) call sysexi(fatale)
  endif
  !
  ! There is a weight column
  if (jw.gt.0) then
    iw = 7+3*jw
    !
    ! Loop on U,V cells
    do icv = nbcv,1,-1
      vcmin = (icv-1)*vstep+vmin
      vimin = vcmin-unif
      vcmax = icv*vstep+vmin
      vimax = vcmax+unif
      !
      ivmin = 1
      ivmax = nv
      call findp (nv,vv,vimin,ivmin)
      ivmax = ivmin
      call findp (nv,vv,vimax,ivmax)
      ivmax = min(nv,ivmax+1)
      !
      do icu = 1,nbcu
        ucmin = (icu-1)*ustep+umin
        uimin = ucmin-unif
        ucmax = icu*ustep+umin
        uimax = ucmax+unif
        !
        ! Select valid visibilities
        nbv = 0
        do i=ivmin,ivmax
          ! Note that V stays ordered by increasing values
          u = visi(jx,i)
          v = visi(jy,i)
          !
          ! Normal case only...
          if ((v.ge.vimin).and.(v.le.vimax)) then
            if ((u.ge.uimin).and.(u.le.uimax)) then
              nbv = nbv+1
              ipv(nbv) = i
              utmp(nbv)= u
              vtmp(nbv)= v
              wtmp(nbv)= visi(iw,i)
            endif
          endif
          !
          ! Limiting case near V=0, inverse the U test...
          if (-v.le.unif) then
            if ((u.lt.-uimin).and.(u.gt.-uimax)) then
              nbv = nbv+1
              ipv(nbv) = 0
              utmp(nbv)= u
              vtmp(nbv)= v
              wtmp(nbv)= visi(iw,i)
            endif
          endif
        enddo
        !
        ! Compute the weights
        if (nbv.gt.0) then
          isub = isub+1
          call doweig_sub (nbv,utmp,vtmp,wtmp, rtmp, unif)
          !
          ! IPV is a back pointer
          do i=1,nbv
            if ( (utmp(i).gt.ucmin.and.utmp(i).le.ucmax)   &
     &              .and. (vtmp(i).gt.vcmin.and.vtmp(i).le.vcmax) )   &
     &              then
              if (ipv(i).ne.0) then
                if (we(ipv(i)).ne.-1.0) then
                  print *,'Computed ',i,ipv(i),we(ipv(i)),rtmp(i)
                endif
                we(ipv(i)) = rtmp(i)
              endif
            endif
          enddo
        endif
        !
      enddo
      if (icv.eq.nbcv) call map_message(seve%i,rname,'Done boundary cells')
    enddo
    !
    ! All weights are computed now, normalize them
    call dowfact(nv,we,wfact)
    weight = wm*wfact
    !!write(6,*) 'Renormalized Weights ',wmax/weight,wmin/weight
    do i=1,nv
      if (we(i).gt.weight) then
        we(i) = visi(iw,i)/we(i)*weight
      elseif (we(i).gt.0.0) then
        we(i) = visi(iw,i)
      endif
    enddo
  else
    !
    ! No weighting column
    !
    ! Loop on U,V cells
    do icv = 1,nbcv
      vimin = (icv-1)*vstep+vmin-unif
      vimax = vimin+vstep+unif
      !
      ivmin = 1
      ivmax = nv
      call findp (nv,vv,vimin,ivmin)
      call findp (nv,vv,vimax,ivmax)
      !
      do icu = 1,nbcu
        uimin = (icu-1)*ustep+umin-unif
        uimax = uimin+ustep+unif
        !
        ! Select valid visibilities
        nbv = 0
        do i=ivmin,ivmax
          u = visi(jx,i)
          v = visi(jy,i)
          !
          ! Normal case only...
          if ((v.gt.vimin).and.(v.lt.vimax)) then
            if ((u.gt.uimin).and.(u.gt.uimax)) then
              nbv = nbv+1
              ipv(nbv) = i
              utmp(nbv)= u
              vtmp(nbv)= v
              wtmp(nbv)= 1.0   ! No weight channel
            endif
          endif
          !
          ! Limiting case near V=0, inverse the U test...
          if (-v.le.unif) then
            if ((u.lt.-uimin).and.(u.gt.-uimax)) then
              nbv = nbv+1
              ipv(nbv) = 0
              utmp(nbv)= u
              vtmp(nbv)= v
              wtmp(nbv)= 1.0   ! No weight channel
            endif
          endif
        enddo
        !
        ! Compute the weight density
        if (nbv.gt.0) then
          call doweig_sub (nbv,utmp,vtmp,wtmp, rtmp, unif)
          !
          ! IPV is a back pointer
          do i=1,nbv
            if (ipv(i).ne.0) we(ipv(i)) = rtmp(i)
          enddo
        endif
        !
      enddo
    enddo
    !
    call dowfact(nv,we,wfact)
    weight = wm*wfact
    do i=1,nv
      if (we(i).gt.weight) then
        we(i) = 1.0/we(i)
      elseif (we(i).gt.0.0) then
        we(i) = 1.0/weight
      endif
    enddo
  endif
end subroutine doweig_quick
!
subroutine doweig_sub (nv,uu,vv,ww,we,unif)
  !$ use omp_lib
  !----------------------------------------------------------------------
  ! @ private
  !
  !! IMAGER -- Compute weights of the visibility points.
  !----------------------------------------------------------------------
  integer, intent(in) :: nv          !! number of values
  real, intent(in) ::  uu(nv)        !! U coordinates
  real, intent(in) ::  vv(nv)        !! V coordinates
  real, intent(in) ::  ww(nv)        !! Input Weights
  real, intent(out) ::  we(nv)       !! Output weights
  real, intent(in) ::  unif          !! Cell size
  !!
  !$ logical, external :: ompget_debug_code
  !
  ! Local ---
  integer i,j
  real u,v,weight,v_aux
  integer :: ithread, mthread
  !
  ! Uniform weights only
  call imager_tree('DOWEIG_SUB',.false.)
  !
  mthread = 1
  !$  mthread = omp_get_max_threads()
  !$  if (ompget_debug_code()) Print *,'OMP Already parallel ',omp_in_parallel(),' Nesting ',omp_get_nested(), mthread
  !$OMP PARALLEL &
  !$OMP &   SHARED(ww,uu,vv),  &
  !$OMP &   PRIVATE(ithread,i,j,weight,u,v,v_aux)
  !
  !$OMP DO
  do i=1,nv
    if (ww(i).le.0.0) then
      we(i) = 0.0
    else
      weight = ww(i)
      u = uu(i)
      v = vv(i)
      j = i-1
      v_aux = v-unif
      do while (j.gt.0 .and. vv(j).gt.v_aux)
        if (abs(u-uu(j)).lt.unif) then
          if (ww(j).gt.0.0) weight = weight + ww(j)
        endif
        j = j-1
      enddo
      j = i+1
      v_aux = v+unif
      do while (j.le.nv .and. vv(j).lt.v_aux)
        if (abs(u-uu(j)).lt.unif) then
          if (ww(j).gt.0.0) weight = weight + ww(j)
        endif
        j = j+1
      enddo
      !
      ! Close to (U,V) = (0,0), take symmetry into account
      j = nv
      v_aux = -(v+unif)
      do while (j.gt.0 .and. vv(j).gt.v_aux)
        if (abs(u+uu(j)).lt.unif) then
          if (ww(j).gt.0.0) weight = weight + ww(j)
        endif
        j = j-1
      enddo
      we(i) = weight
    endif
  enddo
  !$OMP END DO
  !$OMP FLUSH
  !$OMP END PARALLEL
  call imager_tree('DOWEIG_SUB',.true.)
  !
end subroutine doweig_sub
!
subroutine doweig_slow (jc,nv,visi,jx,jy,jw,unif,we,wm)
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Compute weights of the visibility points.
  !
  !   Stupid, slow, version kept here for reference, but unused
  !
  !----------------------------------------------------------------------
  integer, intent(in) ::  nv          !! number of values
  integer, intent(in) ::  jc          !! Number of "visibilities"
  integer, intent(in) ::  jx          !! X coord location in VISI
  integer, intent(in) ::  jy          !! Y coord location in VISI
  integer, intent(in) ::  jw          !! Location of weights. If .LE.0, uniform weight
  real, intent(in) ::  visi(jc,nv)    !! Visibilities
  real, intent(in) ::  unif           !! uniform cell size in Meters
  real, intent(inout) ::  we(nv)      !! Weight array
  real, intent(in) ::  wm             !! on input: % of uniformity
  !
  ! Local ----
  integer i,j,iw
  real u,v,weight,wfact,v_aux
  !
  ! Code ----
  if (jw.gt.0) then
    ! There is a weight column
    iw = 7+3*jw
    !
    ! Uniform weights
    if (unif.gt.0) then
      do i=1,nv
        if (visi(iw,i).le.0.0) then
          we(i) = 0.0
        else
          weight = visi(iw,i)
          v = visi(jy,i)
          u = visi(jx,i)
          j = i-1
          v_aux = v-unif
          do while (j.gt.0 .and. visi(jy,j).gt.v_aux)
            ! unoptimized
            !                  do while (j.gt.0 .and. (v-visi(jy,j)).lt.unif)
            if (abs(u-visi(jx,j)).lt.unif) then
              if (visi(iw,j).gt.0.0)   &
     &                weight = weight + visi(iw,j)
            endif
            j = j-1
          enddo
          j = i+1
          v_aux = v+unif
          do while (j.le.nv .and. visi(jy,j).lt.v_aux)
            ! unoptimized
            !                  do while (j.le.nv .and. (visi(jy,j)-v).lt.unif)
            if (abs(u-visi(jx,j)).lt.unif) then
              if (visi(iw,j).gt.0.0)   &
     &                weight = weight + visi(iw,j)
            endif
            j = j+1
          enddo
          !
          ! Close to (U,V) = (0,0), take symmetry into account
          j = nv
          v_aux = -(v+unif)
          do while (j.gt.0 .and. visi(jy,j).gt.v_aux)
            ! unoptimized
            !                  do while (j.gt.0 .and. (-visi(jy,j)-v).lt.unif)
            if (abs(u+visi(jx,j)).lt.unif) then
              if (visi(iw,j).gt.0.)   &
     &                weight = weight + visi(iw,j)
            endif
            j = j-1
          enddo
          we(i) = weight
        endif
      enddo
      !
      call dowfact(nv,we,wfact)
      weight = wm*wfact
      do i=1,nv
        if (we(i).gt.weight) then
          we(i) = visi(iw,i)/we(i)*weight
        elseif (we(i).gt.0.0) then
          we(i) = visi(iw,i)
        endif
      enddo
    else
      !
      ! Natural weights
      do i=1,nv
        if (visi(iw,i).gt.0.0) then
          we(i) = visi(iw,i)
        else
          we(i) = 0.0
        endif
      enddo
    endif
  else
    !
    ! No weighting column
    if (unif.ge.0) then
      !
      ! Uniform weights
      do i=1,nv
        weight = 1
        v = visi(jy,i)
        u = visi(jx,i)
        j = i-1
        do while (j.gt.0 .and. (u-visi(jy,j)).lt.unif)
          if (abs(u-visi(jx,j)).lt.unif) then
            weight = weight + 1
          endif
          j = j-1
        enddo
        j = i+1
        do while (j.le.nv .and. (visi(jy,j)-v).lt.unif)
          if (abs(u-visi(jx,j)).lt.unif) then
            weight = weight + 1
          endif
          j = j+1
        enddo
        j = nv
        do while (j.ge.1 .and. (-visi(jy,j)-v).lt.unif)
          if (abs(u+visi(jx,j)).lt.unif) then
            weight = weight + 1
          endif
          j = j-1
        enddo
        we(i) = weight
      enddo
      !
      call dowfact(nv,we,wfact)
      weight = wm*wfact
      do i=1,nv
        if (we(i).gt.weight) then
          we(i) = 1.0/we(i)
        elseif (we(i).gt.0.0) then
          we(i) = 1.0/weight
        endif
      enddo
    else
      !
      ! Natural weighting
      we(1:nv) = 1.
    endif
  endif
end subroutine doweig_slow
!
subroutine dowei_icode(umax,umin,vmax,vmin,unif,mv,icode)
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Weighting routine
  !
  !   Get the sub-division for the UV cells for Robust weighting
  !!
  !---------------------------------------------------------------------
  real, intent(in) :: umax,umin     !! U range
  real, intent(in) :: vmax,vmin     !! V range
  real, intent(in) :: unif          !! Uniform cell size
  integer, intent(in) :: mv         !! Number of visibilities
  integer, intent(inout) :: icode   !! Number of sub-cells
  !
  ! Local ---
  real :: rboxes, density
  integer :: jcode, kcode
  character(len=120) :: chain
  !
  ! Code ----
  !
  ! Evaluate the average density
  rboxes = (umax-umin)/unif * (vmax-vmin)/unif
  !
  density = mv/rboxes
  ! Experimentally, that works very well
  kcode = nint(sqrt(density))
  ! But one should not make it too large as the buffer size scales 
  ! as Icode^2 - So check rboxes is not too large
  jcode = 2.0/sqrt(rboxes*16E-9) ! Allow a Maximum of 8 Gbyte memory
  rboxes = rboxes*4e-6           ! In MByte each
  write(chain,'(A,F8.1,A,I0,1X,I0,1X,I0,A,F8.1,A)') 'Box memory size ',rboxes, &
    & ' Mbytes -- Icode ',icode,kcode,jcode,'  (',real(mv)*1E-6,' Mega Visibilities)'
  call map_message(seve%d,'DOWEIG',chain)
  if (icode.eq.0) icode = kcode
  icode = min(icode,jcode)    
  !
  ! A minimum of 2 is required by the algorithm anyway...
  icode = max(2,icode)
end subroutine dowei_icode
