subroutine mosaic_uvmap_sault(task,line,error)
  !$ use omp_lib
  use gkernel_interfaces
  use imager_interfaces, except_this=>mosaic_uvmap_sault
  use clean_def
  use clean_arrays
  use clean_types
  use clean_default
  use clean_beams 
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- 
  !     Support for command UV_MAP, Mosaic case, SAULT method
  !
  !   Compute a Mosaic from a UV Table, Phase (ideally) or Pointing
  !   (for historical reasons) Offsets information.
  !
  ! Input quantities :  
  !     a Mosaic UV table with Phase or Pointing offset information.  
  !     its associated Mosaic table.
  !
  !   NX NY are the mosaic image sizes  
  !   FX FY are the Field image sizes   
  !   NC is the number of channels   
  !   NF is the number of different frequencies  
  !   NP is the number of pointing centers  
  !   NB is the number of frequency-dependent beam cubes  
  !
  ! Now, we obtain
  !   HDirty      a 3-d cube containing the uniform noise
  !              combined mosaic, i.e. the sum of the product
  !               of the fields by the primary beam. (NX,NY,NC)
  !   HBeam       a 4-d cube where each cube contains the synthesised
  !               beam for one field (NX,NY,NB,NP)
  !   HPrim       the primary beams pseudo-cube (NP,NX,NY,NB)
  !
  ! Ideally, only the Dirty image should be large. 
  ! Dirty and Primary beams can be smaller, with the Pixel shifts
  ! stored in the POINTINGS table.
  !
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: task  !! Caller (MOSAIC)
  character(len=*), intent(in) :: line  !! Command line
  logical, intent(out) :: error         !! Logical error flag
  !
  ! Constants
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: sec_in_rad = pi/3600d0/180d0
  real(8), parameter :: f_to_k = 2.d0*pi/299792458.d-6
  character(len=*), parameter :: rname='UV_SAULT'
  logical, parameter :: subtract=.true.
  !
  ! Local ---
  type(channel_par) :: channels
  character(len=80) :: mess
  real, allocatable :: w_mapu(:), w_mapv(:), w_grid(:,:)
  real(8) newabs(3)
  real(4) rmega,uvmax,uvmin,uvma
  integer wcol,mcol(2),nfft,sblock
  integer ier
  logical one, sorted
  character(len=message_length) :: chain
  real cpu0, cpu1
  real(8) :: freq
  real, allocatable :: fft(:)
  real, allocatable :: noises(:)
  integer :: nu   ! Local size of a visibility
  integer :: mu   ! Global size of a visibility
  integer :: nc   ! Number of channels
  integer :: mp   ! Total number of fields
  integer :: np   ! Selected number of pointings
  !
  integer :: debug
  logical :: abort
  type(gildas) :: htmp, pdirty, pbeam, local_huv
  real :: btrunc, bsize(10), beamsize 
  !
  real, allocatable, target :: dmap(:,:,:), dtmp(:,:,:,:)
  real, allocatable :: dtrunc(:,:)
  real, allocatable :: doff(:,:)
  integer, allocatable :: teles(:)
  real, pointer :: my_dirty(:,:,:)        ! Global dirty cube
  real, allocatable :: ic_dirty(:,:)      ! Local plane dirty image
  !
  real :: xm, xp, off_range(2)
  integer :: ifield, jfield, jc, fstart, fend
  integer :: ib, nb, old_ib
  integer, parameter :: o_trunc=1
  integer, parameter :: o_field=2
  type(projection_t) :: proj
  real(8) :: pos(2)
  !
  logical :: per_field
  integer(kind=8) :: ram_map, ram_uv, ram_beam
  integer :: nthread, othread, ithread
  logical :: omp_nested
  logical :: do_jvm, do_cct
  real :: jvm_factor
  !
  integer :: ndim, nn(2)
  integer(kind=index_length) :: dim(4)
  complex, allocatable :: comp(:,:)
  !
  real, allocatable :: gfield_w(:)              ! Per field Weights 
  real, allocatable, target :: dfield_uv(:,:)   ! Per field Visibilites
  integer :: idcol          ! ID column number
  integer :: im,ip,jm,jp    ! Input Subset ranges of Field in Dirty sky map
  integer :: km,kp,lm,lp    ! Output Subset ranges of Field in Dirty sky map
  integer :: nx,ny          ! Size of a single field image/beam
  integer :: mx,my          ! Size of dirty sky cube
  integer :: kx,ky          ! Final size of beam cube
  integer :: mv             ! Total Number of visibilities
  integer :: nv             ! per field number of visibilities
  real :: cs(2)             ! Rotation matrix
  real(8) :: dxy(2,1)       ! Per field offset 
  real(4) :: rxy(2,1)       ! Idem, but Real*4
  real(8) :: a0,d0,ap,dp
  !
  logical :: slow
  integer :: ksign=-1       ! Sign of phase correction
  !
  real, allocatable :: dtmp_uv(:,:)
  real, allocatable, target :: ccou(:,:,:)  ! Clean component list
  real, pointer  :: fcou(:,:,:)             ! possibly compressed component list
  integer, allocatable :: omic(:), nmic(:)
  integer :: maxic, icmax,  fcol, lcol, nchan, ic, lc
  integer :: it ! Debug only
  !
  real, pointer :: fctmp(:,:,:)
  real, allocatable :: duv_tmp(:,:)
  integer(kind=index_length) :: iv
  integer :: chunk, oic, olc
  integer :: itrail, nvisi
  real :: bstep ! Words per image pixel
  !-------------------------------------------------------------------------
  ! 
  ! Code ----
  debug = 0
  call sic_get_inte('DEBUG_'//task,debug,error)
  Print *,'Debug DEBUG_'//task, debug
  !
  error = .false.
  call imager_tree(rname,.false.)
  !
  ! A few debug (obsolescent) controls for debugging
  if (mosaic_enlarge.lt.0 .or. mosaic_enlarge.gt.2) mosaic_enlarge = 2
  ksign = -1
  call sic_get_inte('KSIGN',ksign,error) ! For debug only Ksign = -1 is the solution
  !
  !
  if (huv%mos%nfields.gt.1) then
    idcol = huv%gil%column_pointer(code_uvt_id)
  else
    idcol = 0
  endif
  !
  wcol = 0
  abort = .false.
  !
  do_cct = task.eq.'MOSAIC_RESTORE' 
  do_jvm = do_cct .and. beam_defined
  !
  ! Get beam size from data or command line
  call sic_get_real('MAP_TRUNCATE',btrunc,error)
  if (error) return
  write(chain,'(A,F4.2,1X,F4.2)') 'Truncation level ',default_map%truncate, btrunc
  call map_message(seve%i,task,chain,3)
  bsize = 0  ! Must be initialized
  if (sic_present(o_trunc,0)) then
    call get_bsize(huv,rname,line,bsize,error,OTRUNC=o_trunc,BTRUNC=btrunc)
  else
    call get_bsize(huv,rname,line,bsize,error,BTRUNC=btrunc)
  endif
  if (error) return
  beamsize = maxval(bsize)
  write(chain,'(a,f10.2,a,f6.0,a)') 'Correcting for a beam size of ',&
    & beamsize/pi*180*3600,'" down to ',100*btrunc,'% '
  call map_message(seve%i,rname,chain)
  !
  call map_prepare(task,huv,themap,error)
  if (error) return
  if (debug.gt.1) Print *,'Done MAP_PREPARE  Fields ',huv%mos%nfields
  !
  one = .true.  
  call uvmap_cols(rname,line,huv,channels,error)
  if (error) return 
  if (debug.gt.1) Print *,'Done UVMAP_COLS Fields ',huv%mos%nfields, allocated(huv%mos%fields)
  mcol = channels%bounds
  wcol = channels%weight
  !
  mp = abs(themap%nfields) ! Number of pointings
  !
  ! Define Visibility expansion for Continuum data
  nvisi = 0
  do jfield=1,mp
    nvisi = nvisi + huv%mos%fields(jfield)%nvisi
  enddo
  if (huv%gil%nvisi.ne.nvisi*expand_cont) then
    expand_cont = huv%gil%nvisi / nvisi
    write(chain,'(A,I0,A,I0)') 'Set EXPAND_CONT to ',expand_cont,' Number of visi ',nvisi*expand_cont
    call map_message(seve%i,rname,chain,1)
  endif
  !
  ! Select Fields first
  if (.not.do_cct) then
    call sic_delvariable('FIELDS%N_SELECT',.false.,error)
    call sic_delvariable('FIELDS%SELECTED',.false.,error)
    error = .false.
    !
    ! Get the field lists from the /FIELDS option if any
    if (allocated(selected_fields)) deallocate(selected_fields)
    selected_fieldsize = 0
    if (sic_present(o_field,0)) then
      call select_fields(rname,line,o_field,mp,np,selected_fields,error)
      if (error) return
      selected_fieldsize = np
      call sic_def_inte('FIELDS%N_SELECT',selected_fieldsize,0,0,.true.,error)
      dim(1) = selected_fieldsize
      call sic_def_inte('FIELDS%SELECTED',selected_fields,1,dim,.true.,error) 
    endif
  else if (selected_fieldsize.ne.0) then
    write(chain,'(A,I0,A,20(1X,I0))') 'Restoring only ',selected_fieldsize, &
    & ' Fields: ',selected_fields(1:min(20,selected_fieldsize))
    call map_message(seve%i,rname,chain,3)
    np = selected_fieldsize
  else
    np = mp
  endif  
  if (selected_fieldsize.eq.0) then
    np = mp
    if (allocated(selected_fields)) deallocate(selected_fields)
    allocate(selected_fields(mp),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation on Selected Fields')
    endif
    do jfield=1,np
      selected_fields(jfield) = jfield
    enddo
  endif
  !
  call gag_cpu(cpu0)
  !
  call uvgmax(huv,duv,uvmax,uvmin)
  if (debug.gt.1) Print *,'Done UVGMAX ',uvmax,uvmin
  freq = gdf_uv_frequency(huv)
  uvmin = uvmin*freq*f_to_k
  uvmax = uvmax*freq*f_to_k
  !
  mp = abs(themap%nfields) ! Number of fields
  xm = minval(huv%mos%fields(:)%opoint(1))
  xp = maxval(huv%mos%fields(:)%opoint(1))
  off_range(1) = xp-xm
  xm = minval(huv%mos%fields(:)%opoint(2))
  xp = maxval(huv%mos%fields(:)%opoint(2))
  off_range(2) = xp-xm
  !
  ! Point or Phase ?
  allocate(doff(2,mp),teles(mp),stat=ier)
  doff(1,1:mp) = huv%mos%fields(:)%opoint(1)
  doff(2,1:mp) = huv%mos%fields(:)%opoint(2)
  teles(1:mp) = huv%mos%fields(:)%jteles
  !
  ! Never sort, never touch the UV data here
  sorted = .true.
  if (.not.sorted) then
    ! ! Print *,'Done mosaic_sort UV range ',uvmin,uvmax,' sorted ',sorted
    ! ! call uv_dump_buffers('UV_MOSAIC')
    ! Redefine SIC variables (mandatory)
    ! Caution: this overrides command line pointers
    call map_uvgildas ('UV',huv,error,duv) 
  else
    ! ! Print *,'Mosaic was sorted ',uvmin,uvmax,' sorted ',sorted
  endif
  !
  nv = huv%mos%fields(ifield)%nvisi * expand_cont          ! Number of visibilities
  !
  call gag_cpu(cpu1)
  write(chain,102) 'Finished sorting ',cpu1-cpu0
  call map_message(seve%i,task,chain)
  !
  ! Get map parameters
  call map_parameters(task,themap,huv,freq,uvmax,uvmin,error,print=.true.)
  if (error) return
  uvma = uvmax/(freq*f_to_k)
  !
  themap%xycell = themap%xycell*pi/180.0/3600.0
  !
  ! Get work space, ideally before mapping first image, for
  ! memory contiguity reasons.
  !
  ! Dirty sky size
  mx = themap%size(1)
  my = themap%size(2)
  ! Per field size
  kx = nint(abs(field_size*beamsize/themap%xycell(1)))
  call gi4_round_forfft(kx,nx,error,map_rounding,map_power)
  nx = min(nx,mx)
  nx = min(nx,my)
  ny = nx
  write(mess,'(A,I0,A,I0,A,I0,A,I0,A)') 'Field size [',nx,',',ny, &
    & ']  -- Map size [',mx,',',my,']'
  call map_message(seve%i,task,mess,1)
  !
  ! Visibility size and range
  mu = huv%gil%dim(1)  
  mv = huv%gil%nvisi     ! not huv%gil%dim(2)
  nc = mcol(2)-mcol(1)+1 ! not huv%gil%nchan
  nu = mu-2              ! Remove the trailing columns... Why only 2 ???
  !
  allocate(w_mapu(nx),w_mapv(ny),w_grid(nx,ny),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,task,'Gridding allocation error')
    goto 98
  endif
  !
  do_weig = .true.
  if (do_weig) then
    call map_message(seve%i,task,'Computing weights (Sault)')
    if (allocated(g_weight)) deallocate(g_weight)
    allocate(g_weight(mv),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,task,'Weight allocation error')
      goto 98
    endif
  else
    call map_message(seve%i,task,'Re-using weights')
  endif
  nfft = 2*max(nx,ny)
  allocate(fft(nfft),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,task,'FFT allocation error')
    goto 98
  endif
  !
  rmega = 8.0
  ier = sic_ramlog('SPACE_IMAGER',rmega)
  sblock = max(int(256.0*rmega*1024.0)/(nx*ny),1)
  !
  ! New Beam place
  if (allocated(dbeam)) then
    call sic_delvariable ('BEAM',.false.,error)
    deallocate(dbeam)
  endif
  call gildas_null(hbeam)
  !
  ! New dirty image
  allocate(dmap(nx,ny,nc),dtrunc(nx,ny),ic_dirty(mx,my),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,task,'Map allocation error')
    goto 98
  endif
  !
  if (.not.do_cct) then
    if (allocated(ddirty)) then
      call sic_delvariable ('DIRTY',.false.,error)
      deallocate(ddirty)
    endif
    allocate(ddirty(mx,my,nc),stat=ier)
    my_dirty => ddirty
  else
    if (allocated(dresid)) then
      call sic_delvariable ('RESIDUAL',.false.,error)
      deallocate(dresid)
    endif
    allocate(dresid(mx,my,nc),stat=ier)
    my_dirty => dresid
  endif
  if (ier.ne.0) then
    call map_message(seve%e,task,'Map allocation error')
    goto 98
  endif
  !
  call gildas_null(hdirty)
  hdirty%gil%ndim = 3
  hdirty%gil%dim(1:3) = (/nx,ny,nc/)
  !
  ! Compute the primary beams and weight image
  call gildas_null(hprim)
  if (allocated(dprim)) then
    call sic_delvariable ('PRIMARY',.false.,error)
    deallocate(dprim)
  endif
  if (allocated(dfields)) then
    deallocate(dfields)
  endif
  !
  if (debug.gt.1) Print *,'Done MAP_BEAMS ',themap%beam,nb
  !
  ! Find out how many beams are required
  call define_beams(rname,themap%beam,nx,ny,huv,mcol,nb,error)
  if (error) return
  ! Define the map characteristics
  call mosaic_headers(rname,themap,huv,hbeam,hdirty,hprim,nb,np,mcol)
  !
  ! Re-size the per-field data
  hprim%gil%dim(2:3) = [nx,ny]
  hprim%gil%ref(2) = nx/2+1
  hprim%gil%ref(3) = ny/2+1
  hprim%gil%inc(1) = 1
  !
  hbeam%gil%dim(1:2) = [nx,ny]
  hbeam%gil%ref(1) = nx/2+1
  hbeam%gil%ref(2) = ny/2+1
  !
  hdirty%gil%dim(1:2) = [nx,ny]
  hdirty%gil%ref(1) = nx/2+1
  hdirty%gil%ref(2) = ny/2+1
  !
  write(chain,'(A,I0,A,I0,A)') 'Imaging channel range [',mcol(1),',',mcol(2),']'
  call map_message(seve%i,task,chain)
  !
  ! Check if Weights have changed by MCOL choice
  if (any(saved_chan%bounds.ne.mcol)) do_weig = .true. ! Useless ???? NEW !!!! At least mis-placed
  saved_chan%bounds = mcol
  !
  ! Define the projection about the Phase center
  call gwcs_projec(huv%gil%a0,huv%gil%d0,huv%gil%pang,huv%gil%ptyp,proj,error)
  !
  ! POS is here the Offset of the Pointing center relative to the Phase center
  ! (This may be Zero in most cases) 
  call abs_to_rel (proj,huv%gil%ra,huv%gil%dec,pos(1),pos(2),1)
  !
  ! Code ready and now tested for several channels per Beam
  hbeam%gil%ndim = 4
  hbeam%gil%dim(1:4)=(/nx,ny,nb,np/)
  !
  ! Small memory Foot print case
  allocate (dtmp(nx,ny,nb,1), dbeam(nx,ny,np,nb), dprim(np,nx,ny,nb), stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,task,'NB>1 Primary beam allocation error')
    goto 98
  endif
  !
  ! For things to work, doff & pos must be related to the fractional 
  ! pixel offset only at this stage 
  !
  ! Re-compute the offsets ...
  newabs = [huv%gil%a0,huv%gil%d0,huv%gil%pang]
  call change_fields(rname,abs(themap%nfields),huv%mos%fields,newabs,error)
  ! Get the shifts and fractions
  call fraction_fields(rname,huv%mos%fields,themap,mx,my,nx,ny,error)
  !
  ! The indirection on Selected Fields is done in Primary_Mosaic
  do ifield = 1,mp
    doff(1,ifield) = huv%mos%fields(ifield)%oxy(1)
    doff(2,ifield) = huv%mos%fields(ifield)%oxy(2)
    teles(ifield) = huv%mos%fields(ifield)%jteles
  enddo
  ! Pos MUST be zero in fact (except for Pointing Mosaics ???)
  pos = 0
  ! 
  hprim%r4d => dprim
  call primary_mosaic(line,np,hprim,hdirty,selected_fields, &
	& selected_fieldsize,doff,pos,teles,bsize,error)
  if (error) return
  call map_message(seve%i,rname,'Done Primary Beams')
  hprim%gil%inc(1) = btrunc  ! Convention to store the truncation level
  hprim%gil%extr_words = 2
  hprim%gil%rmin = 0.
  hprim%gil%rmax = 1.
  !
  ! Loop on fields for imaging
  ! Use Dtmp and Dmap as work arrays for beam and image
  hbeam%r3d => dtmp(:,:,:,1)
  hbeam%gil%dim(4) = 1
  !
  ! In Parallel part, DMAP will be copied per Thread
  ! So we have to verify that the Parallel mode actually fits into Memory
  !
  othread = 1  
  !$ othread = omp_get_max_threads()
  !
  ! Verify memory requirements - Must be adjusted more seriously, considering
  !   Private vs Shared arrays
  ram_uv = huv%gil%dim(1)*huv%gil%dim(2)/512/512
  ram_map = 2*hdirty%gil%dim(1)*hdirty%gil%dim(2)*hdirty%gil%dim(3)/512/512
  ram_beam = 2*hbeam%gil%dim(1)*hbeam%gil%dim(2)*hbeam%gil%dim(3)*hbeam%gil%dim(4)/512/512
!    Print *,'   RAM Map ',ram_map,hdirty%gil%dim(1:4)    Print *,'   RAM Beam ',ram_beam,hbeam%gil%dim(1:4)
  ram_map = ram_map+ram_beam
  !
  nthread = min(othread,np)
  if (ram_map*nthread.gt.sys_ramsize) nthread = nint(real(sys_ramsize)/real(ram_map))
  nthread = max(nthread,1) ! Just in case
  ram_map = ram_map * min(nthread, np)
  !
  if (ram_map.gt.0.2*sys_ramsize) then
    write(chain,'(A,F8.1,A,F8.1,A,F8.1,A)') 'Data size (UV ',1d-3*ram_uv,& 
      & 'GB + Map ',1D-3*ram_map, &
      & 'GB), available RAM (',1d-3*sys_ramsize,' GB)'
    call map_message(seve%w,rname,chain,3)
    if (ram_map.gt.sys_ramsize) then
      call map_message(seve%e,'Data size exceeds RAM',chain,3)
      error = .true.
      return
    endif
  endif
  !
  per_field = .false.  ! Make sure it is initialized
  !
  !$ call ompset_thread_nesting(rname, nthread, othread, omp_nested)    
  !$ nthread = ompget_outer_threads()
  if (nthread.gt.1) then
    per_field = .true.    
    write(chain,'(A,I0,A,I0,A)') 'Using per-field parallel mode. - Threads ',nthread,' Fields ',np
    call map_message(seve%i,rname,chain,3)
  endif
  !
  hdirty%r3d => dmap
  !
  my_dirty = 0.
  ic_dirty = 0.
  allocate(noises(np))  ! To remember the noise
  abort = .false.
  if (sic_ctrlc()) then
    error = .true.
    call map_message(seve%e,rname,'Aborted by user')
    return
  endif
  !
  ! Compress the Clean Component List if needed
  fcol = mcol(1)
  lcol = mcol(2)
  nchan = lcol-fcol+1
  !
  if (do_cct) then
    !
    allocate (omic(nchan),nmic(nchan),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,task,'Memory allocation error')
      error = .true.
      return
    endif
    !
    ! Compact the Clean components first
    ic = fcol
    lc = lcol
    hcct%r3d => dcct
    call uv_clean_sizes(hcct,hcct%r3d,omic,ic-fcol+1,lc-fcol+1)
    icmax = maxval(omic)
    if (debug.gt.1) Print *,'U-DEBUG, Max number of clean components ',icmax
    !
    ! Nothing to do if no Clean component
    if (icmax.eq.0) then
      call map_message(seve%w,task,'No valid Clean Component')
      return
    endif  
    !
    ! Spatially compress the Clean Component List
    allocate(ccou(3,icmax,nchan),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,task,'Memory allocation error')
      error = .true.
      return
    endif
    if (debug.gt.2) Print *,'U-DEBUG, uv_squeeze_clean ',nchan,omic,ic,lc
    call uv_squeeze_clean(nchan,hcct%r3d,ccou, omic,ic,lc)
    if (debug.gt.2) Print *,'U-DEBUG, Done uv_squeeze_clean' 
    ! 
    ! Remember the Full Clean Component List size
    nmic(:) = omic
    !
    ! TRICKY !...
    if (beamsize.ne.0) then  ! This indicates a restoration process  ?
      maxic = maxval(omic)
      write(chain,'(A,I0,A,I0,A)') 'Compressing CCT from ',icmax,' to ',maxic,' components'
      call map_message(seve%i,task,chain)
    endif
    freq = gdf_uv_frequency(huv,0.5d0*(ic+lc))
    !
  endif
  !
  !
  if (per_field) then
    write(chain,'(A,I0,A,I0,A)') 'Starting per-field parallel loop on channel range [', &
      & mcol(1),'-',mcol(2),']'
    call map_message(seve%i,rname,chain)
  else
    call map_message(seve%i,rname,'Using per-Plane parallelism')
  endif
  !
  slow = .true.   ! Small number of visibilities per field ?
  ! FFTW plan 
  ndim = 2
  nn(1) = nx !! hdirty%gil%dim(1)
  nn(2) = ny !! hdirty%gil%dim(2)
  allocate(comp(nx,ny),stat=ier)
  if (ier.ne.0) then
    write(chain,'(A,I0,A,I0)') 'FFT Allocation error IER ',ier
    call map_message(seve%e,task,chain)
    error = .true.
    return
  endif
  call fourt_plan(comp,nn,ndim,-1,1)
  cs = [1.,0.]
  a0 = huv%gil%a0
  d0 = huv%gil%d0
  !
  ! Resize the Map
  themap%size = [nx,ny]
  !
  ! Compute Chunk Size.  Nthread should depend on per_field logic
  if (do_cct) then
    bstep = 0.1                  ! Small memory imprint
    if (.not.slow) bstep = 2     ! 1 complex word
    mx = (hcct%gil%convert(1,1)-1)*2
    my = (hcct%gil%convert(1,3)-1)*2
    call uv_get_block(.not.slow,mx,my,nc,nthread,bstep,chunk)
    call map_message(seve%w,task,'FFT Clean subtraction still under test',3) 
  endif
  itrail = -huv%gil%lcol + huv%gil%dim(1) 
  !
  !$OMP PARALLEL DEFAULT(none) if (per_field) NUM_THREADS (nthread) &
  !$OMP   & SHARED(np,debug,task,themap,huv,dprim,dbeam,my_dirty) & 
  !$OMP   & SHARED(hdirty,hbeam,idcol,hcct) &
  !$OMP   & SHARED(selected_fields, noises, nthread) &
  !$OMP   & SHARED(nx,ny,nu,mu,nc,mv,duv,channels,sblock,cpu0,uvma,btrunc,abort) &
  !$OMP   & SHARED(g_weight,beams_param,do_jvm,cs,doff,a0,d0,mx,my) &
  !$OMP   & SHARED(do_cct,nmic,ccou,bsize,nchan,slow,ic,lc,freq,maxic,ksign) &
  !$OMP   & PRIVATE(local_huv,dtmp_uv,omic,fcou) &
  !$OMP   & PRIVATE(pdirty,pbeam,dfield_uv,gfield_w,ic_dirty) &
  !$OMP   & PRIVATE(fstart,fend,nv,do_weig,error,chain,ier)     &
  !$OMP   & PRIVATE(old_ib,jc,ib,dtrunc,dmap,dtmp, ithread, km,kp,lm,lp)     &
  !$OMP   & PRIVATE(dxy,rxy,ap,dp,jvm_factor,im,ip,jm,jp,ifield,jfield,beamsize) &
  !$OMP   & SHARED(itrail,chunk, expand_cont) PRIVATE(oic,olc,duv_tmp,fctmp)
  !
  ithread = 1
  !$ ithread = omp_get_thread_num()+1
  call gildas_null(pdirty)
  call gildas_null(pbeam)
  call gildas_null(local_huv,type='UVT')
  call gdf_copy_header(hdirty,pdirty,error)
  call gdf_copy_header(hbeam,pbeam,error)
  call gdf_copy_header(huv,local_huv,error)
  local_huv%gil%dim(1) = nu
  !
  !$OMP DO
  do jfield = 1,np
    write(chain,'(A,I0,A,I0,A,I0)') 'Starting FIELD ',jfield,' Size ',nu,' x ',nv
    call map_message(seve%t,task,chain)
    if (sic_ctrlc()) then
      abort = .true.
    endif
    if (abort) cycle ! Quick jump if Abort (EXIT not allowed in Parallel mode)
    !
    ifield = selected_fields(jfield)
    !
    ! Extract the specified field
    nv = huv%mos%fields(ifield)%nvisi * expand_cont          ! Number of visibilities
    if (.not.do_cct) then
      ! Imaging of whole data 
      allocate(dfield_uv(nu,nv),gfield_w(nv),stat=ier)
      if (ier.ne.0) then
        write(chain,'(A,I0,A,I0)') 'Allocation error IER ',ier,' Field ',ifield
        call map_message(seve%e,task,chain)
        abort = .true.
        cycle
      endif
      call sault_extract_field(duv,mu,mv,nu,idcol,g_weight, &
        & ifield,dfield_uv,gfield_w,nv)
    else
      ! Imaging of Residuals
      if (beamsize.ne.0) then
        allocate(fcou(3,maxic,nchan),stat=ier)
        if (ier.ne.0) then
          call map_message(seve%e,task,'Memory allocation error')
          error = .true.
          cycle
        endif
      else
        fcou => ccou
      endif
      !
      ! Need an intermediate array
      allocate(dfield_uv(nu,nv),gfield_w(nv),dtmp_uv(nu,nv),stat=ier)
      if (ier.ne.0) then
        write(chain,'(A,I0,A,I0)') 'Allocation error IER ',ier,' Field ',ifield
        call map_message(seve%e,task,chain)
        abort = .true.
        cycle
      endif
      !
      ! And one more for FFTs
      if (.not.slow) then
        allocate(duv_tmp(7+3*chunk+itrail,nv),stat=ier) !! kvend-kvstart+1),stat=ier)
        if (ier.ne.0) then
          call map_message(seve%e,task,'FFT memory allocation error')
          abort = .true.
          cycle
        endif
      endif
      !
      ! Extract the Field
      call sault_extract_field(duv,mu,mv,nu,idcol,g_weight, &
        & ifield,dtmp_uv,gfield_w,nv)
      local_huv%gil%nvisi = nv
      local_huv%gil%dim(2) = nv
      !
      ! The Clean Components are in Offsets compared to the Reference value
      call map_message(seve%i,task,'Computing UV residuals')
      omic(:) = nmic(:)       ! Restart from un-attenuate Clean Component List size
      rxy(1,1) = huv%mos%fields(ifield)%opoint(1)
      rxy(2,1) = huv%mos%fields(ifield)%opoint(2)
      !
      ! The sub-images will be shifted by their respective Phase offsets
      dxy(1,1) = huv%mos%fields(ifield)%ophase(1)
      dxy(2,1) = huv%mos%fields(ifield)%ophase(2)
      beamsize = bsize(huv%mos%fields(ifield)%jteles)
      call attenuate_clean(nchan,ccou,rxy,beamsize,fcou,omic,dxy(:,1))
      if (debug.gt.2) then
        print *,'Field ',ifield,rxy(1:2,1)/sec_in_rad,huv%mos%fields(ifield)%opoint(1:2)/sec_in_rad
        do it=1,min(10,omic(1))
          Print *,it,fcou(1:2,it,1)/sec_in_rad,ccou(3,it,1),fcou(3,it,1) !,omic(1),nmic(1)
        enddo
      endif
      !
      if (slow) then
        if (debug.gt.1) Print *,'U-DEBUG, Slow case IC ',ic,' LC ',lc,' OMIC ',omic
        call uv_removes_clean(nv,dtmp_uv,dfield_uv,lc-ic+1,omic, &
          & fcou,freq,ic,lc,subtract)
        if (debug.gt.1) Print *,'U-DEBUG, Done Slow ',ifield  
      else
        if (debug.gt.1) Print *,'U-DEBUG, Fast case '
        !
        ! By channel chunks
        do oic=ic,lc,chunk 
          olc = min(lc,oic+chunk-1)
          duv_tmp = 0.
          !
          ! Offset in OMIC but Also in FCOU
          fctmp => fcou(:,:,oic-ic+1:)
          call uv_removef_clean(hcct,dtmp_uv,duv_tmp,olc-oic+1,omic(oic:olc), &
            & fctmp,freq, oic, olc, subtract)
          !
          do iv=1,nv
            dfield_uv(5+3*oic:7+3*olc,iv) = duv_tmp(8:7+3*(olc-oic+1),iv)
          enddo
        enddo
        deallocate(duv_tmp,stat=ier) 
        !
        ! Start & Trail after the loop
        do iv=1,nv
          dfield_uv(1:7,iv) = dtmp_uv(1:7,iv)
          if (itrail.gt.0) then
            dfield_uv(huv%gil%lcol+1:huv%gil%dim(1),iv) = &
              & dtmp_uv(huv%gil%lcol+1:huv%gil%dim(1),iv)  
          endif
        enddo
        !
        if (debug.gt.1) Print *,'U-DEBUG, Done Fast ',ifield  
        !
      endif
      if (debug.gt.3) then
        write(local_huv%file,'(A,I0)') 'test', ifield
        call gdf_write_image(local_huv,dfield_uv,error)
        write(local_huv%file,'(A,I0)') 'all', ifield
        call gdf_write_image(local_huv,dtmp_uv,error)
      endif
      deallocate(dtmp_uv)  ! Per field intermediate array
    endif
    !
    ! Shift the Phases for the Fractional pixel & difference between Pointing and Phase centers
    dxy(1,1) = ksign*huv%mos%fields(ifield)%oxy(1)+(huv%mos%fields(ifield)%opoint(1)-huv%mos%fields(ifield)%ophase(1))
    dxy(2,1) = ksign*huv%mos%fields(ifield)%oxy(2)+(huv%mos%fields(ifield)%opoint(2)-huv%mos%fields(ifield)%ophase(2))
    if (debug.gt.0) then
      write(chain,'(A,I0,A,I0,A,F8.3,F8.3,A,F8.3,F8.3)')  'Field ',ifield,': Visi ',nv, &
        & ' Offsets :',huv%mos%fields(ifield)%opoint(1)/sec_in_rad,huv%mos%fields(ifield)%opoint(2)/sec_in_rad, &
        & ', Phases :',dxy(1,1)/sec_in_rad,dxy(2,1)/sec_in_rad
      call map_message(seve%d,task,chain,1)
    endif
    dxy = - freq * f_to_k * dxy ! Convert to Wavelength units
    call sault_shiftuv (nu,nv,huv%gil%nchan,dfield_uv,cs,1,dxy)
    if (debug.gt.0) call map_message(seve%i,task,'Done SAULT_SHIFT_UV',1)
    !
    ! Correct the u,v values for the Global projection since it is not yet done.
    ap = huv%mos%fields(ifield)%apoint(1)
    dp = huv%mos%fields(ifield)%apoint(2)
    call sault_uv_change(nu,nv,dfield_uv,ap,dp,a0,d0)  
    if (debug.gt.0) call map_message(seve%i,task,'Done SAULT_SHIFT_UV',1)
    !
    ! Assign the Pointers in each Thread for Parallel case
    pdirty%r3d => dmap
    pbeam%r3d => dtmp(:,:,:,1)
    local_huv%r2d => dfield_uv
    dtmp = 0.
    dmap = 0.
    !
    do_weig = .true.
    !
    ! We could write the Thread or Field number in "task" argument...
    ! SG: does "themap" contains the proper sizes ?... Not obvious
    local_huv%gil%nvisi = nv
    call many_beams_para (task,themap, channels, local_huv, pbeam, pdirty,   &
       &    nx,ny,nu,nv,dfield_uv,   &
       &    gfield_w, do_weig,  &
       &    sblock,cpu0,error,uvma,ifield,abort,ithread)
    deallocate(gfield_w,dfield_uv,stat=ier)
    if (debug.gt.0) call map_message(seve%i,task,'Done MANY_BEAMS_PARA',1)
    !
    noises(jfield) = pdirty%gil%noise   ! Remember the noise
    huv%mos%fields(ifield)%sigma = pdirty%gil%noise   ! Remember the noise
    if (abort) cycle                    ! Cannot Return
    !
    old_ib = 0
    !
    ! Define the subset range to be added
    call pixel_range(huv%mos%fields(ifield)%jxy(1),im,ip,km,kp,nx,mx)
    call pixel_range(huv%mos%fields(ifield)%jxy(2),jm,jp,lm,lp,ny,my)
    write(chain,'(A,I0,A,6(1X,I0))') 'Field ',ifield,' Pixel range ',im,ip,jm,jp,mx,my
    call map_message(seve%d,task,chain)
    write(chain,'(A,I0,A,6(1X,I0))') 'Sky   ',ifield,' Pixel range ',km,kp,lm,lp,nx,ny
    call map_message(seve%d,task,chain)
    !
    do jc=1,nc
      ib = beam_for_channel(jc,pdirty,pbeam)
      if (do_jvm) then
        jvm_factor = beams_param(4,ib,jfield)
        if (jvm_factor.eq.0.) jvm_factor = 1.
        write(chain,'(A,I0,A,I0,A,F7.3,A,I0)')  &
          & 'Field ',jfield,', Beam ',ib,', JvM factor ',jvm_factor,'; Thread ',ithread
        call map_message(seve%i,task,chain)
      else
        jvm_factor = 1.
      endif
      if (debug.gt.3) Print *,'Selected beam ',ib, jvm_factor
      ! Add it to the "mosaic dirty" image, by multiplying by
      ! the truncated primary beam
      if (ib.ne.old_ib) then
        dtrunc(:,:) = dprim(jfield,:,:,ib)
        if (debug.gt.3) Print *,'Set DTRUNC ',ib,' # ',old_ib
        where (dtrunc.lt.btrunc) dtrunc = 0
        old_ib = ib
      endif
      !
      ! Here we should add the (smaller) field to the global Dirty image
      ! The intermediate array ic_dirty(:,:) is required to avoid
      ! memory collision in Parallel programming
      ic_dirty = 0.
      ! We use here the JvM factor for the Residual image 
      ic_dirty(im:ip,jm:jp) = dmap(km:kp,lm:lp,jc)*dtrunc(km:kp,lm:lp)*jvm_factor
      !$OMP CRITICAL
      my_dirty(:,:,jc) = my_dirty(:,:,jc) + ic_dirty(:,:)
      !$OMP END CRITICAL
    enddo
    !
    ! Save the beam - Transposition is done here as needed -
    dbeam(:,:,jfield,:) = dtmp(:,:,:,1) ! Transpose      
    if (.not.do_jvm) then
      write(chain,'(A,I0,A,I0)') 'Ending Field ',ifield,' Thread ',ithread
      call map_message(seve%t,task,chain)
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  if (debug.gt.0) call map_message(seve%i,task,'Done loop on fields',1)
  if (per_field) then
    !$  call omp_set_nested(omp_nested)
    !$  call omp_set_num_threads(othread)
    !$  call map_message(seve%d,task,'Finished parallel section')
  endif
  if (abort) then
    call map_message(seve%w,task,'Aborted by user')
    error = .true.
    return
  endif
  hdirty%gil%noise = sum(noises)/np
  !
  ! Set the BEAM header 
  call gildas_null(htmp)
  call gdf_copy_header(hbeam,htmp,error)
  htmp%gil%ndim = 4
  call gdf_transpose_header(htmp,hbeam,'1243',error)
  if (error) return
  !
  if (mosaic_enlarge.gt.0) then
    ! 
    ! Temporary stuff : plunge Beam & Primary into Bigger arrays for CLEAN
    if (allocated(dtmp)) deallocate(dtmp)
    !
    ! Do Dirty Beams only if needed and requested
    if (mosaic_enlarge.gt.1) then
      if (nx.ne.mx .or. ny.ne.my) then
        call map_message(seve%w,rname,'Enlarging Dirty Beam')
        allocate(dtmp(nx,ny,np,nb),stat=ier)
        dtmp(:,:,:,:) = dbeam
        if (allocated(dbeam)) deallocate(dbeam)
        allocate(dbeam(mx,my,np,nb),stat=ier)
        dbeam = 0.0
        im = mx/2-nx/2+1
        ip = im+nx-1
        jm = my/2-ny/2+1
        jp = jm+ny-1
        !
        do ib=1,nb
          do jfield=1,np
            dbeam(im:ip,jm:jp,jfield,ib) = dtmp(:,:,jfield,ib)
          enddo
        enddo
        deallocate(dtmp)
      endif
      hbeam%gil%dim(1:2) = [mx,my]
      hbeam%gil%ref(1) = mx/2+1
      hbeam%gil%ref(2) = my/2+1
    else
      call map_message(seve%w,rname,'Dirty Beam not Enlarged')
    endif
    !
    write(mess,'(A,I0,A,I0,A,I0,A,I0,A)') 'Enlarging from [',nx,',',ny &
      & ,'] to [',mx,',',my,']'
    call map_message(seve%i,rname,mess)
    !
    ! Do Primary Beams in all cases
    allocate(dtmp(np,nx,ny,nb),stat=ier)
    dtmp(:,:,:,:) = dprim
    if (allocated(dprim)) deallocate(dprim)
    allocate(dprim(np,mx,my,nb),stat=ier)
    dprim(:,:,:,:) = 0
    do ib=1,nb
      do jfield=1,np
        ! Define the subset range to be added
        ifield = selected_fields(jfield)
        call pixel_range(huv%mos%fields(ifield)%jxy(1),im,ip,km,kp,nx,mx)
        call pixel_range(huv%mos%fields(ifield)%jxy(2),jm,jp,lm,lp,ny,my)
        write(chain,'(A,I0,A,6(1X,I0))') 'Field  ',ifield,' Pixel range ',km,kp,lm,lp,nx,ny
        call map_message(seve%d,task,chain)
        write(chain,'(A,I0,A,6(1X,I0))') 'Output ',ifield,' Pixel range ',im,ip,jm,jp,mx,my
        call map_message(seve%d,task,chain)
        dprim(jfield,im:ip,jm:jp,ib)  = dtmp(jfield,km:kp,lm:lp,ib)
      enddo
    enddo
    deallocate(dtmp)
    !    
    hprim%gil%dim(2:3) = [mx,my] 
    hprim%gil%ref(2) = mx/2+1
    hprim%gil%ref(3) = my/2+1
    !
    kx = mx
    ky = my
  else
    ! We have unfortunately no way yet to store the appropriate pixel shifts
    ! with the Primary Beams. 
    !
    call map_message(seve%w,rname,'MOSAIC_ENLARGE = 0 mode is still only for tests',1)
    !
    !   It would not matter for the Dirty Beams, since
    ! this can be done automatically when starting CLEAN. In fact,
    ! CLEAN could easily handle Dirty Beams that are smaller (or larger)
    ! than the full image. To be verified at some point later...
    kx = nx
    ky = ny
  endif
  !
  ! Finish the Beam header - Change address & size
  hbeam%r4d => dbeam  
  hbeam%gil%dim(3:4)=(/np,nb/)
  hbeam%gil%ndim = 4
  hbeam%loca%addr = locwrd(dbeam)
  hbeam%loca%size = product(hbeam%gil%dim(1:4))
  call sic_delvariable('BEAM',.false.,error)
  call sic_mapgildas('BEAM',hbeam,error,dbeam)
  !
  hprim%r4d => dprim
  call sic_mapgildas('PRIMARY',hprim,error,dprim)
  !
  ! OK we are almost done 
  !
  ! Reset the Dirty pointer and the Sizes
  hdirty%r3d => my_dirty
  hdirty%gil%dim(1:2) = [mx,my] ! Correct the size now
  hdirty%gil%ref(1) = mx/2+1
  hdirty%gil%ref(2) = my/2+1
  hdirty%loca%addr = locwrd(my_dirty)
  themap%size = [mx,my]
  !
  ! Nullify Filtered channels and Compute Dirty extrema 
  call cube_flag_extrema(huv%gil%nchan,'DIRTY',mcol,hdirty)
  !
  ! Correct the noise for the approximate gain at mosaic center
  ! for HWHM hexagonal spacing (normally it is sqrt(1+6/4)) 
  hdirty%gil%noise = hdirty%gil%noise/sqrt(2.5)
  if (.not.do_cct) then
    !
    ! UV_MAP only - We have the Dirty image 
    call sic_mapgildas('DIRTY',hdirty,error,ddirty)
    !
    save_data(code_save_beam) = .true.
    save_data(code_save_dirty) = .true.
    save_data(code_save_primary) = .true.
    save_data(code_save_fields) = .true.
    !
    call new_dirty_beam
    !
    ! Define Min Max
    call cube_minmax('DIRTY',hdirty,error)
    !
    d_max = hdirty%gil%rmax
    if (hdirty%gil%rmin.eq.0) then
      d_min = -0.03*hdirty%gil%rmax
    else
      d_min = hdirty%gil%rmin
    endif
  else
    ! Define the RESIDUAL
    call gdf_copy_header(hdirty,hresid,error)
    hresid%r3d => dresid
    call cube_minmax('RESIDUAL',hresid,error)
    call sic_mapgildas('RESIDUAL',hresid,error,dresid)
    ! Restore the DIRTY image pointer
    hdirty%r3d => ddirty
  endif
  !
  error = .false.
  !
  ! Backward compatibility with previous methods
  user_method%trunca = btrunc     ! By convention
  hprim%gil%convert(3,4) = beamsize  ! Primary beam size convention
  call sub_mosaic('ON',error)
  !
  if (allocated(w_mapu)) deallocate(w_mapu)
  if (allocated(w_mapv)) deallocate(w_mapv)
  if (allocated(w_grid)) deallocate(w_grid)
  if (allocated(fft)) deallocate(fft)
  call imager_tree(rname,.true.)
  return
  !
98 call map_message(seve%e,task,'Memory allocation failure')
  error = .true.
  return
  !
102 format(a,f9.2)
end subroutine mosaic_uvmap_sault
!
subroutine sault_extract_field(visi,mu,mv,nu,id,g_w, &
  & ifield,dfield_uv,gf_w,nv)
  use image_def
  !-------------------------------------------------------------------
  ! @ private
  !* 
  !  IMAGER -- Support routine for commands UV_MAP and UV_RESTORE
  !
  ! Extract a field for the SAULT method, based on the Field ID number
  !!
  !-------------------------------------------------------------------  
  integer, intent(in) :: mu             !! Input Visibility size
  integer, intent(in) :: mv             !! Number of visibilities
  real(4), intent(in) :: visi(mu,mv)    !! Visibilities
  integer, intent(in) :: nu             !! Output Visibility size
  integer, intent(in) :: id             !! ID column number
  real(4), intent(in) :: g_w(mv)        !! Weights
  integer, intent(in) :: ifield         !! Field to be loaded
  integer, intent(in) :: nv             !! Number of output visibilities
  real(4), intent(out) :: dfield_uv(nu,nv)  !! Field visibilities
  real(4), intent(out) :: gf_w(nv)      !! Field weights
  !
  ! Local ---
  integer :: iv, kv
  !  
  ! Code ----
  kv = 0
  do iv=1,mv
    if (visi(id,iv).eq.ifield) then
      kv = kv+1
      if (kv.le.nv) then
        dfield_uv(:,kv) = visi(1:nu,iv)
      endif
    endif
  enddo
  if (kv.ne.nv) then
    Print *,'F-SAULT_EXTRACT_FIELDS,  Programming error KV ',kv,' # NV ',nv
    Print *,'F-SAULT_EXTRACT_FIELDS,  Field number ',id,ifield,' -- UV size ',mu,mv
    Print *,'F-SAULT_EXTRACT_FIELDS,  Input UV sizes ',mu,mv,' -- Output size ',nu,nv
  endif
end subroutine sault_extract_field
!
subroutine sault_shiftuv (nu,nv,nchan,visi,cs,nc,xy)
  !$ use omp_lib
  use image_def
  use gkernel_interfaces
  use gkernel_types
  use clean_arrays 
  use gbl_message
  use imager_interfaces, only : map_message
  use phys_const
  !-------------------------------------------------------------------
  ! @ private
  !*
  !  IMAGER  -- Support routine for commands UV_MAP, Mosaic SAULT method
  !
  !   Shift phase center and apply U,V coordinates rotation if needed
  !   Note that Offsets are not shifted, neither rotated by this
  !   subroutine.
  !!
  !-------------------------------------------------------------------
  integer, intent(in) :: nu             !! Size of a visibility
  integer, intent(in) :: nv             !! Number of visibilities
  integer, intent(in) :: nchan          !! Number of channels
  real, intent(inout) :: visi(nu,nv)    !! Visibilities
  real, intent(in) :: cs(2)             !! Cos/Sin of Rotation
  integer, intent(in) :: nc             !! Number of Channels
  real(8), intent(in) :: xy(2,nc)       !! Position Shift per channel
  !
  ! Local ---
  integer :: i,jc,iu,iv,ix
  real(8) :: phi, sphi, cphi
  real :: u, v, reel, imag
  !
  ! Code ----
  if (all(xy.eq.0)) then
    if (cs(1).ne.1.0 .or. cs(2).ne.0.0) then
      iu = 1
      iv = 2
      !$OMP PARALLEL DEFAULT(none) &
      !$OMP SHARED(nv,cs,visi,iu,iv) &
      !$OMP PRIVATE(i,u,v) 
      !$OMP DO
      do i = 1,nv
        u = visi(iu,i)
        v = visi(iv,i)
        visi(iu,i) = cs(1)*u - cs(2)*v
        visi(iv,i) = cs(2)*u + cs(1)*v
      enddo
      !$OMP ENDDO
      !$OMP END PARALLEL
    endif
    return
  endif
  !
  ! Shift and rotation of a specified phase center
  !
  cphi = 1.0
  sphi = 0.0
  !
  iu = 1
  iv = 2
  !
  !$OMP PARALLEL DEFAULT(none) &
  !$OMP SHARED(nchan,nv,nc,cs,xy,visi,iu,iv) &
  !$OMP PRIVATE(i,u,v,phi,jc,ix,reel,imag) &
  !$OMP FIRSTPRIVATE(cphi,sphi) 
  !
  !$OMP DO
  do i = 1,nv
    u = visi(iu,i)
    v = visi(iv,i)
    visi(iu,i) = cs(1)*u - cs(2)*v
    visi(iv,i) = cs(2)*u + cs(1)*v
    !
    if (nc.eq.1) then
      phi = xy(1,1)*u + xy(2,1)*v
      cphi = cos(phi)
      sphi = sin(phi)
    endif
    !
    do jc=1,nchan
      ix = 8+(jc-1)*3 
      if (nc.gt.1) then
        phi = xy(1,jc)*u + xy(2,jc)*v
        cphi = cos(phi)
        sphi = sin(phi)
      endif
      reel = visi(ix,i) * cphi - visi(ix+1,i) * sphi
      imag = visi(ix,i) * sphi + visi(ix+1,i) * cphi
      visi(ix,i) = reel
      visi(ix+1,i) = imag
    enddo
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
end subroutine sault_shiftuv
!
subroutine loadfiuv_id (visi,np,nv,dtr,it,sorted,idoff,rpv,nf,doff)
  use clean_arrays
  !---------------------------------------------------------------------
  ! @ public-mandatory
  !*
  ! IMAGER    UV_MAP -- Mosaic SAULT sorting routines  
  !     Load field numbers into work arrays for sorting.
  !!
  !---------------------------------------------------------------------
  integer, intent(in)  :: np                     !! Size of a visibility
  integer, intent(in)  :: nv                     !! Number of visibilities
  real, intent(in) :: visi(np,nv)                !! Input visibilities
  real(8), intent(out) :: dtr(nv)                !! Output field number
  integer, intent(out) :: it(nv)                 !! Indexes
  logical, intent(out) :: sorted                 !! Is data sorted by Fields ?
  integer, intent(in)  :: idoff                  !! ID pointer
  real(4), intent(in)  :: rpv(nv)                !! V Values
  integer, intent(inout) :: nf                   !! Number of fields
  real(kind=4), intent(out) :: doff(:,:)         !! Fields offsets
  !
  ! Local ---
  integer :: iv, i
  integer :: mfi 
  real(8) :: vmax
  !
  ! Code ----
  !
  ! Scan how many fields
  mfi = ubound(doff,2)
  if (nf.ne.mfi) Print *,'Warning Number of field mismatch ',nf, mfi
  !
  ! V are negative values, so this 1 + max(abs(V))
  vmax = 1.0d0-minval(rpv)
  !
  do iv=1,nv
    if (rpv(iv).gt.0) then
      Print *,'Unsorted Visibility with V > 0 ',iv,rpv(iv)
    endif
    if ((visi(idoff,iv).lt.1).or.(visi(idoff,iv).gt.nf)) then
      Print *,'Out of bound field number at # ',iv, visi(idoff,iv)
    endif
    dtr(iv) = dble(visi(idoff,iv)) + rpv(iv)/vmax
    it(iv) = iv
  enddo
  !
  do i=1,nf
    doff(1,i) = huv%mos%fields(i)%opoint(1)
    doff(2,i) = huv%mos%fields(i)%opoint(2)
  enddo
  !
  ! DTR must in the end be ordered and increasing.
  vmax = dtr(1)
  do iv = 1,nv
    if (dtr(iv).lt.vmax) then
      sorted = .false.
      return
    endif
    vmax = dtr(iv)
  enddo
  sorted = .true.
  !
end subroutine loadfiuv_id
!
subroutine pixel_range(r,im,ip,km,kp,nx,mx)
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- UV_MAP utility routine for SAULT method.
  !   
  !   Define input & output pixel ranges
  ! when placing an input array into an output one.
  !     Load field numbers into work arrays for sorting.
  !!
  !---------------------------------------------------------------------
  integer, intent(in) :: r                !! Pixel shift
  integer, intent(in) :: nx,mx            !! Input & Output sizes
  integer, intent(out) :: im,ip           !! Input pixel range
  integer, intent(out) :: km,kp           !! Output pixel range
  !
  ! Code ----
  im =  1+r
  ip = nx+im-1
  if (ip.gt.mx) then
    kp = nx-ip+mx
    ip = mx
  else 
    kp = nx
  endif
  if (im.lt.1) then
    km = 2-im
    im = 1
  else
    km = 1
  endif
end subroutine pixel_range
