subroutine dotape (jc,nv,visi,jx,jy,taper,we)
  use gildas_def
  !----------------------------------------------------------------------
  ! @ public
  !
  ! MAPPING  Support for UV_MAP
  !     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
  integer iv
  real staper,etaper
  real u,v
  real cx,cy,sx,sy
  !
  if (taper(1).eq.0. .and. taper(2).eq.0.) return
  !
  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
end subroutine dotape
!
subroutine doweig (jc,nv,visi,jx,jy,jw,unif,we,wm,vv,error,code)
  use gildas_def
  use gkernel_interfaces
  use mapping_interfaces, except_this => doweig
  use gbl_message
  !----------------------------------------------------------------------
  ! @ public-mandatory
  !
  ! MAPPING   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
  real, intent(in) ::  wm             ! on input: % of uniformity
  real, intent(in) ::  vv(nv)         ! V values, pre-sorted
  logical, intent(inout) :: error
  integer, intent(in), optional :: code
  !
  integer i,iw
  real umin,umax,vmin,vmax,vstep,vimin,vimax
  real vcmin, vcmax
  integer nbcv, ivmin, ivmax, icv, nbv, new, nflag
  integer ier, icode
  character(len=message_length) :: chain
  !
  real my_wm
  real, allocatable :: my_we(:)
  !
  ! Natural weight
  nflag = 0
  if (unif.le.0.0 .or. wm.le.0.0) then
    if (jw.gt.0) then
      iw =7+3*jw
      do i=1,nv
        if (visi(iw,i).gt.0.0) then
          we(i) = visi(iw,i)
        else
          nflag = nflag+1
          we(i) = 0.0
        endif
      enddo
    else
      do i=1,nv
        we(i) = 1.0
      enddo
    endif
    if (nflag.ne.0) then
      write(chain,'(I12,A)') nflag,' flagged visibilities ignored'
      call map_message(seve%i,'DOWEIG',chain)
    endif
    return
  endif
  !
  if (present(code)) then
    icode = code
  else
    icode = -1
  endif
  !
  if (icode.ge.0) then
    iw = 7+3*jw
    !
    my_wm = wm
    allocate(my_we(nv),stat=ier)
    my_we = we(:)
    call doweig_sph (jc,nv,visi,jx,jy,iw,unif,my_we,my_wm,vv,error,code)
    we = my_we(:)
  else
    !
    ! Uniform weight
    !
    ! 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
    call doweig_quick (jc,nv,visi,jx,jy,jw,unif,we,wm,vv,nbv,   &
       &    umin,umax,vmin,vmax,nbcv)
    !!print *,'OLD after Unif ',unif,' WM ',wm
  endif
  !
end subroutine doweig
!
subroutine doweig_sph (jc,nv,visi,jx,jy,jw,unif,we,wm,vv,error,code)
  use gildas_def
  use gkernel_interfaces
  use mapping_interfaces, except_this => doweig_sph
  use gbl_message
  !----------------------------------------------------------------------
  ! @ public
  !
  ! MAPPING   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
  real, intent(in) ::  wm             ! on input: % of uniformity
  real, intent(in) ::  vv(nv)         ! V values, pre-sorted
  logical, intent(inout) :: error
  integer, intent(in), optional :: code  ! Number of sub-cells per UV uniform cell size
  !
  real, allocatable :: suu(:), svv(:), sww(:), swe(:)
  real :: weight, wmin, wmax, umin, umax, vmin, vmax
  real :: sizecell
  integer :: ier, mv, nbv, i, ivmin, icode
  character(len=120) :: mess
  character(len=*), parameter :: rname='DOWEIG'
  !
  ! For tests only
  logical :: briggs=.false.
  real :: s2
  !
  ! 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(visi(jw,:),0.0)    
  !
  ! Find out extrema
  vmin = svv(1)
  vmax = unif
  umin = minval(suu(1:nv))
  umax = maxval(suu(1:nv))
  !
  ! Brutally apply Hermiticity
  nbv = nv
  do i=ivmin,nv
    nbv = nbv+1
    suu(nbv) = -visi(jx,i)
    svv(nbv) = -visi(jy,i)
    sww(nbv) = max(visi(jw,i),0.0)   
  enddo
  !
  ! Sub-divide the uniform cell size into sub-cells for speed
  ! The optimal depends on the density of UV points.
  ! In principle, it would depend on umin,umax, vmin,vmax and the
  ! number of points.  Use a stupid rule-of-thumb for now.
  !
  if (present(code).and.code.gt.0) then
    icode = max(2,code)
  else
    if (mv.le.2e5) then
      icode = 3
    else if (mv.le.1e6) then
      icode = 7
    else if (mv.le.5e6) then
      icode = 15
    else
      icode = 20
    endif
  endif
  sizecell = unif/icode
  !
  write(mess,'(A,I0,F6.1,F6.1)') "Gridding for ", mv, sizecell, unif
  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(mv,sizecell,unif,suu,svv,sww,swe, &
    umin,umax,vmin,vmax,error)
  if (error) return
  !
  we(:) = swe(1:nv)
  !
  weight = 0.0
  wmax = 0.0
  wmin = 1.e36
  do i=1,nv
    if (we(i).gt.0.0) then
      wmin = min(we(i),wmin)
      wmax = max(we(i),wmax)
    endif
  enddo
  weight = sqrt(wmin*wmax)
  write(mess,'(A,2(1PG11.3,1X))') 'Relative Weight range ',wmin/weight,wmax/weight
  call map_message(seve%i,rname,mess)
  !
  if (briggs) then
    !
    ! Briggs Solution
    ! s = 5*10^(-Briggs)  with (typically) -2 < Briggs < 2
    !
    ! Experimentally, not as flexible as our default solution
    s2 = 5*10**(-wm)    ! s^2
    s2 = s2*s2
    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
  else
    !
    ! S.Guilloteau solution
    weight = wm*weight
    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
  endif
  !
end subroutine doweig_sph
!
subroutine gridless_density (npts,sizecell,distmax,evex,evey,eveweight,&
  & evesumweight,xmin,xmax,ymin,ymax,error)
  use gildas_def
  use mapping_interfaces, except_this => gridless_density
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   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
  !
  !----------------------------------------------------------------------
  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
  !
  ! Local
  integer(kind=4) :: nbboxx,nbboxy,nbbox,i,j,indice1,indice2
  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
  !
  error = .false.
  !
  distmaxsq = distmax*distmax
  evesumweight = 0
  !
  nbboxx = ceiling( (xmax-xmin) / sizecell)
  nbboxy = ceiling( (ymax-ymin) / sizecell)
  nbbox = nbboxx * nbboxy
  !
  ! Required elements
  error = .true.
  allocate(boxx(nbboxx),boxy(nbboxy),boxtotweight(nbboxx,nbboxy),stat=ier)
  if (ier.ne.0) return
  allocate(firstevent(nbboxx,nbboxy),nextevent(npts),stat=ier)
  if (ier.ne.0) return
  ! Potentially avoidable arrays
  allocate(eveindx(npts),eveindy(npts),boxnbevent(nbboxx,nbboxy),stat=ier)
  if (ier.ne.0) return
  ! Work array
  allocate(last(nbboxx,nbboxy),stat=ier)
  if (ier.ne.0) return
  error = .false.
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  ! 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)
  !
  ! 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
  allocate(statebox(nbcellmaxx,nbcellmaxy))
  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
  !
  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
  !
  ! 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
  !
  do i = 1, nbboxx
    do j = 1, nbboxy
      if (boxnbevent(i,j).GT.0) then
        call linkidenticalbox(boxnbevent(i,j),firstevent(i,j),boxtotweight(i,j), &
        & evesumweight,nextevent)
        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), &
                      & evesumweight,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), &
                      & evesumweight, 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), &
                      & evesumweight,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), &
                      & evesumweight, eveweight, evex, evey, nextevent, &
                      & distmax, distmaxsq)
                  endif
                endif
              endif
            endif
          enddo
        enddo
      endif
    enddo
  enddo
  !
  deallocate(statebox)
  deallocate(boxx,boxy,boxtotweight)
  deallocate(firstevent,nextevent)
  deallocate(eveindx,eveindy,boxnbevent)
  !
end subroutine gridless_density
!
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
  !
  ! MAPPING
  !   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
  !
  ! MAPPING
  !   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
  use mapping_interfaces, only : calcdistsq
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   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
!
subroutine scawei (nv,uni,ori,wall)
  !---------------------------------------------------------
  ! @ public
  !
  ! MAPPING
  !   Scale the 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
  !
  ! MAPPING
  !   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 gildas_def
  use gbl_message
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !     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(out) :: umin,umax,vmin,vmax
  !
  ! Automatic arrays
  integer, allocatable :: ipv(:)
  real, allocatable :: utmp(:), vtmp(:), wtmp(:), rtmp(:)
  !
  integer i,iw
  real u,v,weight,wmax,wmin
  !
  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
  character(len=*), parameter :: rname='DOWEIG'
  !
  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
    weight = 0.0
    wmax = 0.0
    wmin = 1.e36
    do i=1,nv
      wmax = max(we(i),wmax)
      if (we(i).gt.0.0) wmin = min(we(i),wmin)
      weight = weight+we(i)
    enddo
    weight = weight/nv
    !!write(6,*) 'Raw Weights ',weight,wmax,wmin,sqrt(wmin*wmax)*wm
    weight = wm*sqrt(wmin*wmax)
    !!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
    !
    weight = 0.0
    wmax = 0.0
    wmin = 1.e36
    do i=1,nv
      wmax = max(we(i),wmax)
      if (we(i).gt.0.0) wmin = min(we(i),wmin)
      weight = weight+we(i)
    enddo
    weight = weight/nv
    !!write(6,*) 'Raw Weights ',weight,wmax,wmin,sqrt(wmin*wmax)*wm
    weight = wm*sqrt(wmin*wmax)
    !!write(6,*) 'Renormalized Weights ',wmax/weight,wmin/weight
    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
  !
  ! MAPPING
  !     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
  !
  integer i,j
  real u,v,weight,v_aux
  integer :: ithread, mthread
  !
  ! Uniform weights only
  mthread = 1
  !$  mthread = omp_get_max_threads()
  !!$  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
end subroutine doweig_sub
!
subroutine doweig_slow (jc,nv,visi,jx,jy,jw,unif,we,wm)
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !     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
  real, intent(in) ::  wm             ! on input: % of uniformity
  !
  integer i,j,iw
  real u,v,weight,wmax,wmin,v_aux
  !
  ! There is a weight column
  if (jw.gt.0) then
    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
      !
      weight = 0.0
      wmax = 0.0
      wmin = 1.e36
      do i=1,nv
        wmax = max(we(i),wmax)
        if (we(i).gt.0.0) wmin = min(we(i),wmin)
        weight = weight+we(i)
      enddo
      weight = weight/nv
      write(6,*) 'Weights ',weight,wmax,wmin,   &
     &        sqrt(wmin*wmax)*wm
      weight = wm*sqrt(wmin*wmax)
      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
      !
      weight = 0.0
      wmax = 0.0
      wmin = 1.e36
      do i=1,nv
        wmax = max(we(i),wmax)
        if (we(i).gt.0.0) wmin = min(we(i),wmin)
        weight = weight+we(i)
      enddo
      weight = weight/nv
      write(6,*) 'Weights ',weight,wmax,wmin,   &
     &        sqrt(wmin*wmax)*wm
      weight = wm*sqrt(wmin*wmax)
      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
      do i=1,nv
        we(i) = 1.0
      enddo
    endif
  endif
end subroutine doweig_slow
