subroutine sg_map(task,line,do_cct,error)
  !$ use omp_lib
  use gkernel_interfaces
  use imager_interfaces, except_this=>sg_map
  use clean_def
  use clean_arrays
  use clean_types
  use clean_default
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !
  !     Support for commands
  !       UV_RESTORE  [/SPEED FFT | PRECISION | Number]
  !       UV_MAP
  !       UV_SELF
  ! and   MX (eventually, not coded yet)
  !
  ! Compute a map from a CLIC UV Sorted Table  by Gridding and Fast Fourier
  ! Transform, using adequate virtual memory space for optimisation. Also
  ! allows removal of Clean Components in the UV data and restoration of
  ! the clean image.
  !
  ! Input :
  !     a precessed UV table
  !     a list of Clean components
  ! Output :
  !     a precessed, rotated, shifted UV table, sorted in V,
  !     ordered in (U,V,W,D,T,iant,jant,nchan(real,imag,weig))
  !     a beam image or cube
  !     a LMV cube  (dirty or clean)
  !
  ! To be implemented
  !     Optionally, a Residual UV table
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: task ! Caller (MX or UV_MAP or UV_RESTORE)
  character(len=*), intent(inout) :: line ! Command line
  logical, intent(in) :: do_cct        ! Remove Clean Components before
  logical, intent(out) :: error  
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: f_to_k = 2.d0*pi/299792458.d-6
  integer, parameter :: o_speed = 2   ! For UV_RESTORE
  integer, parameter :: o_copy = 1    ! For UV_RESTORE
  integer, parameter :: o_range= 3    ! For UV_MAP
  integer, parameter :: code_fft=1, code_auto=0, code_precis=-1
  !
  ! Toggling number of visibilities to switch method
  real(4), save :: noper_slow_max=2E8 ! Empirical value
  integer :: code_speed=code_auto
  !
  real, allocatable :: w_mapu(:), w_mapv(:), w_grid(:,:)
  !! real, allocatable :: res_uv(:,:)
  real(8) newabs(3)
  real(4) rmega,uvmax,uvmin,uvma
  integer wcol,mcol(2),rcol,sblock
  integer ier
  logical one, sorted, shift, needed
  character(len=message_length) :: chain
  character(len=32) :: acomm
  character(len=12) :: string
  real cpu0, cpu1
  real(8) :: freq
  integer nx,ny,nu,nv,nc,nb,mx,my,mthread
  !
  real(4) :: noper
  character(len=4) :: key
  integer :: nk
  logical :: do_slow
  logical :: do_copy, goon
  logical :: LIKE_MOSAIC=.false.
  !
  integer, allocatable, target :: smic(:)     ! Number of clean components per channel
  real, allocatable, target :: sccou(:,:,:)  ! Transpose, compressed Clean Component List
  integer :: maxic, icmax(2), fcol, lcol
  !
  ! Code
  call imager_tree('SG_MAP in restore_many.f90')
  !
  ! Print *,'DO_WEIG at start ',do_weig
  !
  ! Decode command line
  call map_query (line,task,themap,goon,error)  
  if (error.or..not.goon) return ! Syntax error, or missing information
  !
  ! Guess speed automatically
  code_speed = code_auto
  !
  if (task.eq.'UV_SELF') then
    do_copy = .false.
  else
    if (sic_present(o_speed,0)) then
      call sic_ke(line,o_speed,1,key,nk,.true.,error)
      select case (key)
      case ('AUTO')
        code_speed = code_auto
      case ('FFT')
        code_speed = code_fft
      case ('PREC')
        code_speed = code_precis
      case default
        call sic_r4(line,o_speed,1,noper_slow_max,.true.,error)
        if (error) return
        code_speed = code_auto
      end select
    endif
    do_copy = sic_present(o_copy,0) 
  endif
  !
  error = .false.
  !
  if (do_cct) then
    !!Print *,'UVMAP_MCOL ',uvmap_mcol,' SAVE_MCOL ',saved_mcol
    !
    ! Subtract all Clean Components
    if (.not.associated(duv)) then
      call map_message(seve%e,task,'No UV data loaded')
      error = .true.
    endif
    if (.not.allocated(dcct)) then
      call map_message(seve%e,task,'No CCT data available')
      error = .true.
    endif
    if (error) return
  endif
  !
  call map_prepare(task,huv,themap,error)
  if (error) return
  !
  one = .true.
  wcol = 0 
  !
  string = " "
  if (sic_present(o_range,0)) then
    ! Define the number of output channels
    call uvmap_cols(task,line,huv,mcol,wcol,error)
    uvmap_mcol = mcol
    uvmap_wcol = wcol
    string = "Imaging"
  else if (do_cct) then
    mcol = uvmap_mcol
    wcol = uvmap_wcol
    string = "Restoring"
  else
    call uvmap_cols(task,line,huv,mcol,wcol,error)
    uvmap_mcol = mcol
    uvmap_wcol = wcol
  endif
  !
  if (string.ne." ") then
    write(chain,'(A,I0,A,I0,A)') trim(string)//" channel range [",mcol(1),",",mcol(2),"]"
    call map_message(seve%i,task,chain)
  endif
  !
  call map_center(line,task,huv,shift,newabs,error)
  if (error) return
  !
  call gag_cpu(cpu0)
  needed = themap%uniform(2).ne.0 ! Need sorting ?
  needed = .false.  !! Test
  call uv_sort (huv,duv,error,sorted,shift,newabs,uvmax,uvmin,needed)
  if (error) return
  if (.not.sorted) then
    ! Redefine SIC variables (mandatory)
    call map_uvgildas('UV',huv,error,duv)
  endif
  call gag_cpu(cpu1)
  write(chain,102) 'Finished sorting ',cpu1-cpu0
  call map_message(seve%i,task,chain)
  !
  ! At this stage, we should reset MAP_CENTER
  acomm = 'LET MAP_CENTER " "'
  call exec_command(acomm,error)
  !
  call map_parameters(task,themap,huv,freq,uvmax,uvmin,error)
  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.
  !
  nx = themap%size(1)
  ny = themap%size(2)
  nu = huv%gil%dim(1)
  nv = huv%gil%nvisi ! not %dim(2)
  !
  ! Define beam characteristics
  call define_beams(task,themap%beam,nx,ny,huv,mcol,nb,error)
  if (error) return  
  !
  nc = mcol(2)-mcol(1)+1
  if (do_cct .and. nc.ne.hcct%gil%dim(2)) then
    write(chain,'(A,I0,A,I0)') 'Mismatched number of channels between HUV ',nc,' and CCT ',hcct%gil%dim(2)
    call map_message(seve%e,task,chain)
    error = .true.
    return
  endif
  !
  ! Check if Weights have changed by MCOL choice
  !!PRINT *,'DO_WEIG before ',do_weig
  if (any(saved_mcol.ne.mcol) .or. nb.gt.1) do_weig = .true.
  if (saved_wcol.ne.wcol) do_weig = .true.
  !!PRINT *,'DO_WEIG just after ',do_weig,' nb ',nb
  saved_mcol = mcol
  saved_wcol = wcol
  !
  if (method%method.eq.'MX') do_weig = .true. ! Test
  if (do_weig) then
    call map_message(seve%i,task,'Computing weights ')
    if (allocated(g_weight)) deallocate(g_weight)
    if (allocated(g_v)) deallocate(g_v)
    allocate(g_weight(nv),g_v(nv),stat=ier)
    if (ier.ne.0) goto 98
  else
    call map_message(seve%i,task,'Re-using weight space')
  endif
  !
  !
  ! In fast mode, an intermediate Large FFT is used
  ! The maximum number of threads thus plays a role here.
  !
  if (do_cct) then
    hcct%r3d => dcct
    !
    ! Compress all CCTs first
    maxic = hcct%gil%dim(3)
    allocate (sccou(3,maxic,hcct%gil%dim(2)), smic(hcct%gil%dim(2)), stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,task,'Compressed CCT allocation error')
      error = .true.
      return
    endif
    !
    ! Find out Clean size per Channel
    ! This was probably inconsistent before ?...
    fcol = 1     !  min(mcol(1),mcol(2))
    lcol = nc    !  max(mcol(1),mcol(2))
    call uv_clean_sizes(hcct,hcct%r3d,smic,fcol,lcol) 
    !
    ! Compress Clean Components
    call uv_squeeze_clean(nc,hcct%r3d,sccou, smic,fcol,lcol)
    icmax(2) = maxval(smic)   ! This should be smaller than MAXIC then
    icmax(1) = sum(smic)/nc
    write(chain,'(A,I0,1X,I0,A,I0,A)') 'Clean sizes:  Max [',icmax(1),icmax(2),' < ',maxic,'] '
    call map_message(seve%i,task,chain)
    !
    select case (code_speed)
    case (code_fft)
      call map_message(seve%i,task,'Using "fast" FFT-based subtraction mode')
      do_slow = .false.
    case (code_precis)
      do_slow = .true.
      call map_message(seve%i,task,'Using "slow" Sin/Cos visibility based subtraction mode')
    case (code_auto)
      ! Automatic guess
      ! That does not include the number of channels, 
      ! but only the Number of visibilities times the number of Clean Components 
      !
      ! A better guess would be by testing the average per block instead of the 
      ! overal Max number here ?
      noper = huv%gil%nvisi*icmax(2)
      !! Print *,'NOPER ',noper,' Max ',noper_slow_max,' Ratio ',real(noper_slow_max)/real(noper)
      if (noper.lt.noper_slow_max) then
        call map_message(seve%i,task,'Selecting precise mode because of small number of visibilities')
        do_slow = .true.
      else
        call map_message(seve%i,task,'Selecting FFT-based subtraction mode')
        do_slow = .false.
      endif
    end select
  endif
  !
  rmega = sys_ramsize/4      ! Do not overload Memory 
  rmega = max(4096.0,rmega)  !! Assume you can at least take 4GByte of memory
  ier = sic_ramlog('SPACE_IMAGER',rmega)
  mthread = 1
  ! This is stupidly conservative, as in the end, we shall use
  ! a much smaller number of outer threads ??...
  !$ mthread = omp_get_max_threads()
  rmega = rmega/min(mthread,8) ! Trial ...
  ! Re-adjust the block size according to Memory requirements of the method
  if (do_cct.and..not.do_slow) then
    mx = max(nx,min(4*nx,4096))
    my = max(ny,min(4*ny,4096))
    sblock = max(int((1024.0*rmega*1024.0)/8.0/mx/my),1)
  else
    sblock = max(int((1024.0*rmega*1024.0)/8.0/nx/ny),1)
    mx = nx
    my = ny
  endif
  write(chain,*) 'RMEGA ',rmega,' SBLOCK ',sblock,' DO_CCT ',do_cct,do_slow,' MX MY ',mx,my
  call map_message(seve%d,task,chain)
  !
  ! New Beam place
  if (allocated(dbeam)) then
    call sic_delvariable ('BEAM',.false.,error)
    deallocate(dbeam)
  endif
  call gildas_null(hbeam)
  !
  ! Process sorted UV Table according to the number of beams produced
  !
  hbeam%gil%ndim = 3
  hbeam%gil%dim(1:4)=[nx,ny,nb,1]
  if (nb.gt.1) then
    if (LIKE_MOSAIC) then
      allocate(hbeam%r3d(nx,ny,nb),dbeam(nx,ny,1,nb),stat=ier)
    else
      allocate(dbeam(nx,ny,nb,1),stat=ier)
      hbeam%r3d => dbeam(:,:,:,1)
    endif
    rcol = 0
  else
    allocate(dbeam(nx,ny,1,1),stat=ier)
    hbeam%r3d => dbeam(:,:,:,1)
    rcol = (mcol(2)+mcol(1))/2
  endif
  if (ier.ne.0) then
    call map_message(seve%e,task,'Memory allocation error on DBEAM')
    error =.true.
    return
  endif
  !
  if (do_cct) then
    ! UV_RESTORE case
    call map_message(seve%d,task,'DO_CCT is set')
    !
    ! New residual image
    if (allocated(dresid)) then
      call sic_delvariable ('RESIDUAL',.false.,error)
      deallocate(dresid)
    endif
    allocate(dresid(nx,ny,nc),stat=ier)
    !
    call gildas_null(hresid)
    hresid%gil%ndim = 3
    hresid%gil%dim(1:3) = (/nx,ny,nc/)
    hresid%r3d => dresid
    !
    if (allocated(dclean)) then
      call sic_delvariable ('CLEAN',.false.,error)
      deallocate(dclean)
    endif
    allocate(dclean(nx,ny,nc),stat=ier)
    hclean%r3d => dclean

    call uvmap_and_restore (task,themap,   &
       &    huv, hbeam, hresid,   &
       &    nx,ny,nu,nv, duv,   &
       &    g_weight, g_v, do_weig,  &
       &    rcol,wcol,mcol,sblock,cpu0,error,uvma, &
       &    method, do_cct, hcct, hclean, do_slow, do_copy, &
       &    sccou, smic)
       !
    save_data(code_save_clean) = .true.
    save_data(code_save_resid) = .true.
    if (error) return ! Make sure nothing happens in case of failure...
    !!PRINT *,'DO_WEIG after ',do_weig
    !
    ! Specify clean beam parameters
    hclean%gil%reso_words = 3
    hclean%gil%majo = method%major
    hclean%gil%mino = method%minor
    hclean%gil%posa = pi*method%angle/180.0
    ! Specify clean beam parameters
    hbeam%gil%reso_words = 3
    hbeam%gil%majo = method%major
    hbeam%gil%mino = method%minor
    hbeam%gil%posa = pi*method%angle/180.0
    !
    ! Get extrema
    hclean%loca%size = nx*ny
    hclean%loca%size= hclean%loca%size*nc
    hclean%gil%ndim = 3
    hclean%gil%dim(1:3) = (/nx,ny,nc/)
    call cube_minmax('CLEAN',hclean,error)
    !
    call sic_mapgildas ('CLEAN',hclean,error,dclean)
    call sic_mapgildas ('RESIDUAL',hresid,error,dresid)
    !
  else
    allocate (sccou(3,1,1), smic(1), stat=ier)
    !
    ! New dirty image
    if (allocated(ddirty)) then
      call sic_delvariable ('DIRTY',.false.,error)
      deallocate(ddirty)
    endif
    allocate(ddirty(nx,ny,nc),stat=ier)
    !
    call gildas_null(hdirty)
    hdirty%gil%ndim = 3
    hdirty%gil%dim(1:3) = (/nx,ny,nc/)
    hdirty%r3d => ddirty
    call sic_mapgildas('DIRTY',hdirty,error,ddirty)
    !
    call uvmap_and_restore (task,themap,   &
       &    huv, hbeam, hdirty,   &
       &    nx,ny,nu,nv, duv,   &
       &    g_weight, g_v, do_weig,  &
       &    rcol,wcol,mcol,sblock,cpu0,error,uvma, &
       &    method, do_cct, hcct, hclean, do_slow, do_copy, &
       &    sccou, smic)
    !!PRINT *,'DO_WEIG after ',do_weig
    !
    save_data(code_save_beam) = .true.
    save_data(code_save_dirty) = .true.
    !
    if (error) return ! Make sure nothing happens in case of failure...
    !
    call new_dirty_beam
    !
    ! Define Min Max  - Duplication from uvmap_and_restore
    !
    ! Is this still used anywhere ?
    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
  endif
  !
  if (LIKE_MOSAIC) THEN
    ! Re-shape the beam, and reset the 4-D pointer,
    ! but show it as a 3-D array in SIC
    if (nb.gt.1) then
      dbeam(:,:,:,:) = reshape(hbeam%r3d,[nx,ny,1,nb])
      deallocate(hbeam%r3d)
    endif
    !
    hbeam%r4d => dbeam
    hbeam%gil%dim(1:4)=[nx,ny,1,nb]
    hbeam%gil%ndim = 4
    !
    ! Transpose the header appropriately
    hbeam%gil%convert(:,4) = hbeam%gil%convert(:,3)
    hbeam%gil%faxi = 4
    hbeam%char%code(4) = 'VELOCITY' ! Frequency would be better...
    hbeam%gil%convert(:,3) = 1.d0
    hbeam%char%code(3) = 'FIELD'    ! Pseudo-mosaic
    hbeam%gil%ndim = 4
    call sic_mapgildas('BEAM',hbeam,error,dbeam)
  ELSE
    hbeam%r4d => dbeam
    hbeam%char%code(4) = 'FIELD'
    hbeam%gil%ndim = 3
    hbeam%gil%convert(:,4) = 1.d0
    call sic_mapgildas('BEAM',hbeam,error,dbeam(:,:,:,1))
  ENDIF
  !
  !
  if (task.ne.'MX') goto 99
  !
  ! There could be code for MX at this level...
  !
99 continue
  if (allocated(w_mapu)) deallocate(w_mapu)
  if (allocated(w_mapv)) deallocate(w_mapv)
  if (allocated(w_grid)) deallocate(w_grid)
  !!PRINT *,'DO_WEIG at end ',do_weig
  return
  !
98 call map_message(seve%e,task,'Memory allocation failure')
  error = .true.
  return
  !
102 format(a,f9.2)
  !
end subroutine sg_map
!
subroutine uvmap_and_restore (rname,map,huv,hbeam,hdirty,   &
     &    nx,ny,nu,nv,uvdata,r_weight, w_v, do_weig,    &
     &    rcol,wcol,mcol,sblock,cpu0,error,uvmax, &
     &    method, do_cct,hcct,hclean,do_slow,do_copy,sccou,smic)
  use gkernel_interfaces
  use imager_interfaces, except_this=>uvmap_and_restore
  use clean_def
  use clean_default
  use clean_beams
  use image_def
  use gbl_message
  use omp_control
  !$ use omp_lib
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Compute a map from a CLIC UV Sorted Table
  !   by Gridding and Fast Fourier Transform, with
  !   a different beam per channel.
  !
  ! Input :
  ! a precessed UV table, sorted in V, ordered in
  ! (U,V,W,D,T,iant,jant,nchan(real,imag,weig))
  !
  ! (optionally) a list of Clean components
  !
  ! Output :
  ! a beam image
  ! a DIRTY or RESIDUAL and CLEAN cube
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname   ! Calling Task name
  type (uvmap_par), intent(inout) :: map  ! Mapping parameters
  type (gildas), intent(inout) :: huv     ! UV data set
  type (gildas), intent(inout) :: hbeam   ! Dirty beam data set
  type (gildas), intent(inout) :: hdirty  ! Dirty image data set
  integer, intent(in) :: nx               ! X size
  integer, intent(in) :: ny               ! Y size
  integer, intent(in) :: nu               ! Size of a visibility
  integer, intent(in) :: nv               ! Number of visibilities
  real, intent(inout) :: uvdata(nu,nv)
  real, intent(inout), target :: r_weight(nv)    ! Weight of visibilities
  real, intent(inout) :: w_v(nv)          ! V values
  logical, intent(inout) :: do_weig
  !
  real, intent(inout) :: cpu0            ! CPU
  real, intent(inout) :: uvmax           ! Maximum baseline
  integer, intent(inout) :: sblock       ! Blocking factor
  integer, intent(inout) :: rcol         ! Reference frequency channel
  integer, intent(inout) :: wcol         ! Weight channel
  integer, intent(inout) :: mcol(2)      ! First and last channel
  logical, intent(inout) :: error
  logical, intent(in) :: do_cct
  type (clean_par), intent(inout) :: method ! Cleaning Method
  type (gildas), intent(inout) :: hcct      ! Clean component data set
  type (gildas), intent(inout) :: hclean    ! Clean image data set
  logical, intent(in) :: do_slow
  logical, intent(in) :: do_copy
  real, intent(in), target :: sccou(:,:,:)  ! Transpose, compressed Clean Component List
  integer, intent(in), target :: smic(:)    ! Number of clean components per channel
  !
  ! Global variables:
  !
  real(kind=8), parameter :: clight=299792458d-6 ! Frequency in  MHz
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: sec_to_rad=pi/180d0/3600d0
  !
  type (gridding) :: conv
  character(len=32) :: cname
  !
  integer :: nchan    ! Number of channels
  integer :: ndata    ! Size of data
  integer :: nbeam    ! Number of beams
  integer :: schunk   ! Number of channels per chunk
  integer :: nblock   ! Number of blocks/chunks ( = nbeam if nbeam.gt.1)
  integer :: ier, icmax
  real(kind=8) :: freq
  integer ctypx,ctypy
  integer lcol,fcol
  real wall,wprt,cpu1
  real xparm(10),yparm(10)
  real(8) :: vref,voff,vinc
  integer ndim, nn(2), lx, ly, kz1
  integer kz,iz,ic,kc,kb,jc,lc
  character(len=message_length) :: chain
  character(len=80) :: meslock
  !
  real :: rms, null_taper(4), wold
  complex, allocatable :: ftbeam(:,:)
  complex, allocatable :: tfgrid(:,:,:)
  real, allocatable :: w_xgrid(:),w_ygrid(:), w_w(:),  w_grid(:,:), walls(:)
  real, allocatable :: w_weight(:)
  real, allocatable :: beam(:,:)
  real, allocatable :: w_mapu(:), w_mapv(:)
  real, allocatable :: local_wfft(:)
  real uvcell(2)
  real support(2)
  real(8) local_freq
  !
  integer :: ithread, othread, nthread
  real(8) :: elapsed_s, elapsed_e, elapsed
  !
  real :: jvm_factor
  real :: toto
  logical :: local_error, abort
  logical :: compute_weight
  !
  integer :: maxic, icc, no, niter
  integer, pointer :: pmic(:)        ! Number of clean components per channel
  real, pointer :: pccou(:,:,:)      ! Transpose, compressed Clean Component List
  real, allocatable :: ouv(:,:)      ! Residual Visibilities
  type (cct_par), allocatable :: p_cct(:)
  type(clean_par) :: my_method
  real :: my_major, my_minor, my_angle
  integer :: ix_min,ix_max,iy_min,iy_max
  real :: bmin,bmax
  character(len=12) :: fname
  integer :: grid_code
  logical :: omp_nested
  !
  logical :: cct_compress = .true.
  integer :: scct
  character(len=20) cspeed
  !
  !
  call imager_tree('UVMAP_AND_RESTORE in restore_many.f90')
  !
  if (do_slow) then
    cspeed = 'Slow Precise'
  else
    cspeed = 'Fast FFT    '    
  endif
  grid_code = 0
  call sic_get_inte('MAP_GRID_CODE',grid_code,error)
  call sic_get_logi('CCT_COMPRESS',cct_compress,error)
  jvm_factor = 1.0
  if (do_cct) then
    call sic_get_real('BEAM_JVM',jvm_factor,error)
    if (abs(jvm_factor-1).gt.0.01) then
      write(chain,'(A,F6.2)')  'Dirty beam scaling factor (JvM factor) ',jvm_factor
      call map_message(seve%i,rname,chain,3)
    endif
  endif
  !
  ! Code:
  elapsed_s = 0
  elapsed_e = 0
  error = .false.
  ndata = nx*ny
  nchan = huv%gil%nchan
  nbeam = hbeam%gil%dim(3)
  !
  schunk = map%beam
  null_taper = 0
  !
  ! Reset the parameters
  xparm = 0.0
  yparm = 0.0
  !
  vref = huv%gil%ref(1)
  voff = huv%gil%voff
  vinc = huv%gil%vres
  !
  ! Select the channels
  if (mcol(1).eq.0) then
    mcol(1) = 1
  else
    mcol(1) = max(1,min(mcol(1),nchan))
  endif
  if (mcol(2).eq.0) then
    mcol(2) = nchan
  else
    mcol(2) = max(1,min(mcol(2),nchan))
  endif
  fcol = min(mcol(1),mcol(2))
  lcol = max(mcol(1),mcol(2))
  if (wcol.eq.0) then
    wcol = (fcol+lcol)/3
  endif
  wcol = max(1,wcol)
  wcol = min(wcol,nchan)
  nchan = lcol-fcol+1
  !
  ! The Threading must be set here, once NCHAN is defined
  if (schunk.ne.1 .and. nbeam.gt.1) then
    write(chain,'(a,i6,a)') 'Processing one beam for ',schunk,' channels'
    call map_message(seve%w,rname,chain)
  endif
  !
  if (nbeam.eq.1) then
    !
    ! Optimize SBLOCK now, allowing some additional memory if NBLOCK small
    if ((sblock.gt.0)) then
      nblock = (nchan+sblock-1)/sblock
      kz = mod(nchan,sblock)
      if (kz.ne.0 .and. kz.lt.(sblock/(nblock+1))) then
        if (nblock.ne.1) nblock = nblock-1
      endif
      sblock = (nchan+nblock-1)/nblock
      schunk = min(sblock,nchan)
    else
      schunk = nchan
      nblock = 1
    endif
    ! One might be more clever, and use a number of threads that
    ! depend on the Block Size when sufficient memory is available.
    ! A Block size of 128 channels is in general a nice goal.
    ! 4 Threads in general enough, but user customizable through 
    ! SIC Variable OMP_MAP%OUTER_GOAL, accessible by ompget_outer_goal()
    !$ nthread = min(omp_get_max_threads(),ompget_outer_goal()) 
    if (nblock.lt.nthread) then ! Split in more Blocks if possible
      nblock = min(nthread,nchan)
      sblock = (nchan+nblock-1)/nblock
      write(chain,'(A,I6,A,I8,A)') 'Reset ',nblock,' blocks of ',&
        & sblock,' channels for Threading'
      call map_message(seve%w,rname,chain)
      schunk = sblock
    endif
    !
    ! Maximize Inner thread number (so minimize nthread) if possible
    if (nthread.gt.nchan) nthread = nchan 
    write(chain,'(A,I6,A,I8,A,I0,A)') 'Using ',nblock,' blocks of ',&
        & schunk,' channels'
    call map_message(seve%w,rname,chain)    
  else
    nblock = nbeam  ! For the Nesting of OMP parallel codes
  endif
  !
  ! Compute observing sky frequency for U,V cell size
  if (rcol.eq.0) then
    freq = gdf_uv_frequency(huv, 0.5d0*dble(lcol+fcol) )
  else
    freq = gdf_uv_frequency(huv, dble(rcol) )
  endif
  !
  ! Compute gridding function
  ctypx = map%ctype
  ctypy = map%ctype
  call grdflt (ctypx, ctypy, xparm, yparm)
  call convfn (ctypx, xparm, conv%ubuff, conv%ubias)
  call convfn (ctypy, yparm, conv%vbuff, conv%vbias)
  map%uvcell = clight/freq/(map%xycell*map%size)
  map%support(1) = xparm(1)*map%uvcell(1)  ! In meters
  map%support(2) = yparm(1)*map%uvcell(2)
  !
  ! Process sorted UV Table according to the type of beam produced
  !
  allocate (w_w(nv),w_weight(nv),walls(nbeam),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Cannot allocate Weight arrays')
    error = .true.
    return
  endif
  w_v(:) = uvdata(2,1:nv)
  !
  lx = (uvmax+map%support(1))/map%uvcell(1) + 2
  ly = (uvmax+map%support(2))/map%uvcell(2) + 2
  lx = 2*lx
  ly = 2*ly
  if (ly.gt.ny) then
    write(chain,'(A,A,F8.3)') 'Map cell is too large ',   &
        &      ' Undersampling ratio ',float(ly)/float(ny)
    call map_message(seve%w,rname,chain,3)
    ly = min(ly,ny)
    lx = min(lx,nx)
  endif
  !
  ! Get FFTs and beam work spaces
  allocate (tfgrid(schunk+1,lx,ly),ftbeam(nx,ny),beam(nx,ny),&
    & w_mapu(lx),w_mapv(ly),local_wfft(2*max(nx,ny)), &
    & w_xgrid(nx),w_ygrid(ny),w_grid(nx,ny),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Cannot allocate TF arrays')
    error = .true.
    return
  endif
  !
  call docoor (lx,-map%uvcell(1),w_mapu)
  call docoor (ly,map%uvcell(2),w_mapv)
  !
  ndim = 2
  nn(1) = nx
  nn(2) = ny
  call fourt_plan(ftbeam,nn,ndim,-1,1)
  !
  ! Prepare grid correction,
  call grdtab (ny, conv%vbuff, conv%vbias, w_ygrid)
  call grdtab (nx, conv%ubuff, conv%ubias, w_xgrid)
  !
  ! Make beam, not normalized
  call uvmap_headers(huv,nx,ny,nbeam,schunk,map,mcol,hbeam,hdirty,error)  
  !
  if (do_cct) then
    call gdf_copy_header(hdirty,hclean,error)
    maxic = hcct%gil%dim(3) ! or maxic = maxval(smic)
    no = 7+3*schunk
    if (cct_compress) then
      ! Compress all CCTs first
      scct = hcct%gil%dim(2)
      allocate (ouv(no,huv%gil%dim(2)), p_cct(maxic), stat=ier)
    else
      ! Perform per-block compression        
      scct = schunk
      allocate (ouv(no,huv%gil%dim(2)), p_cct(maxic), stat=ier)
    endif
  else
    no = 7+3*schunk
    allocate (ouv(no,huv%gil%dim(2)), stat=ier)
    maxic = 0
  endif
  if (ier.ne.0) then
    call map_message(seve%e,rname,'UV data allocation error')
    error = .true.
    return
  endif
  !
  cname = rname
  !
  error = .false.
  if (nbeam.gt.1) then
    !$ othread = omp_get_max_threads()
    !$ nthread = min(othread,nbeam)
    !$ call ompset_thread_nesting(rname, nthread, othread, omp_nested)
    !$ call omp_set_num_threads(nthread)
  else
    !$ othread = omp_get_max_threads()
    !$ if (do_cct) then
    !$   call ompset_thread_nesting(rname, nthread, othread, omp_nested)
    !$ else
    !$   nthread = othread 
    !$   call ompset_thread_nesting(rname, nthread, othread, omp_nested)
    !$ endif
  endif
  !$ elapsed_s = omp_get_wtime()
  !
  ! Print *,'WCOL ',wcol,' RCOL ',rcol,' FREQ '
  ! Loop over blocks
  wold = 0.
!  read(5,*) wall
  if (do_weig.and.nbeam.eq.1) then
    do ic = fcol,lcol,schunk   
      wall = 0.    ! Initialize, this is mandatory
      !
      lc = min(lcol,ic+schunk-1) ! Bug correction 09-06-2016
      !
      if (sic_ctrlc()) then
        write(*,*) ' '
        write(chain,'(A,I0,A)') 'Abort request received'
        call map_message(seve%w,rname,chain,3)
        exit 
      endif
      if (abort) cycle
      !
      ! The weight channel choice depends on BEAM_STEP
      jc = min(lcol,ic+schunk/2)            ! The default weight channel here in auto mode...
      if (nbeam.eq.nchan) jc = lc           ! If One Beam per Channel
      if (nbeam.eq.1) jc = wcol             ! Reset the default weight channel
      !!Print *,'NBEAM ',nbeam,'; NCHAN',nchan,'; LC',lc,'; JC',jc,'; Wcol',wcol
      if (ic.le.wcol .and. ic+schunk.gt.wcol) then
        continue
      else
        cycle !! compute_weight = .false.
      endif
      !
      kz = min(schunk,lcol-ic+1)            ! The number of channels
      !! Print *,'IC ',ic,' JC ',jc,'MCOL ',fcol,lcol,' Schunk ',schunk
      !Print *,'Thread ',ithread,' IC ',ic,', KZ ',kz,', Schunk ',schunk
      !
      kb = (ic-fcol)/schunk+1
      if (kb.gt.nbeam .or. kb.lt.1) then
        !
        ! *** Actually, this is perfectly acceptable in the One Beam, Many Chunks case
        if (nbeam.gt.1) Print *,'Programming error, expected 0 < ',kb,' < ',nbeam+1
        kb = nbeam
      endif
      !
      w_w(:) = uvdata(7+3*jc,:)
      !
      wold = sump(nv,w_w)
      !
      ! Search for a non empty weight channel
      if ((wold.eq.0).and.(nbeam.ne.nchan))  then
        do kc=ic,min(ic+schunk,lcol) ! not  ,huv%gil%nchan)
          if (kc.ne.jc) then
            w_w(:) = uvdata(7+3*kc,:)
            wold = sump(nv,w_w)
            if (wold.ne.0) then
              jc = kc
              exit
            endif
          endif
        enddo
      endif
      !
      if (wold.eq.0) then
        write(chain,'(A,I0,A,I0)') 'Channel ',jc, ' has zero weight from ',lc
        hbeam%r3d(:,:,kb) = 0
        hdirty%r3d(:,:,kb) = 0
        walls(kb) = 0.0
        if (nbeam.eq.1) then
          call map_message(seve%e,rname,chain)
          error = .true.
        else
          call map_message(seve%w,rname,chain)
        endif
        cycle
      else
        wall = 1e-3/sqrt(wold)
        write(chain,'(a,i6,a)') 'Plane ',ic,' Natural '
        call prnoise('UV_MAP',trim(chain),wall,rms)
        walls(kb) = wall
        !! Print *,'Ithread ',ithread,' Wold ',wold,kb,' Walls(kb) ',kb,compute_weight
      endif
      !
      local_error = .false.
      call doweig (nu,nv,   &
         &    uvdata,   &          ! Visibilities
         &    1,2,    &            ! U, V pointers
         &    jc,     &            ! Weight channel
         &    map%uniform(1),   &  ! Uniform UV cell size
         &    w_weight,   &        ! Weight array
         &    map%uniform(2),   &  ! Fraction of weight
         &    w_v,              &  ! V values
         &    local_error,      &
         &    grid_code)           ! Gridding method (for tests)
      if (local_error)  then
        error = .true.
        exit
      endif
      !
      ! Should also plug the TAPER here, rather than in DOFFT later  !
      call dotape (nu,nv,   &
         &    uvdata,   &          ! Visibilities
         &    1,2,   &             ! U, V pointers
         &    map%taper,  &        ! Taper
         &    w_weight)            ! Weight array
      !
      ! Re-normalize the weights and re-count the noise
      wall = sump(nv,w_weight)
      if (wall.ne.wold) then
        call scawei (nv,w_weight,w_w,wall)
        wprt = 1E-3/sqrt(wall)
        write(chain,'(a,i6,a)') 'Plane ',ic,' Expected '
        call prnoise('UV_MAP',trim(chain),wprt,rms)
      endif
      !
      ! Declare the weight ready
      r_weight = w_weight
    enddo
    ! Ok, we got the weights now...
    do_weig = .false.
  else if (.not.do_weig) then
    wold = sump(nv,r_weight)
    !    
  endif
  !
!  Print *,'Nbeam ',nbeam,'DO_WEIG',do_weig
!  read(5,*) wall
  ! Loop over blocks
  !
  ! !$OMP PARALLEL if (.not.cct_compress) DEFAULT(none) &      ! For UV_MAP first
  !$OMP PARALLEL if (nblock.gt.1) NUM_THREADS(min(nblock,othread)) DEFAULT(none) &      ! For UV_MAP first
  !$OMP PRIVATE(tfgrid,ftbeam,beam,w_weight,w_w) &
  !$OMP PRIVATE(w_mapu,w_mapv,w_grid) &
  !$OMP PRIVATE(local_wfft,chain) &
  !$OMP PRIVATE(local_freq,support,wall,rms,uvcell,local_error) &
  !$OMP PRIVATE(kz,kb,kc,iz,ic, kz1, toto, jc,lc, cname) &
  !$OMP SHARED(walls,schunk,nbeam) &
  !$OMP SHARED(nu,nv,nx,ny,nchan,ndata,fcol,lcol,lx,ly, nthread) &
  !$OMP SHARED(map,null_taper,error) &
  !$OMP SHARED(conv,freq,do_weig, r_weight) &
  !$OMP SHARED(nn,ndim,huv,hbeam,hdirty,rname,meslock) &
  !$OMP SHARED(w_xgrid,w_ygrid,w_v,uvdata) &
  !$OMP SHARED(cpu0,cpu1) PRIVATE(elapsed_s, elapsed_e, elapsed, ithread) &
  !$OMP SHARED(maxic,hcct,hclean,no,do_cct,do_slow,method,do_copy) & ! For RESTORE
  !$OMP PRIVATE(pmic,pccou) & 
  !$OMP SHARED(smic,sccou,cct_compress) & 
  !$OMP PRIVATE(niter,ouv,p_cct,ier) &
  !$OMP PRIVATE(ix_min,ix_max,iy_min,iy_max,bmin,bmax,icmax) &
  !$OMP PRIVATE(my_method,fname,compute_weight) SHARED(my_major, my_minor, my_angle) &
  !$OMP SHARED(omp_debug) & 
  !$OMP SHARED(rcol, wold, wcol, grid_code, abort, jvm_factor, cspeed) &
  !$OMP SHARED(beam_defined, beam_fitted, beams_param)
  kz = 1 ! test for bug below
  !
  ! Print *,'KZ ',kz,' NChan ',nchan,' ndata ',ndata
  my_method = method
  my_method%method = 'RESTORE'
  !
  abort = .false.
  if (.not.cct_compress) then
    allocate(pccou(3,maxic,schunk), pmic(schunk), stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Cannot allocate CCT arrays')
      abort = .true.
    endif    
  endif 
  !
  !$OMP DO SCHEDULE(STATIC) 
  do ic = fcol,lcol,schunk   
    wall = 0    ! Initialize, this is mandatory
    !
    lc = min(lcol,ic+schunk-1) ! Last channel in chunk 
    !
    ithread = 1
    !$ ithread = omp_get_thread_num()+1
    !!$ if (ithread.eq.1) Print *,'Nbeam ',nbeam,'DO_WEIG',do_weig, ' NumThreads ',omp_get_num_threads()
    !$ elapsed_s = omp_get_wtime()
    !$ write(cname,'(A,A,I0,A)') trim(rname),'(',ic,')' 
    !
    if (sic_ctrlc()) then
      write(*,*) ' '
      write(chain,'(A,I0,A)') 'Abort request received by thread ',ithread
      call map_message(seve%w,rname,chain,3)
      abort = .true.
    endif
    if (abort) cycle
    !
    ! The weight channel choice depends on BEAM_STEP
    jc = min(lcol,ic+schunk/2)            ! The default weight channel here in auto mode...
    if (nbeam.eq.nchan) jc = lc           ! If One Beam per Channel
    if (nbeam.eq.1) jc = wcol             ! Reset the default weight channel
    !!Print *,'NBEAM ',nbeam,'; NCHAN',nchan,'; LC',lc,'; JC',jc,'; Wcol',wcol
    compute_weight = do_weig
    !
    kz = min(schunk,lcol-ic+1)            ! The number of channels
    !! Print *,'IC ',ic,' JC ',jc,'MCOL ',fcol,lcol,' Schunk ',schunk
    !Print *,'Thread ',ithread,' IC ',ic,', KZ ',kz,', Schunk ',schunk
    !
    kb = (ic-fcol)/schunk+1               ! The current beam number
    if (kb.gt.nbeam .or. kb.lt.1) then
      !
      ! *** Actually, this is perfectly acceptable in the One Beam, Many Chunks case
      if (nbeam.gt.1) Print *,'Programming error, expected 0 < ',kb,' < ',nbeam+1
      kb = nbeam
    endif
    !
    ! Load Natural weight array
    w_w(:) = uvdata(7+3*jc,:)
    !
    if (compute_weight) then
      !
      ! Compute the weight for this Chunk
      ! Natural weight first
      wold = sump(nv,w_w)
      !!Print *,'Wold ',wold,jc,ithread
      !
      ! Search for a non empty weight channel
      if ((wold.eq.0).and.(nbeam.ne.nchan))  then
        do kc=ic,min(ic+schunk,lcol) ! not  ,huv%gil%nchan)
          if (kc.ne.jc) then
            w_w(:) = uvdata(7+3*kc,:)
            wold = sump(nv,w_w)
            if (wold.ne.0) then
              jc = kc
              exit
            endif
          endif
        enddo
      endif
      !
      if (wold.eq.0) then
        write(chain,'(A,I0,A,I0)') 'Channel ',jc, ' has zero weight from ',lc
        hbeam%r3d(:,:,kb) = 0
        hdirty%r3d(:,:,kb) = 0
        walls(kb) = 0.0
        if (nbeam.eq.1) then    ! This should no longer happen
          call map_message(seve%e,rname,chain)
          error = .true.
        else
          call map_message(seve%w,rname,chain)
        endif
        cycle
      else
        wall = 1e-3/sqrt(wold)
        !!write(chain,'(a,i6,a)') 'Plane ',ic,' Natural '
        !!call prnoise('UV_MAP',trim(chain),wall,rms)
        walls(kb) = wall
  !!      Print *,'Ithread ',ithread,' Wold ',wold,kb,' Walls(kb) ',kb,compute_weight
      endif
      !
      ! Compute the Actual (Robust + Taper) weights from this
      !
      local_error = .false.
      call doweig (nu,nv,   &
         &    uvdata,   &          ! Visibilities
         &    1,2,    &            ! U, V pointers
         &    jc,     &            ! Weight channel
         &    map%uniform(1),   &  ! Uniform UV cell size
         &    w_weight,   &        ! Weight array
         &    map%uniform(2),   &  ! Fraction of weight
         &    w_v,              &  ! V values
         &    local_error,      &
         &    grid_code)           ! Gridding method (for tests)
      if (local_error)  then
        error = .true.
        cycle
      endif
      !
      ! Should also plug the TAPER here, rather than in DOFFT later  !
      call dotape (nu,nv,   &
         &    uvdata,   &          ! Visibilities
         &    1,2,   &             ! U, V pointers
         &    map%taper,  &        ! Taper
         &    w_weight)            ! Weight array
      !
      ! Re-normalize the weights and re-count the noise
      wall = sump(nv,w_weight)
      if (wall.ne.wold) call scawei (nv,w_weight,w_w,wall)
      !
!OLD      ! Declare the weight ready 
!OLD      if (nbeam.eq.1) then
!OLD        if (do_weig) then
!OLD          r_weight = w_weight
!OLD          Print *,'Assigned r_weight ',ithread,' but should not be there...'
!OLD        endif
!OLD      endif
      !
      write(chain,'(a,i6,a)') 'Plane ',ic,' Expected '
      walls(kb) = 1e-3/wall
      call prnoise(cname,trim(chain),walls(kb),rms)
      !
    else
      chain = 'Reusing weights'
      !$  write(chain(20:),'(a,i4)') ' - Thread ',ithread
      call map_message(seve%d,cname,chain)
      w_weight(:) = r_weight
      !
      wall = sump(nv,w_weight)
      if (wall.ne.wold) call scawei (nv,w_weight,w_w,wall)
      walls(kb) = 1e-3/sqrt(wall)
    endif
    !
    ! If null weight, move to next channel range
    if (wall.eq.0) then
      write(chain,'(a,i6,a)') 'Plane ',ic,' has zero weight' 
      call map_message(seve%w,cname,chain)
      cycle
    endif
    !
    ! Then compute the Dirty Beam
    if (rcol.eq.0) then
      local_freq = gdf_uv_frequency(huv, dble(ic))
    else
      local_freq = freq
    endif
    uvcell = map%uvcell * (freq / local_freq)
    support = map%support * (freq / local_freq)
    !
    call docoor (lx,-uvcell(1),w_mapu)
    call docoor (ly,uvcell(2),w_mapv)
    !
    ! Optionally remove the Clean components
    icmax = 0
    !
    if (maxic.ne.0) then
      ! Compact the Clean components first if not already done. Beware that if MCOL # 0, the
      ! CCT and Clean images channel range are offset from one another
      if (cct_compress) then
        pmic => smic(ic-fcol+1:lc-fcol+1)
      else
        call uv_clean_sizes(hcct,hcct%r3d,pmic,ic-fcol+1,lc-fcol+1) !! SOMEHOW ICC = IC-FCOL+1 and LCC = LC-FCOL+1 ???
      endif
      icmax = maxval(pmic)
      if (icmax.ne.0) then
        if (cct_compress) then
          freq = gdf_uv_frequency(huv,0.5d0*(ic+lc))
          pccou => sccou(:,:,ic-fcol+1:lc-fcol+1)
        else
          call uv_squeeze_clean(nchan,hcct%r3d,pccou, pmic,ic-fcol+1,lc-fcol+1) 
          write(chain,'(A,I0,A,4(I0,1X))') 'Clean sizes:  Max [',icmax,'] ',pmic(1:min(kz,4))
          call map_message(seve%d,cname,chain)        
        endif
        ! From here, OUV will be a (subset) copy of the whole UV data 
        ! and we compute the residuals
        freq = gdf_uv_frequency(huv,0.5d0*(ic+lc))
        if (do_slow) then
          call uv_removes_clean(nv,uvdata,ouv,lc-ic+1,pmic,pccou,freq,ic,lc) 
        else
          call uv_removef_clean(hcct,uvdata,ouv,lc-ic+1,pmic,pccou,freq,ic,lc)
        endif
      else
        ! No Clean component to remove: just extract.
        if (do_copy) call uv_extract_clean(uvdata,ouv,lc-ic+1,ic,lc)
        call map_message(seve%w,cname,'No valid Clean Component')
      endif
      !$  elapsed_e = omp_get_wtime()
      !$  elapsed = elapsed_e - elapsed_s
      !$  write(chain,'(a,f9.2,a)') 'Finished '//cspeed//' Clean subtraction ',elapsed
      !$  call map_message(seve%i,cname,chain)
    else if (do_copy) then
      call uv_extract_clean(uvdata,ouv,lc-ic+1,ic,lc)
    endif
    !
    if (.not.do_copy .and. icmax.eq.0) then
      !$ if (omp_debug) Print *,'OMP No copy '
      !
      ! Compute FFTs
      call dofft (nu,nv,          &   ! Size of visibility array
           &    uvdata,           &   ! Visibilities
           &    1,2,              &   ! U, V pointers
           &    ic,               &   ! First channel to map
           &    kz,lx,ly,         &   ! Cube size
           &    tfgrid,           &   ! FFT cube
           &    w_mapu,w_mapv,    &   ! U and V grid coordinates
           &    support,uvcell,null_taper, &  ! Gridding parameters
           &    w_weight,w_v,     &    ! Weight array + V Visibilities
           &    conv%ubias,conv%vbias,conv%ubuff,conv%vbuff,map%ctype)
    else
      !$ if (omp_debug) Print *,'OMP With copy '
      call dofft (no,nv,          &   ! Size of visibility array
           &    ouv,              &   ! Visibilities
           &    1,2,              &   ! U, V pointers
           &    1,                &   ! First channel to map
           &    kz,lx,ly,         &   ! Cube size
           &    tfgrid,           &   ! FFT cube
           &    w_mapu,w_mapv,    &   ! U and V grid coordinates
           &    support,uvcell,null_taper, &  ! Gridding parameters
           &    w_weight,w_v,     &    ! Weight array + V Visibilities
           &    conv%ubias,conv%vbias,conv%ubuff,conv%vbuff,map%ctype)
      !
    endif
    !
! *** May Compute the beam only if needed ***
! *** Currently, the extra cost of the Beam if small, so we re-compute it ***
! ****  in every Block ***
    !
    kz1 = kz+1
    call extracs(kz1,nx,ny,kz1,tfgrid,ftbeam,lx,ly)
    call fourt  (ftbeam, nn,ndim,-1,1,local_wfft)
    beam = 0.0
    call cmtore (ftbeam, beam ,nx,ny)
    call chkfft (beam, nx,ny, error)
    !!   Print *,ic,'BEAM ',nx,ny,beam(nx/2+1,ny/2+1)
    !!Print *,'NU,NV ',nu,nv
    !!Print *,'IC ',ic
    !!Print *,'KZ,LX,LY ',kz,lx,ly
    !!Print *,'support ',support,' uvcell ',uvcell, ' null_taper ',null_taper
    !!Print *,'conv%ubias,conv%vbias,map%ctype ',conv%ubias,conv%vbias,map%ctype
    !!Print *, ' '
    if (error) then
      Print *,ic,'BEAM ',nx,ny,beam(nx/2+1,ny/2+1),' NO ',no
      Print *,'Local freq ',local_freq
      Print *,'KZ, LX, LY ', kz,lx,ly, ' nx,ny ',nx,ny, ' Schunk ',schunk
      call map_message(seve%e,rname,'Inconsistent pixel size')
      cycle
    endif
    !
    ! Compute grid correction,
    ! Normalization factor is applied to grid correction, for further
    ! use on channel maps.
    !
    ! Make beam, not normalized
    call dogrid (w_grid,w_xgrid,w_ygrid,nx,ny,beam)  ! grid correction
    !
    ! Normalize and Free beam
    call docorr (beam,w_grid,nx*ny)
    !
    ! Fit beam if needed
    if (do_cct) then
      !
      ! If the fit has already been done, we can use it
      if (beam_defined) then
!        IFIELD = ?   and       IPLANE = ?
        my_method%major = beam_fitted(1) * sec_to_rad
        my_method%minor = beam_fitted(2) * sec_to_rad
        my_method%angle = beam_fitted(3)   ! Keep it Degree...
        if (ic.eq.fcol) then
          call pribeam(rname,method%major,method%minor,my_method%angle, 1, ic, beam_fitted(4))
          my_major = my_method%major
          my_minor = my_method%minor
          my_angle = my_method%angle
        endif
        call beam_plane(my_method,hbeam,hdirty)
        if (beam_fitted(4)-beams_param(4,my_method%ibeam,1).gt.0.01*beam_fitted(4)) then
          write(chain,'(A,I0,A,F7.3)') 'Beam plane is ',my_method%ibeam,' JVM factor ', &
            & beams_param(4,my_method%ibeam,1)
          call map_message(seve%i,cname,chain)
        endif
      else
        !
        my_method%major = 0
        my_method%minor = 0
        my_method%bzone=[1,1,nx,ny]
        call maxmap(beam,nx,ny,my_method%bzone,   &
            &      bmax,ix_max,iy_max,   &
            &      bmin,ix_min,iy_min)
        my_method%beam0 = [ix_max,iy_max]
        my_method%ibeam = kb
        !$OMP CRITICAL
        if (ic.eq.fcol) then
          fname = rname  ! Print beam
        else
          fname = ' '    ! Do not print beam
        endif
        !
        call beam_unit_conversion(my_method)
        call fibeam (fname,beam,nx,ny,   &
         &    my_method%patch(1),my_method%patch(2),my_method%thresh,   &
         &    my_method%major,my_method%minor,my_method%angle,   &
         &    hbeam%gil%convert,error)
        !
        my_major = my_method%major
        my_minor = my_method%minor
        my_angle = my_method%angle
        ! Print *,'fit results ',my_method%major, my_method%minor, my_method%angle
        !$OMP END CRITICAL
      endif
    endif
    !
    !
! *** End of LOCK in case of One Beam ***
    ! Wait for gridding correction to be computed
!    if (nbeam.eq.1) then
!      !$   if (ic.eq.fcol) then
!      !$     Print *,'Thread ',ithread,' freeing lck_grid'
!      !$     call omp_unset_lock(lck_grid)  ! Release the lock
!      !$   else
!      !$     Print *,'Thread ',ithread,' waiting for lck_grid'
!      !$     call omp_set_lock(lck_grid)    ! Wait for the Lock to be grasped
!      !$     Print *,'Thread ',ithread,' got lck_grid'
!      !$     call omp_unset_lock(lck_grid)  ! and free it immediately
!      !$   endif
!    endif
! *** End of One Beam region ***
    !
    ! Write beam
    hbeam%r3d(:,:,kb) = beam
    !
    ! Now extracts the Image planes...
    do iz=1,kz
      call extracs(kz+1,nx,ny,iz,tfgrid,ftbeam,lx,ly)
      call fourt  (ftbeam,nn,ndim,-1,1,local_wfft)
      call cmtore (ftbeam,beam,nx,ny)
      call docorr (beam,w_grid,ndata)
      ! Write the subset
      kc = ic-fcol+iz
      hdirty%r3d(:,:,kc) = beam
      !
      if (do_cct) then
        !
        ! And add the Clean Components
        ! Recover the component list in pixels
        !
        niter = pmic(iz)
        do icc = 1,pmic(iz)
          !
          ! The NINT is required because of rounding errors
          p_cct(icc)%ix = nint( (pccou(1,icc,iz)-hdirty%gil%convert(2,1)) /  &
              &        hdirty%gil%convert(3,1) + hdirty%gil%convert(1,1))
          p_cct(icc)%iy = nint( (pccou(2,icc,iz)-hdirty%gil%convert(2,2)) /  &
              &        hdirty%gil%convert(3,2) + hdirty%gil%convert(1,2))
          p_cct(icc)%value = pccou(3,icc,iz)
        enddo
        !
        ! Compute Clean image and add back residual
        if (niter.gt.0) then
          my_method%n_iter = niter
          call clean_make90(my_method,hclean,hclean%r3d(:,:,kc),p_cct)
          ! There is only 1 field in this case, so only 1 jvm_factor per channel
          hclean%r3d(:,:,kc) = hclean%r3d(:,:,kc) + hdirty%r3d(:,:,kc) * jvm_factor
        else
          hclean%r3d(:,:,kc) = hdirty%r3d(:,:,kc) * jvm_factor
        endif
        if (niter.lt.maxic) p_cct(niter+1)%value = 0 ! Required to signal end-of-list
      endif
      !
    enddo
    !
    !$  elapsed_e = omp_get_wtime()
    elapsed = elapsed_e - elapsed_s
    write(chain,103) 'End plane ',kc,' Time ',elapsed,' Thread ',ithread
    call map_message(seve%d,cname,chain)
    !
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  !$  call omp_set_nested(omp_nested)
  !$  call omp_set_num_threads(othread)
  if (abort) then
    call map_message(seve%e,cname,'Abort by user',3)
    error = .true.
  endif
  if (error) return
  !
  if (nbeam.eq.1) do_weig = .false.
  !
  method%major = my_major
  method%minor = my_minor
  method%angle = my_angle
  !
  ! Set the clean Beam value too
  !
  call gag_cpu(cpu1)
  !$  elapsed_e = omp_get_wtime()
  !$  elapsed = elapsed_e - elapsed_s
  if (elapsed.eq.0) then
    write(chain,102) 'Finished maps CPU ',cpu1-cpu0
  else
    write(chain,102) 'Finished maps Elapsed ',elapsed,'; CPU ',cpu1-cpu0
  endif
  call map_message(seve%i,rname,chain)
  !
  call cube_minmax('DIRTY',hdirty,error)
  call cube_minmax('BEAM',hbeam,error)
  !
  wall = maxval(walls(1:nbeam))
  call prnoise(rname,'Expected',wall,rms)
  hdirty%gil%noise = wall
  hclean%gil%noise = wall ! Also for the Restored clean map
  !  !
  ! Delete scratch space
  error = .false.
  if (nbeam.ne.1)  deallocate(w_grid)
  if (allocated(tfgrid)) deallocate(tfgrid)
  if (allocated(ftbeam)) deallocate(ftbeam)
  if (allocated(w_xgrid)) deallocate(w_xgrid)
  if (allocated(w_ygrid)) deallocate(w_ygrid)
  return
  !
102 format(a,f9.2,a,f9.2)
103 format(a,i5,a,f9.2,a,i2,a,i2)
end subroutine uvmap_and_restore
!
subroutine uv_removes_clean(nv,duv,ouv,nc,mic,dcct,freq,first,last)
  use image_def
  use gbl_message
  !$ use omp_lib
  !-----------------------------------------------------------------
  ! @ private-mandatory
  !
  ! IMAGER   Support for UV_RESTORE
  !     Compute visibilities for a UV data set according to a
  !     set of Clean Components , and remove them from the original
  !     UV table.
  !       Semi-Slow version using interpolation from pre-tabulated
  !       Sin/Cos, which could still be optimized
  !-----------------------------------------------------------------
  integer, intent(in) :: nv         ! Number of visibilities
  real, intent(in) :: duv(:,:)      ! UV data set
  integer, intent(in) :: nc         ! Number of channels
  integer, intent(in) :: mic(:)     ! Number of Clean Components
  real, intent(out) :: ouv(:,:)     ! Extracted UV data set
  real, intent(in) :: dcct(:,:,:)   ! Clean component
  real(8), intent(in) :: freq       ! Apparent observing frequency
  integer, intent(in) :: first      ! First channel
  integer, intent(in) :: last       ! Last channel
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: f_to_k=2.d0*pi/299792458.d-6
  integer, external :: ompget_inner_threads
  !
  real(8) :: pidsur            ! 2*pi*D/Lambda
  real(8) :: phase, cp, sp
  real(4) :: rvis, ivis, value
  integer ii, ir, iw
  integer oi, or, ow
  integer ic,iv,jc,kc
  !
  integer :: no, icmax
  integer :: nthread
  !
  pidsur = f_to_k * freq
  !
  no = ubound(mic,1)
  if (no.lt.last-first+1 .or. no.gt.ubound(dcct,3)) then
    Print *,'Remove Clean Slow dimension error ',no,last-first+1,ubound(dcct,3)
  endif
  icmax = maxval(mic)
  if (icmax.gt.ubound(dcct,2))  then
    Print *,'Remove Clean Slow -- too many Clean Comp.',icmax,ubound(dcct,2)
  endif
  !!Print *,'CCT Bounds ',ubound(dcct),' FIRST ',first,' LAST ',last
  !
  ! Remove clean component from UV data set
  !
  !$ nthread = ompget_inner_threads() 
  !$OMP PARALLEL DEFAULT(none) NUM_THREADS(nthread) &
  !$OMP    & SHARED(duv,ouv,dcct)  SHARED(pidsur,nv,first,last,mic) &
  !$OMP    & PRIVATE(iv,jc,ic,kc,ir,ii,iw,or,oi,ow,phase,rvis,ivis,cp,sp) &
  !$OMP    & PRIVATE(value) 
  !
  !$OMP DO SCHEDULE(DYNAMIC,32)
  do iv=1,nv            ! Visibilies
    ouv(1:7,iv) = duv(1:7,iv)
    do jc = first,last  ! Channels
      ir = 5+3*jc
      ii = 6+3*jc
      iw = 7+3*jc
      !
      kc = jc-first+1
      or = 5+3*kc      
      oi = 6+3*kc
      ow = 7+3*kc
      !
      ouv(or,iv) = duv(ir,iv)
      ouv(oi,iv) = duv(ii,iv)
      do ic = 1,mic(kc) ! Clean components
        if (dcct(3,ic,kc).ne.0) then
          value = dcct(3,ic,kc)
          phase = (ouv(1,iv)*dcct(1,ic,kc) + ouv(2,iv)*dcct(2,ic,kc))*pidsur
          cp = cos(phase)
          sp = sin(phase)
          !!call cossin(phase,cp,sp)
          rvis = value*cp
          ivis = value*sp
          ouv(or,iv) = ouv(or,iv) - rvis   ! Subtract
          ouv(oi,iv) = ouv(oi,iv) - ivis
        else if (iv.eq.1) then
          Print *,'Premature end of work for channel ',jc, kc, mic(kc)
          exit ! End of work, jump to next channel
        endif
      enddo             ! Clean components
      ouv(ow,iv) = duv(iw,iv)
    enddo               ! Channels
  enddo                 ! Visibilities
  !$OMP END DO
  !$OMP END PARALLEL
end subroutine uv_removes_clean
!
subroutine uv_squeeze_clean(nc,ccin,ccou, mic, first, last)
  use image_def
  !$ use omp_lib
  !-----------------------------------------------------------------
  ! @ private-mandatory
  !
  ! IMAGER   Support for UV_RESTORE
  !   Compact the component list by summing up all values at the
  !   same position in a range of channels.
  !   The output list has a transposed order
  !-----------------------------------------------------------------
  integer, intent(in) :: nc         ! Number of channels
  real, intent(in) :: ccin(:,:,:)   ! Initial Clean Component List
  real, intent(out) :: ccou(:,:,:)  ! Resulting list
  integer, intent(inout) :: mic(:)  ! Number of Clean component per channel
  integer, intent(in) :: first      ! First channel
  integer, intent(in) :: last       ! Last channel
  !
  integer :: ii,jj,ic,jc,kc
  integer :: ki    ! Number of different components per channel
  integer :: nin   ! Number of input channels
  logical doit
  integer :: ithread
  !
  ccou = 0
  !
  nin = size(ccin,2)    ! That is the number of channels
  if (nin.eq.1) then
    ki = 0
    do ii=1,mic(1)
      if (ccin(3,1,ii).eq.0) then
        exit
      else
        doit = .true.
        do jj=1,ki
          if (ccou(1,jj,1).eq.ccin(1,1,ii)) then
            if (ccou(2,jj,1).eq.ccin(2,1,ii)) then
              doit = .false.
              ccou(3,jj,1) = ccou(3,jj,1) + ccin(3,1,ii)
              exit
            endif
          endif
        enddo
        if (doit) then
          ki = ki+1
          ccou(1:3,ki,1) = ccin(1:3,1,ii)
        endif
      endif
    enddo
    mic(1) = ki
    !
    ! Then duplicate 
    do ic=2,last-first+1
      ccou(:,:,ic) = ccou(:,:,1)
    enddo
  else
    !
    !$OMP PARALLEL DEFAULT(none) SHARED(ccin,ccou) &
    !$OMP    & SHARED(first,last, mic, nin) &
    !$OMP    & PRIVATE(ic,jc,kc,ki, ii, doit, ithread)   
    !
    ithread = 1
    !$ ithread = omp_get_thread_num()+1
    !$OMP DO
    do ic=first,last
      jc = ic-first+1
      ki = 0
      do ii=1,mic(jc)
        kc = min(ic,nin)
        if (ccin(3,kc,ii).eq.0) then
          exit
        else
          doit = .true.
          do jj=1,ki
            if (ccou(1,jj,jc).eq.ccin(1,kc,ii)) then
              if (ccou(2,jj,jc).eq.ccin(2,kc,ii)) then
                doit = .false.
                ccou(3,jj,jc) = ccou(3,jj,jc) + ccin(3,kc,ii)
                exit
              endif
            endif
          enddo
          if (doit) then
            ki = ki+1
            ccou(1:3,ki,jc) = ccin(1:3,ic,ii)
          endif
        endif
      enddo
      mic(jc) = ki
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
  endif
end subroutine uv_squeeze_clean
!
subroutine uv_removef_clean(hcct,duv,ouv,nc,mic,dcct,freq,first,last)
  use image_def
  use imager_interfaces, except_this => uv_removef_clean
  use gbl_message
  !$ use omp_lib
  !-----------------------------------------------------------------
  ! @ private-mandatory
  !
  ! IMAGER   Support for UV_RESTORE
  !     Compute visibilities for a UV data set according to a
  !     set of Clean Components , and remove them from the original
  !     UV table
  !   This version is for tranpose CCT data (3,ncomp,nchannels)
  !   and uses an intermediate FFT for speed
  !-----------------------------------------------------------------
  type(gildas), intent(in) :: hcct  ! header of Clean Components Table
  integer, intent(in) :: nc         ! Number of channels
  integer, intent(in) :: mic(:)     ! Number of Clean Components
  real, intent(in) :: duv(:,:)      ! Input visibilities
  real, intent(out) :: ouv(:,:)     ! Output visibilities
  real, intent(in) :: dcct(:,:,:)   ! Clean components
  real(8), intent(in) :: freq       ! Apparent observing frequency
  integer, intent(in) :: first      ! First
  integer, intent(in) :: last       ! and last channel
  !
  integer :: nv    ! Number of visibilities
  integer :: mv    ! Size of a visibility
  integer :: nx,ny
  integer :: mx,my
  integer :: kx,ky
  real :: rx,ry,dxy
  real :: value
  complex, allocatable :: cfft(:,:,:)
  real, allocatable :: work(:)
  integer :: iplane,ic,ix,iy,iv,ier, dim(2)
  logical :: error
  real(8) :: xinc, yinc, xref, yref, xval, yval
  real(8), parameter :: pi=3.14159265358979323846d0
  integer :: ithread, mthread, lx,ly
  !
  nv = ubound(duv,2)    ! Number of Visibilities
  !! Print *,'Number of visibilities ',nv,' in removef_clean'
  mv = 7+3*nc
  !
  ! Image size
  mx = (hcct%gil%convert(1,1)-1)*2
  my = (hcct%gil%convert(1,3)-1)*2
  !
  ! Define the image size
  rx = log(float(mx))/log(2.0)
  kx = nint(rx)
  if (kx.lt.rx) kx = kx+1
  nx = 2**kx
  ry = log(float(my))/log(2.0)
  ky = nint(ry)
  if (ky.lt.ry) ky = ky+1
  ny = 2**ky
  kx = max(nx,ny)
  kx = min(4*kx,4096)
  !
  ! If the image is already fine enough, use it "as is"
  !    even if it is not a power of two...
  nx = max(kx,mx)  ! max(kx,nx) for power of two
  ny = max(kx,my)  ! max(kx,ny) for power of two
  !
  ! Get Virtual Memory & compute the FFT
  allocate(cfft(nx,ny,nc),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,'UV_RESTORE','uv_removef_clean -- allocation error')
    error = .true.
    return
  endif
  !
  xref = hcct%gil%convert(1,1)
  xval = hcct%gil%convert(2,1)
  xinc = hcct%gil%convert(3,1)
  yref = hcct%gil%convert(1,3)
  yval = hcct%gil%convert(2,3)
  yinc = hcct%gil%convert(3,3)
  dim = [nx,ny]
  !
  !  call fourt_plan(ftbeam,dim,2,1,1)
  ithread = 1
  !
  kx = mx/2+1
  lx = nx/2+1
  ky = my/2+1
  ly = ny/2+1
  !
  ! Oops, must set the number of threads according to number of channels
  ! and available Thread nesting
  mthread = 1
  !$ mthread = ompget_inner_threads()
  mthread = min(nc,mthread)
  !
  !$OMP PARALLEL IF (nc.gt.1) DEFAULT(none) NUM_THREADS(mthread) SHARED(dcct,cfft) &
  !$OMP    & SHARED(nc,mic,nx,ny,mx,my,dim,xinc,yinc,xref,yref,xval,yval) &
  !$OMP    & PRIVATE(iplane,ic,ix,iy,value,ier) PRIVATE(work) &
  !$OMP    & PRIVATE(dxy,ithread) SHARED(kx,lx,ky,ly)
  !
  !$ ithread = omp_get_thread_num()+1
  allocate(work(2*max(nx,ny)),stat=ier)
  !$OMP DO
  do iplane=1,nc
    cfft(:,:,iplane) = 0.0
    do ic=1,mic(iplane)
      if (dcct(3,ic,iplane).eq.0) exit
      !
      value = dcct(3,ic,iplane)
      ! The NINT is required because of rounding errors
      ix = nint( (dcct(1,ic,iplane)-xval) / xinc + xref )
      iy = nint( (dcct(2,ic,iplane)-yval) / yinc + yref )
      cfft(ix-kx+lx,iy-ky+ly,iplane) = cfft(ix-kx+lx,iy-ky+ly,iplane) + & 
        & cmplx(value,0.0)
    enddo
    !
    ! FOURT is now Thread-safe for the non-FFTW version.
    call fourt(cfft(:,:,iplane),dim,2,1,1,work)
    call recent(nx,ny,cfft(:,:,iplane))
  enddo
  !$OMP END DO
  deallocate(work)
  !$OMP END PARALLEL
  !
  ! Extract the visibility subset
  do iv = 1,nv
    ouv(1:7,iv) = duv(1:7,iv)
    ouv(8:mv,iv) = duv(5+3*first:7+3*last,iv)
  enddo
  !
  ! Interpolate and subtract the model visibilities
  call do_smodel(ouv,mv,nv,cfft,nx,ny,nc,freq,xinc,yinc,1.0,mthread)
  !
  deallocate(cfft)
end subroutine uv_removef_clean
!
subroutine cossin(phase,rcos,rsin)
  !-------------------------------------------------------
  ! Semi-Fast,  Semi-accurate Sin/Cos pair computation
  ! using (not yet clever) interpolation from a precise
  ! loop-up table
  !
  ! A solution using Taylor expansion and symmetries
  ! would be faster and more accurate
  !-------------------------------------------------------
  real(8), intent(inout) :: phase
  real(8), intent(out) :: rcos
  real(8), intent(out) :: rsin

!!  integer, intent(inout) :: ier
!!  real(8), intent(in) :: maxerr
!!  real(8), intent(inout) :: themax
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  integer, parameter :: mcos=2048
  integer, save :: ncos = 0
  real(8), save :: cosine(mcos)
  real(8), save :: sine(mcos)
  real(8), save :: rstep
  real(8) :: rdeg
  integer :: i
  logical :: minus
  !
  ! Use accurate value
  rcos = cos(phase)
  rsin = sin(phase)
  !
  ! Approximate solution below
  if (.TRUE.) return
  !
  if (ncos.eq.0) then
    ncos = mcos
    rstep = 2.01d0*pi/mcos
    do i=1,ncos
      rdeg = (i-1)*rstep
      cosine(i) = cos(rdeg)
      sine(i) = sin(rdeg)
    enddo
  endif
  !
  if (phase.ge.0) then
    minus =.false.
    rdeg = modulo(phase,2.0d0*pi)+0.5d0*rstep
  else
    minus = .true.
    rdeg = modulo(-phase,2.0d0*pi)+0.5d0*rstep
  endif
  rdeg = rdeg/rstep
  i = int(rdeg)
  rdeg = rdeg - i
  i = i+1
  rcos = (1.0-rdeg)*cosine(i) + rdeg*cosine(i+1)
  rsin = (1.0-rdeg)*sine(i) + rdeg*sine(i+1)
  if (minus) rsin = -rsin
end subroutine cossin
!
subroutine uv_extract_clean(duv,ouv,nc,first,last)
  !-----------------------------------------------------------------
  ! @ private-mandatory
  !
  ! IMAGER   Support for UV_MAP  &  UV_RESTORE
  !     Extract a subset of visibilities
  !-----------------------------------------------------------------
  integer, intent(in) :: nc         ! Number of channels
  real, intent(in) :: duv(:,:)      ! Input visbilities
  real, intent(out) :: ouv(:,:)     ! Output visibilities
  integer, intent(in) :: first      ! First channel
  integer, intent(in) :: last       ! Last channel
  !
  integer :: iv, nv
  !
  nv = ubound(duv,2)                ! Number of Visibilities
  !
  do iv=1,nv
    ouv(1:7,iv) = duv(1:7,iv)
    ouv(8:,iv) = duv(5+3*first:7+3*last,iv)
  enddo
end subroutine uv_extract_clean
!
subroutine uv_clean_sizes(hcct,ccin, mic, first, last)
  use image_def
  !-----------------------------------------------------------------
  ! @ private-mandatory
  !
  ! IMAGER   Support for UV_RESTORE
  !   Compute the actual number of components
  !-----------------------------------------------------------------
  type(gildas), intent(in) :: hcct  ! header of CCT data set
  real, intent(in) :: ccin(:,:,:)   ! Clean component table
  integer, intent(out) :: mic(:)    ! Number of iterations per channel
  integer, intent(in) :: first      ! First
  integer, intent(in) :: last       ! and last channel
  ! Local
  integer :: nc
  integer :: ni, ki
  integer :: i,ic,jc, mi
  !
  nc = hcct%gil%dim(2)  ! Number of channels
  ni = hcct%gil%dim(3)  ! Maximum number of Clean Components
  ! 
  !!Print *,'Number of channels in CCT ',nc
  !!Print *,'First & Last ',first,last
  !
  if (nc.eq.1) then
    mi = ni
    do i=1,ni
      if (ccin(3,1,i).eq.0) then
        mi = i-1
        exit
      endif
    enddo
    mic(:) = mi
  else
    !
    mic(:) = ni ! Up to the last one
    do ic=first,last
      jc = ic-first+1
      ki = 0
      do i=1,ni
        if (ccin(3,ic,i).eq.0) then
          mic(jc) = i-1
          exit
        endif
      enddo
    enddo
  endif
end subroutine uv_clean_sizes
!
subroutine do_smodel (visi,nc,nv,a,nx,ny,nf,freq,xinc,yinc,factor,mthread)
  !$ use omp_lib
  !-----------------------------------------------------------------
  ! @ private-mandatory
  !
  ! IMAGER   Support for UV_RESTORE
  !
  !     Remove model visibilities from UV data set.
  !     Interpolate from a grid of values obtained by FFT before.
  !-----------------------------------------------------------------
  integer, intent(in) :: nc ! Visibility size
  integer, intent(in) :: nv ! Number of visibilities
  integer, intent(in) :: nx ! X size
  integer, intent(in) :: ny ! Y size
  integer, intent(in) :: nf ! Number of frequencies
  real, intent(inout) :: visi(:,:)    ! Computed visibilities
  real(8), intent(in) :: freq         ! Effective frequency
  real, intent(in)  :: factor         ! Flux factor
  complex, intent(in) ::  a(:,:,:)    ! FFT
  real(8), intent(in) :: xinc,yinc    ! Pixel sizes
  integer, intent(in) :: mthread
  !
  real(8), parameter :: clight=299792458d0
  real(8) :: kwx,kwy,stepx,stepy,lambda,xr,yr
  complex(8) :: aplus,amoin,azero,afin
  integer i,if,ia,ja
  !
  lambda = clight/(freq*1d6)
  stepx = 1.d0/(nx*xinc)*lambda
  stepy = 1.d0/(ny*yinc)*lambda
  !
  ! Loop on visibility
  !$OMP PARALLEL DEFAULT(none) NUM_THREADS(mthread) &
  !$OMP   SHARED(visi,a, factor,nc,nv,nf,nx,ny,stepx,stepy) &
  !$OMP   PRIVATE(kwx,ia,kwy,ja,xr,yr,aplus,azero,amoin,afin,if) 
  !$OMP DO
  do i = 1, nv
    kwx =  visi(1,i) / stepx + dble(nx/2 + 1)
    ia = int(kwx)
    if (ia.le.1) cycle
    if (ia.ge.nx) cycle
    kwy =  visi(2,i) / stepy + dble(ny/2 + 1)
    ja = int(kwy)
    if (ja.le.1) cycle
    if (ja.ge.ny) cycle
    !
    xr = kwx - ia
    yr = kwy - ja
    do if=1,nf
      !
      ! Interpolate (X or Y first, does not matter in this case)
      aplus = ( (a(ia+1,ja+1,if)+a(ia-1,ja+1,if)   &
   &          - 2.d0*a(ia,ja+1,if) )*xr   &
   &          + a(ia+1,ja+1,if)-a(ia-1,ja+1,if) )*xr*0.5d0   &
   &          + a(ia,ja+1,if)
      azero = ( (a(ia+1,ja,if)+a(ia-1,ja,if)   &
   &          - 2.d0*a(ia,ja,if) )*xr   &
   &          + a(ia+1,ja,if)-a(ia-1,ja,if) )*xr*0.5d0   &
   &          + a(ia,ja,if)
      amoin = ( (a(ia+1,ja-1,if)+a(ia-1,ja-1,if)   &
   &          - 2.d0*a(ia,ja-1,if) )*xr   &
   &          + a(ia+1,ja-1,if)-a(ia-1,ja-1,if) )*xr*0.5d0   &
   &          + a(ia,ja-1,if)
      ! Then Y (or X)
      afin = ( (aplus+amoin-2.d0*azero)   &
   &          *yr + aplus-amoin )*yr*0.5d0 + azero
      !
      visi(5+3*if,i) =  visi(5+3*if,i) - real(afin)*factor
      visi(6+3*if,i) =  visi(6+3*if,i) - imag(afin)*factor
    enddo
  enddo
  !$OMP ENDDO
  !$OMP END PARALLEL
end subroutine do_smodel
!
