
subroutine uv_residual(line,error)
  use gkernel_interfaces
  use mapping_interfaces, except_this=>uv_residual
  use clean_def
  use clean_arrays
  use clean_types
  use clean_default
  use gbl_message
  !$ use omp_lib
  !------------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING   Support for routine UV_RESIDUAL
  !     Remove all Clean Components from a UV Table
  !
  ! Input :
  !     a precessed UV table
  !     a list of Clean Components, in DCCT format
  !      i.e. (x,y,v)(iplane,icomponent)
  !     this organisation is not efficient, and one may need to switch to
  !           (x,y,v,)(icomponent,iplane)
  !     which is more easily transmitted
  ! Output :
  !     a precessed, rotated, shifted UV table, sorted in V,
  !     ordered in (U,V,W,D,T,iant,jant,nchan(real,imag,weig))
  !
  !------------------------------------------------------------------------
  character(len=*), intent(inout) :: line
  logical, intent(out) :: error
  !
  real, pointer :: duv_previous(:,:), duv_next(:,:)
  character(len=*), parameter :: task='UV_RESIDUAL'
  !
  nullify(duv_previous,duv_next)
  !
  call sub_uv_residual(task,line,duv_previous,duv_next,.false.,error)
  if (error) return
  !
  ! Clean the allocated stuff here to keep only the residual...
  call uv_clean_buffers (duv_previous, duv_next,error)
  if (error) return
  !
  if (allocated(duvt)) deallocate (duvt)            ! UV data not plotted
  uv_plotted = .false.
  !
  ! Indicate optimization and save status
  optimize(code_save_uv)%change = optimize(code_save_uv)%change + 1
  save_data(code_save_uv) = .true.
  !
  ! Not needed here: weights are unchanged
  ! do_weig = .true.  ! Recompute weight 
  !
  ! Resize UV data and redefine SIC variables 
  huv%gil%nvisi = ubound(duv,2)
  huv%gil%dim(2) = huv%gil%nvisi
  !
  call sic_delvariable ('UV',.false.,error)
  call sic_def_real ('UV',duv,huv%gil%ndim,huv%gil%dim,.true.,error)
end subroutine uv_residual
!
subroutine sub_uv_residual(task,line,duv_previous,duv_next,do_clean,error)
  use gkernel_interfaces
  use mapping_interfaces, except_this=>sub_uv_residual
  use clean_def
  use clean_arrays
  use clean_types
  use clean_default
  use gbl_message
  !$ use omp_lib
  !------------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING   Support for routine UV_RESIDUAL
  !     Remove all Clean Components from a UV Table
  !
  ! Input :
  !     a precessed UV table
  !     a list of Clean Components, in DCCT format
  !      i.e. (x,y,v)(iplane,icomponent)
  !     this organisation is not efficient, and one may need to switch to
  !           (x,y,v,)(icomponent,iplane)
  !     which is more easily transmitted
  ! Output :
  !     a precessed, rotated, shifted UV table, sorted in V,
  !     ordered in (U,V,W,D,T,iant,jant,nchan(real,imag,weig))
  !
  !------------------------------------------------------------------------
  character(len=*), intent(in) :: task
  character(len=*), intent(inout) :: line
  real, pointer, intent(out) :: duv_previous(:,:)
  real, pointer, intent(out) :: duv_next(:,:)
  logical, intent(in) :: do_clean
  logical, intent(out) :: error
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: f_to_k = 2.d0*pi/299792458.d-6
  !
  real(8) :: freq
  character(len=message_length) :: chain
  real :: cpu0, cpu1
  integer :: ier,nu,nv,nchan
  !
  type(gildas) :: occt
  real, pointer :: duv_in(:,:), duv_out(:,:)
  real, allocatable :: ccou(:,:,:), lduv(:,:)
  integer, allocatable :: mic(:)
  integer :: maxic, ic,lc, icmax, oic, olc, istep, iv, ichan
  integer :: othread, nthread, ithread, sblock
  logical :: fast, debug
  real(8) :: elapsed_s, elapsed_e, elapsed
  real(4) :: rmega
  ! For mosaics
  real(4) :: beamp(3), bsize
  integer :: ifield, jfield, nfields! Field number & Number of fields
  real, allocatable :: doff(:,:)    ! Field offsets
  integer, allocatable :: ivoff(:)  ! Input Visibility pointers
  integer, allocatable :: jvoff(:)  ! Output Visibility pointers
  integer :: mv ! Maximum number of Visibilities per field
  integer :: ivstart, ivend, kvstart, kvend
  logical :: sorted, shift
  real(8) :: new(3)
  real(4) :: uvmin, uvmax
  logical, parameter :: fromressection=.true.
  !
  nu = huv%gil%dim(1)
  nv = huv%gil%dim(2)
  nchan = huv%gil%nchan !! (nu-7)/3
  ic = 1
  lc = nchan
  ithread = 1
  nthread = 1
  elapsed_e = 0.
  elapsed_s = 0.
  elapsed = 0.
  error = .false.
  !
  beamp(:) = 0.
  !
  ! Subtract all Clean Components
  if (.not.associated(duv)) then
    call map_message(seve%e,task,'DUV is NOT allocated')
    error = .true.
    return
  endif
  if (.not.allocated(dcct)) then
    call map_message(seve%e,task,'DCCT is NOT allocated')
    error = .true.
    return
  endif
  !
  maxic = hcct%gil%dim(3)
  call sic_i4(line,0,1,maxic,.false.,error)
  if (error) return
  if (maxic.lt.0) maxic = hcct%gil%dim(3)
  maxic = min(hcct%gil%dim(3),maxic)
  if (maxic.eq.0) return ! Nothing to do then...
  !
  allocate (mic(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
  hcct%r3d => dcct
  call uv_clean_sizes(hcct,hcct%r3d,mic,ic,lc)
  icmax = maxval(mic)
  !
  ! Nothing to do if not Clean component
  if (icmax.eq.0) then
    call map_message(seve%w,task,'No valid Clean Component')
    return
  endif  
  !
  fast = .true.
  call sic_get_logi('FAST',fast,error)
  error = .false.
  !
  call gag_cpu(cpu0)
  !
  if (themap%nfields.ne.0) then
    shift = .false.
    sorted = .false.
    error = .false.
    call mosaic_sort (error,sorted,shift,new,uvmax,uvmin, &
      & huv%gil%column_pointer(code_uvt_xoff), &
      & huv%gil%column_pointer(code_uvt_yoff), &
      & nfields,doff,ivoff)
    if (error) return
    allocate(jvoff(nfields+1),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,task,'Memory allocation error')
      error = .true.
      return
    endif
    !
    ! Compute max number of visibilities per field
    mv = 0
    do ifield=1,nfields
      mv  = max(mv,ivoff(ifield+1)-ivoff(ifield))
    enddo
    !
    ! Get primary beam size
    call get_bsize(huv,task,' ',fromressection,bsize,error)
    !
    if (selected_fieldsize.ne.0) then
      if (.not.allocated(selected_fields)) then
        call map_message(seve%f,task, &
          & 'Programming error, Selected_Fields not allocated')
        error = .true.
        return
      endif
      nv = 1
      do jfield=1,selected_fieldsize
        ifield = selected_fields(jfield)
        jvoff(jfield) = nv
        nv = nv + ivoff(ifield+1)-ivoff(ifield)
        jvoff(jfield+1) = nv
      enddo
      nv = nv-1
      nfields = selected_fieldsize
    else
      jvoff = ivoff
    endif
  else
    nfields = 1
    allocate(doff(2,1),ivoff(2),jvoff(2),stat=ier)
    doff = 0.0
    bsize = 0.
    ivoff(1) = 1
    ivoff(2) = nv+1
    jvoff = ivoff
    mv = nv
    !
  endif      
  !
  ! Prepare appropriate array...
  nullify (duv_previous, duv_next)
  call uv_find_buffers (task,nu,nv,duv_previous, duv_next,error)
  if (error) then
    call map_message(seve%e,task,'Cannot set buffer pointers')
    return
  endif
  !
  ! Redo that by block - At this stage NFIELDS is the actual number
  ! of selected fields.
  !
  oic = ic    ! This must be 1
  olc = lc    ! This must be nchan
  !
  ! Divide in as many blocks as threads
  othread = 1
  !$  othread = omp_get_max_threads()
  nthread = min(othread,nchan)
  !
  ! Parallelism is most appropriate per plane
  if (nthread.gt.nfields .and. fast) then
    !$  call omp_set_num_threads(nthread)
    !
    ! The code here is for Mosaics
    !   - identification of the Visiblity Ranges 
    !   - Loop over all fields
    !   - Replaced loop over 1,NV  by  IvStart,IvEnd for each range    !
    !   - Multiply the CCT Table by appropriate primary beam,
    !     after squeezing of course - This is done in the
    !     uv_removes and uv_removes_clean routines, by 
    !     additional arguments (0 if no beam),
    !     as the values of CCT are used there only.
    ! 
    ! The loop is done by using Pointers
    !     DUV_IN  => DUV(:,IvStart:IvEnd)
    ! and DUV_OUT => DUV_NEXT(:,IvStart:IvEnd)
    deallocate(mic)
    !
    ! With this formula, we need as much work space as the original
    ! UV data set - That may be huge...
    istep = (nchan+nthread-1)/nthread      
    ! Here we limit to SPACE_MAPPING per thread
    ! The FFT size is not accounted for, however, in either case...
    ier = sic_ramlog('SPACE_MAPPING',rmega)
    sblock = max(int(256.0*rmega*1024.0)/(3*(nv+icmax)),1)
    istep = min(istep,sblock)
    !
    ! Allocate to Max number of visibilities...
    allocate(mic(istep),ccou(3,icmax,istep),lduv(1:7+3*istep,mv),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,task,'Memory allocation error')
      error = .true.
      return
    endif
    !
    do jfield=1,nfields
      ifield = selected_fields(jfield)
      ivstart = ivoff(ifield)      ! Starting Visibility of field
      ivend   = ivoff(ifield+1)-1  ! Ending Visibility of field
      kvstart = jvoff(jfield)      ! Starting Visibility of field
      kvend   = jvoff(jfield+1)-1  ! Ending Visibility of field
      write(chain,'(A,I0,A)') 'Processing field # ',ifield
      call map_message(seve%i,task,chain)
      nv = ivend-ivstart+1
      duv_in => duv(:,ivstart:ivend)
      duv_out => duv_next(:,kvstart:kvend)
      beamp(1) = bsize
      beamp(2) = doff(1,ifield)
      beamp(3) = doff(2,ifield)
      !
      !$OMP PARALLEL DEFAULT(NONE) &
      !$OMP SHARED(oic,olc,istep,nchan,nthread,fast, beamp) &
      !$OMP SHARED(nv,elapsed_s,elapsed_e,elapsed) &
      !$OMP SHARED(hdirty,huv,hcct,duv_next,duv,dcct) PRIVATE(ccou,lduv) &
      !$OMP PRIVATE(iv,ic,lc,ichan,icmax,mic,freq,ithread) &
      !$OMP SHARED(duv_in,duv_out,ifield) &
      !$OMP SHARED(hclean,do_clean)
      !
      !$ ithread = omp_get_thread_num()+1
      !$ elapsed_s = omp_get_wtime()
      !$OMP DO SCHEDULE(DYNAMIC)
      do ic=oic,olc,istep
        lc = min(ic+istep-1,nchan)
        ichan = lc-ic+1
        call uv_clean_sizes(hcct,hcct%r3d,mic,ic,lc)
        icmax = maxval(mic(1:ichan))
        !
        if (icmax.ne.0) then
          call uv_squeeze_clean(ichan,hcct%r3d,ccou, mic(1:ichan),ic,lc)
          freq = gdf_uv_frequency(huv,0.5d0*(ic+lc))
          if (.not.fast) then
            call uv_removes_clean(huv,duv_in,lduv,lc-ic+1,mic(1:ichan), &
              ccou,freq,ic,lc,beamp)
          else
            call uv_removef_clean(hdirty,duv_in,lduv,lc-ic+1,mic(1:ichan), &
              ccou,freq,ic,lc,beamp)
          endif
          !
          ! Plunge it in the output UV data
          do iv=1,nv
            duv_out(8+3*(ic-1):10+3*(lc-1),iv) = lduv(8:10+3*(lc-ic),iv)
          enddo
          !
          ! Compute the CLEAN image
          if (do_clean) then
            call generate_clean(hclean,oic,olc,ccou,mic)
          endif
        else
          do iv=1,nv
            duv_out(8+3*(ic-1):10+3*(lc-1),iv) = duv_in(8+3*(ic-1):10+3*(lc-1),iv) 
          enddo
        endif
        !
      enddo
      !$OMP END DO
      !$OMP END PARALLEL
      !
      ! Put trailing columns if any
      if (huv%gil%lcol.lt.huv%gil%dim(1)) then
        do iv=1,nv
          ! Already done !          duv_out(1:7,iv) = duv_in(1:7,iv)
          duv_out(huv%gil%lcol+1:huv%gil%dim(1),iv) = &
            & duv_in(huv%gil%lcol+1:huv%gil%dim(1),iv)  
        enddo
      endif
    enddo ! Loop on fields
    !$  call omp_set_num_threads(othread)
    !$  elapsed_e = omp_get_wtime()
    !$  elapsed = elapsed_e - elapsed_s
  else
    !
    ! Simple sequential stuff - parallelism is inside the
    !   uv_remove_...  subroutines to avoid memory issues
    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
    call uv_squeeze_clean(nchan,hcct%r3d,ccou, mic,ic,lc)
    freq = gdf_uv_frequency(huv,0.5d0*(ic+lc))
    !
    do jfield=1,nfields
      ifield = jfield
      if (selected_fieldsize.ne.0) ifield = selected_fields(jfield)
      ivstart = ivoff(ifield)      ! Starting Visibility of field
      ivend   = ivoff(ifield+1)-1  ! Ending Visibility of field
      kvstart = jvoff(jfield)      ! Starting Visibility of field
      kvend   = jvoff(jfield+1)-1  ! Ending Visibility of field
      write(chain,'(A,I0,A)') 'Processing field # ',ifield
      call map_message(seve%i,task,chain)
      nv = ivend-ivstart+1
      duv_in => duv(:,ivstart:ivend)
      duv_out => duv_next(:,kvstart:kvend)
      beamp(1) = bsize
      beamp(2) = doff(1,ifield)
      beamp(3) = doff(2,ifield)
      !
      if (.not.fast) then
        call uv_removes_clean(huv,duv_in,duv_out,lc-ic+1,mic, &
          & ccou,freq,ic,lc,beamp)
      else
        call uv_removef_clean(hdirty,duv_in,duv_out,lc-ic+1,mic, &
          & ccou,freq,ic,lc,beamp)
      endif
      !
      ! Add trailing data if any
      if (huv%gil%lcol.lt.huv%gil%dim(1)) then
        do iv=1,nv
          duv_out(huv%gil%lcol+1:huv%gil%dim(1),iv) = &
            & duv_in(huv%gil%lcol+1:huv%gil%dim(1),iv)  
        enddo
      endif
    enddo
    !
    ! Compute the CLEAN image
    if (do_clean) then
      call generate_clean(hclean,oic,olc,ccou,mic)
    endif
  endif
  !
  call gag_cpu(cpu1)
  if (elapsed.eq.0) then
    write(chain,102) 'Finished Residual CPU ',cpu1-cpu0
  else
    write(chain,102) 'Finished Residual Elapsed ',elapsed,'; CPU ',cpu1-cpu0
  endif
  call map_message(seve%i,task,chain)
  !
  if (allocated(lduv)) deallocate(lduv)
  if (allocated(ccou)) deallocate(ccou)
  !
102 format(a,f9.2,a,f9.2)
end subroutine sub_uv_residual
!
!
! The Whole "fast" way has been re-written in Block Mode like 
! the one_beam.f90 code,  in restore_many.f90.
!
! As written below here, it uses vast amounts of memory and
! induces paging for large number of channels, but is used as a 
! reference for development
!
subroutine uv_restore(line,error)
  use gkernel_interfaces
  use mapping_interfaces, except_this=>uv_restore
  use clean_def
  use clean_arrays
  use clean_types
  use clean_default
  use gbl_message
  !------------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING   Support for routine UV_RESTORE
  !     Restore a Clean map from a CLIC UV Table and a list of Clean
  !     Components, by Gridding and Fast Fourier Transform, using adequate
  !     scratch space for optimisation. Will work for
  !     up to 128x128x128 cube data size, may be more...
  !
  ! Input :
  !     a precessed UV table
  !     a list of Clean Components, in DCCT format
  !      i.e. (x,y,v)(iplane,icomponent)
  !     this organisation is not efficient, and one may need to switch to
  !           (x,y,v,)(icomponent,iplane)
  !     which is more easily transmitted
  ! Output :
  !     (optionally) 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-CLEAN cube
  !     a LMV-RES cube
  !
  ! To work, it would require
  !  1) to have the Pixel definition stored with the TCC Clean Component
  !     structure
  !  2) to re-use this pixel definition for the Images to be created
  !     Images may be different, but this would create some inconsistencies,
  !     which are perhaps not dramatic since the subtraction is in the UV
  !     plane.
  !
  ! Here, for the time being, I assume that the pixel of the TCC are
  ! the same as defined by the current imaging characteristics.
  !------------------------------------------------------------------------
  character(len=*), intent(inout) :: line
  logical, intent(out) :: error
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: f_to_k = 2.d0*pi/299792458.d-6
  character(len=*), parameter :: task='UV_RESTORE'
  !
  type (gildas) :: mybeam
  real, allocatable, target :: mybeamdata(:,:,:)
  real, allocatable :: w_mapu(:), w_mapv(:), w_grid(:,:)
  real(8) :: new(3), freq
  real(4) rmega,uvmax,uvmin
  integer wcol,mcol(2),nfft,sblock
  integer n,ier
  logical one, sorted, shift
  character(len=24) ra_c,dec_c
  character(len=message_length) :: chain
  character(len=12) save_method
  real cpu0, cpu1
  real uvma
  real, allocatable :: fft(:)
  real, allocatable :: ouv(:,:)
  type (cct_par), allocatable :: p_cct(:)
  real, pointer :: p_resid(:,:), p_clean(:,:)
  integer iplane, i, niter
  integer nx,ny,nu,nv,nc,nb
  !
  type(gildas) :: occt
  real, pointer :: ccou(:,:,:)
  integer mic, maxic
  logical comp,fast
  !
  ! Still to be done
  !1) What happens if no DIRTY image is there (only a CCT and UV ?)
  !   This can't be for now, as we cannot reload a CCT, but beware...
  !
  !
  if (method%method.ne.'CLARK' &
       & .and. method%method.ne.'HOGBOM' &
       & .and. method%method.ne.'SDI'    &
       & .and. method%method.ne.'MULTI'  &
       & .and. method%method.ne.'MX' ) then
    Call map_message(seve%e,task,'Unsupported Clean Method '//method%method)
    error = .true.
    return
  endif
  !
  call map_prepare(task,themap,error)
  if (error) return
  !
  one = .true.
  call sic_get_inte('WCOL',wcol,error)
  call sic_get_inte('MCOL[1]',mcol(1),error)
  call sic_get_inte('MCOL[2]',mcol(2),error)
  !
  call sic_get_logi('UV_SHIFT',shift,error)
  if (shift) then
    call sic_get_char('MAP_RA',ra_c,n,error)
    call sic_get_char('MAP_DEC',dec_c,n,error)
    call sic_get_dble('MAP_ANGLE',new(3),error)
  endif
  !
  ! First sort the input UV Table, leaving UV Table in UV_*
  if (shift) then
    call sic_decode(ra_c,new(1),24,error)
    if (error) then
      call map_message(seve%e,task,'Input conversion error on phase center')
      return
    endif
    call sic_decode(dec_c,new(2),360,error)
    if (error) then
      call map_message(seve%e,task,'Input conversion error on phase center')
      return
    endif
    new(3) = new(3)*pi/180.0d0
  endif
  call gag_cpu(cpu0)
  call uv_sort (error,sorted,shift,new,uvmax,uvmin)
  if (error) return
  call gag_cpu(cpu1)
  write(chain,102) 'Finished sorting ',cpu1-cpu0
  call map_message(seve%i,task,chain)
  !
  ! Set default according to DIRTY image
  if (themap%size(1).eq.0) themap%size(1) = hdirty%gil%dim(1)
  if (themap%size(2).eq.0) themap%size(2) = hdirty%gil%dim(2)
  if (themap%xycell(1).eq.0) themap%xycell(1) = abs(hdirty%gil%convert(3,1))*180*3600/pi
  if (themap%xycell(2).eq.0) themap%xycell(2) = abs(hdirty%gil%convert(3,2))*180*3600/pi
  !
  ! Fill other defaults
  call map_parameters(task,themap,freq,uvmax,uvmin,error) ! huv%gil%majo)
  if (error) return
  uvma = uvmax/(freq*f_to_k)
  !
  ! Check if any beam change
  ! CAUTION: this precludes re-using imported CCT, Beam and Dirty images
  !   to restore the Clean image later...
  ! If we want to instate this possibility, a warning should be given then.
  ! Also, the beam fit should be redone in this case.
  !
  if (map_version.lt.0) then
    if (do_weig) then
      call map_message(seve%e,task, &
            & 'Weighting scheme has changed, re-image and clean first')
      error = .true.
      return
    endif
  endif
  !
  ! Redefine some parameters
  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)
  !
  ! Now compare with "dirty" image
  if (nx.ne.hdirty%gil%dim(1).or.ny.ne.hdirty%gil%dim(2).or. &
     &  abs(themap%xycell(1)-abs(hdirty%gil%convert(3,1)))/themap%xycell(1).gt.1e-5 .or. &
     &  abs(themap%xycell(2)-abs(hdirty%gil%convert(3,2)))/themap%xycell(2).gt.1e-5) then
    call map_message(seve%e,task, &
        & 'Mismatch between Dirty image and Restored image')
    error = .true.
    return
  endif
  !
  nu = huv%gil%dim(1)
  nv = huv%gil%dim(2)
  nc = huv%gil%nchan !! (nu-7)/3
  !
  if (do_weig) then
    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
  endif
  !
  rmega = 8.0
  ier = sic_ramlog('SPACE_MAPPING',rmega)
  sblock = max(int(256.0*rmega*1024.0)/(nx*ny),1)
  !
  !
  ! New residual image
  hresid = hdirty
  !
  ! Subtract all Clean Components
  if (.not.associated(duv)) then
    call map_message(seve%e,task,'UV data DUV is not allocated')
    error = .true.
    return
  endif
  if (.not.allocated(dcct)) then
    call map_message(seve%e,task,'Clean component table DCCT is not allocated')
    error = .true.
    return
  endif
  !
  maxic = hcct%gil%dim(3)
  call sic_i4(line,0,1,maxic,.false.,error)
  if (error) return
  if (maxic.lt.0) maxic = hcct%gil%dim(3)
  maxic = min(hcct%gil%dim(3),maxic)
  !
  comp = .true.
  call sic_get_logi('COMPACT',comp,error)
  call gildas_null (occt)
  call gdf_copy_header(hcct,occt, error) ! Copy headers
  if (comp) then
    call uv_clean_size(hcct,dcct,mic)
    if (mic.eq.0) then
      call map_message(seve%w,task,'No valid Clean Component')
      error = .true.
      return
    endif
    mic = min(mic,maxic)
    occt%gil%dim(3) = mic
    allocate(ccou(occt%gil%dim(1),occt%gil%dim(2),occt%gil%dim(3)),stat=ier)
    if (ier.ne.0) call map_message(seve%i,task,'Component Allocation error')
    if (ier.ne.0) goto 98
    call uv_compact_clean(hcct,dcct,occt,ccou, mic)
    !!Print *,'MIC ',mic
    call gag_cpu(cpu1)
    write(chain,102) 'Finished compacting Clean ',cpu1-cpu0
    call map_message(seve%i,task,chain)
  else
    occt%gil%dim(3) = maxic
    ccou => dcct
  endif
  !
  !
  allocate (ouv(huv%gil%dim(1),huv%gil%dim(2)),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%i,task,'UV Allocation error')
    goto 98
  endif
  fast = .true.
  call sic_get_logi('FAST',fast,error)
  !
  ! Define observing frequency (in MHz)
  ier = gdf_range(mcol,huv%gil%nchan)
  freq = gdf_uv_frequency(huv,0.5d0*(mcol(1)+mcol(2)))
  if (fast) then
    Print *,'Fast subtract '
    call uv_subtfast_clean(huv,duv,ouv,occt,ccou,hdirty,freq,cpu0)
  else
    Print *,'Slow subtract '
    call uv_subtract_clean(huv,duv,ouv,occt,ccou,freq)
  endif
  call gag_cpu(cpu1)
  write(chain,102) 'Finished Subtract Clean ',cpu1-cpu0
  call map_message(seve%i,task,chain)
  !
  ! Prepare the Dirty(=Residual) image
  if (allocated(dclean)) deallocate(dclean)
  call sic_delvariable ('CLEAN',.false.,error)
  hclean%loca%size = 0
  !
  if (allocated(dresid)) deallocate(dresid)
  call sic_delvariable ('RESIDUAL',.false.,error)
  hresid%loca%size = 0
  ! Reset RESIDUAL and CLEAN, BUT NOT CCT
  !
  allocate(dresid(nx,ny,nc),stat=ier)
  if (ier.ne.0) then
     print *,'Error allocating DRESID ',ier
  endif
  dresid = 0
  call sic_mapgildas('RESIDUAL',hresid,error,dresid)
  hresid%r3d => dresid
  hresid%loca%size = nx*ny*nc
  !
  allocate(dclean(nx,ny,nc),stat=ier)
  if (ier.ne.0) then
     call map_message(seve%i,task,'Clean image Allocation error')
     goto 98
  endif
  call gag_cpu(cpu1)
  write(chain,102) 'Finished allocating Clean ',cpu1-cpu0
  call map_message(seve%i,task,chain)
  !
  ! Find out how many beams are required
  call map_beams(task,themap%beam,huv,nx,ny,nb,nc)
  !
  ! Process sorted UV Table according to the number of beams produced
  if (map_version.lt.0) then
    ! New Beam place
    call gildas_null (mybeam, type = 'IMAGE')
    call map_message(seve%i,task,'Producing a single beam for all channels')
    nfft = 2*max(nx,ny)
    allocate(w_mapu(nx),w_mapv(ny),w_grid(nx,ny),fft(nfft),mybeamdata(nx,ny,1),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%i,task,'Beam Allocation error')
      goto 98
    endif
    mybeam%r3d => mybeamdata
    mybeam%gil%ndim = 2
    mybeam%gil%dim(1:3)=(/nx,ny,1/)
    !
    call one_beam (task,themap,   &
       &    huv, mybeam, hresid,   &
       &    nx,ny,nu,nv,     ouv,   &
       &    w_mapu, w_mapv, w_grid, g_weight, g_v, do_weig,  &
       &    wcol,mcol,fft,   &
       &    sblock,cpu0,error,uvma)
  else
    !
    call gildas_null (mybeam, type = 'IMAGE')
    !
    mybeam%gil%ndim = 3
    allocate(mybeamdata(nx,ny,nc),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%i,task,'Beam Allocation error')
      goto 98
    endif
    mybeam%r3d => mybeamdata
    mybeam%gil%ndim = 3
    mybeam%gil%dim(1:3)=(/nx,ny,nc/)
    !
    call many_beams_para (task,themap,   &
       &    huv, mybeam, hresid,   &
       &    nx,ny,nu,nv,    ouv,   &
       &    g_weight, g_v, do_weig,  &
       &    wcol,mcol,sblock,cpu0,error,uvma,0)
  endif
  if (error) then
    call map_message(seve%e,task,'Could not image residual')
    return
  endif
  call gag_cpu(cpu1)
  write(chain,102) 'Finished imaging residuals ',cpu1-cpu0
  call map_message(seve%i,task,chain)
  !
  !call map_message(seve%i,task,'Successful completion')
  !
  call gdf_copy_header(hresid,hclean,error)
  hclean%r3d => dclean
  hclean%loca%size = nx*ny*nc
  call sic_mapgildas('CLEAN',hclean,error,dclean)
  !
  save_data(code_save_beam) = .true.
  save_data(code_save_dirty) = .true.
  !
  !
  ! The dirty is the residual. Create the Clean Map now
  allocate (p_cct(occt%gil%dim(3)),stat=ier)
  !
  save_method = method%method
  method%method = 'RESTORE' ! Generic
  niter = 0
  !
  nullify(p_clean)
  nullify(p_resid)
  !
  do iplane = method%first, method%last
    method%iplane = iplane
    p_resid =>  hresid%r3d(:,:,iplane)
    p_clean =>  hclean%r3d(:,:,iplane)
    !
    ! Recover the component list in pixels
    niter = occt%gil%dim(3)
    !!Print *,'Plane ',iplane,' cct size ',niter
    do i=1,occt%gil%dim(3)
      !!Print *,'component ',i,ccou(1:3,iplane,i)
      if (ccou(3,iplane,i).eq.0) then
        p_cct(i)%value = 0 ! Required
        niter = i-1
        exit
      else
        !
        ! The NINT is required because of rounding errors
        p_cct(i)%ix = nint( (ccou(1,iplane,i)-hdirty%gil%convert(2,1)) /  &
            &        hdirty%gil%convert(3,1) + hdirty%gil%convert(1,1))
        p_cct(i)%iy = nint( (ccou(2,iplane,i)-hdirty%gil%convert(2,2)) /  &
            &        hdirty%gil%convert(3,2) + hdirty%gil%convert(1,2))
        p_cct(i)%value = ccou(3,iplane,i)
        !!           if (p_cct(i)%ix.gt.nx .or. p_cct(i)%iy.gt.ny .OR. &
        !!               & p_cct(i)%ix.LT.1 .or. p_cct(i)%iy.LT.1) then
        !!              print *,'Out of bound at ',i,p_cct(i)%ix,p_cct(i)%iy,p_cct(i)%value
        !!           endif
      endif
    enddo
    ! Stupid test
    if (niter.gt.0) then
      !!Print *,'Restoring ',niter,' component '
      method%n_iter = niter
      call clean_make90(method,hclean,p_clean,p_cct)
      p_clean = p_clean+p_resid
    else
      p_clean = p_resid
    endif
  enddo
  method%method = save_method
  deallocate(p_cct)
  !
  ! 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
  !
  call gag_cpu(cpu1)
  write(chain,102) 'Finished restoring Clean ',cpu1-cpu0
  call map_message(seve%i,task,chain)
  !
  ! Stupid test also
  !
  IF (SIC_PRESENT(0,2)) DUV(:,:) = OUV(:,:)
  !! DUV = OUV ! This is to test what the residual look like...
  ! in production code, it should NOT be done, since a READ UV is
  ! then required to repeat the job. However, this can be used to
  ! "iterate" a previous clean...
  !
  if (allocated(mybeamdata)) deallocate(mybeamdata)
  deallocate(ouv)
  !
  if (associated(ccou,dcct)) then
    nullify(ccou)
  else if (associated(ccou)) then
    deallocate(ccou)
  endif
  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)
  save_data(code_save_clean) = .true.
  hresid%gil%extr_words = 0
  hclean%gil%extr_words = 0
  return
  !
98 call map_message(seve%e,task,'Memory allocation failure')
  error = .true.
  return
  !
102 format(a,f9.2)
end subroutine uv_restore
!
subroutine uv_subtract_clean(huv,duv,ouv,hcct,dcct,freq)
  use image_def
  use gbl_message
  !$ use omp_lib
  !-----------------------------------------------------------------
  ! @ private
  !
  ! MAPPING   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 CCT tables from MAPPING
  !-----------------------------------------------------------------
  type(gildas), intent(in) :: huv   ! header of UV data set
  type(gildas), intent(in) :: hcct  ! header of CCT data set
  real, intent(in) :: duv(huv%gil%dim(1),huv%gil%dim(2))
  real, intent(out) :: ouv(huv%gil%dim(1),huv%gil%dim(2))
  real, intent(in) :: dcct(hcct%gil%dim(1),hcct%gil%dim(2),hcct%gil%dim(3))
  real(8), intent(in) :: freq       ! Apparent observing frequency
  !
  real(8) :: pidsur            ! 2*pi*D/Lambda
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: f_to_k=2.d0*pi/299792458.d-6
  real(8) :: phase
  real(4) :: rvis, ivis
  integer ii, ir
  integer ic,iv,jc
  !
  integer :: nv    ! Number of visibilities
  integer :: mc    ! Number of Clean Components
  integer :: nc    ! Number of Channels
  real(8) :: elapsed_s, elapsed_e, elapsed
  character(80) :: chain
  !
  pidsur = f_to_k * freq
  !
  nv = huv%gil%dim(2)  ! Number of Visibilities
  nc = hcct%gil%dim(2) ! Number of channels
  mc = hcct%gil%dim(3) ! Number of Clean Components
  !
  ! Remove clean component from UV data set
!$OMP PARALLEL DEFAULT(SHARED) &
!$OMP    & PRIVATE(iv,jc,ic,ir,ii,phase,rvis,ivis) &
!$OMP    & PRIVATE(elapsed_s,elapsed_e,elapsed,chain)
!
!$ elapsed_s = omp_get_wtime()
!$OMP DO
  do iv=1,nv
    ouv(:,iv) = duv(:,iv)
    ir = 7+1
    ii = 7+2
    do jc = 1,nc
      do ic = 1,mc
        if (dcct(3,jc,ic).ne.0) then
          phase = (ouv(1,iv)*dcct(1,jc,ic) + ouv(2,iv)*dcct(2,jc,ic))*pidsur
          rvis = dcct(3,jc,ic)*cos(phase)
          ivis = dcct(3,jc,ic)*sin(phase)
          ouv(ir,iv) = ouv(ir,iv) - rvis   ! Subtract
          ouv(ii,iv) = ouv(ii,iv) - ivis
        else
          exit ! End of work, jump to next channel
        endif
      enddo
      ir = ir+3
      ii = ii+3
    enddo
  enddo
!$OMP END DO
  !$  elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(chain,'(a,f9.2,a)') ' Finished Subtract Clean ',elapsed
  call gag_message(seve%i,'SUBTRACT',chain)
!$OMP END PARALLEL
end subroutine uv_subtract_clean
!
subroutine uv_clean_size(hcct,ccin, mic)
  use image_def
  !-----------------------------------------------------------------
  ! @ private
  !
  ! MAPPING   Support for UV_RESTORE
  !   Compute the actual number of components
  !-----------------------------------------------------------------
  type(gildas), intent(in) :: hcct  ! header of CCT data set
  real, intent(in) :: ccin(hcct%gil%dim(1),hcct%gil%dim(2),hcct%gil%dim(3))
  integer, intent(out) :: mic
  integer :: nc
  integer :: ni, ki, mi
  integer :: i,ic
  !
  nc = hcct%gil%dim(2)
  ni = hcct%gil%dim(3)
  !
  mi = 0
  do ic=1,nc
    ki = 0
    do i=1,ni
      if (ccin(3,ic,i).eq.0) then
        ki = i-1
        exit
      endif
    enddo
    !!Print *,'Channel ',ic,ki
    if (ki.ne.0) then
      mi = max(mi,ki)
    endif
  enddo
  if (mi.eq.0) mi = ni
  mic = mi
  !!Print *,'MIC ',mic
end subroutine uv_clean_size
!
subroutine uv_compact_clean(hcct,ccin,occt,ccou, mic)
  use image_def
  !-----------------------------------------------------------------
  ! @ private
  !
  ! MAPPING   Support for UV_RESTORE
  !   Compact the component list by summing up all values at the
  !   same position
  !-----------------------------------------------------------------
  type(gildas), intent(in) :: hcct  ! header of CCT data set
  type(gildas), intent(in) :: occt  ! header of CCT data set
  real, intent(in) :: ccin(hcct%gil%dim(1),hcct%gil%dim(2),hcct%gil%dim(3))
  real, intent(out) :: ccou(occt%gil%dim(1),occt%gil%dim(2),occt%gil%dim(3))
  integer, intent(inout) :: mic
  !
  integer nc
  integer ni
  integer :: ii,jj,ic
  integer :: ki, mi ! Number of different components per channel
  logical doit
  !
  nc = hcct%gil%dim(2)
  ni = mic ! no longer !!! hcct%gil%dim(3)
  !
  mi = 0
  ccou = 0
  !
  do ic=1,nc
    ki = 0
    do ii=1,ni
      if (ccin(3,ic,ii).eq.0) then
        exit
      else
        doit = .true.
        do jj=1,ki
          if (ccou(1,ic,jj).eq.ccin(1,ic,ii)) then
            if (ccou(2,ic,jj).eq.ccin(2,ic,ii)) then
              doit = .false.
              !!Print *,'Component ',ii,' relocated at ',jj
              ccou(3,ic,jj) = ccou(3,ic,jj) + ccin(3,ic,ii)
              exit
            endif
          endif
        enddo
        if (doit) then
          ki = ki+1
          !!Print *,'Component ',ii,' new at ',ki
          ccou(1:3,ic,ki) = ccin(1:3,ic,ii)
        endif
      endif
    enddo
    if (ki.ne.0) mi = max(mi,ki)
  enddo
  !
  mic = mi
end subroutine uv_compact_clean
!
subroutine uv_subtfast_clean(huv,duv,ouv,hcct,dcct,hdirty,freq,cpu0)
  use image_def
  use gbl_message
  use mapping_interfaces, except_this=>uv_subtfast_clean
  !$ use omp_lib
  !-----------------------------------------------------------------
  ! @ private
  !
  ! MAPPING   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 CCT tables from MAPPING
  !-----------------------------------------------------------------
  type(gildas), intent(in) :: huv   ! header of UV data set
  type(gildas), intent(in) :: hcct  ! header of CCT data set
  type(gildas), intent(in) :: hdirty ! header of DIRTY data set
  real, intent(in) :: duv(huv%gil%dim(1),huv%gil%dim(2))
  real, intent(out) :: ouv(huv%gil%dim(1),huv%gil%dim(2))
  real, intent(in) :: dcct(hcct%gil%dim(1),hcct%gil%dim(2),hcct%gil%dim(3))
  real(8), intent(in) :: freq       ! Observing frequency in MHz
  real, intent(in) :: cpu0
  !
  integer :: nv    ! Number of visibilities
  integer :: mc    ! Number of Clean Components
  integer :: nc    ! Number of Channels
  integer :: mv    ! Size of a visibility
  integer :: nx,ny
  integer :: mx,my
  integer :: kx,ky
  real :: rx,ry
  real :: value
  complex, allocatable :: cfft(:,:,:)
  real, allocatable :: comp(:,:,:)
  integer iplane,ic,ix,iy,ier
  logical :: error
  real :: cpu1
  real(8) :: elapsed_s, elapsed_e, elapsed
  character(80) :: chain
  !
  !
  mv = huv%gil%dim(1)
  nv = huv%gil%dim(2)  ! Number of Visibilities
  nc = hcct%gil%dim(2) ! Number of channels
  mc = hcct%gil%dim(3) ! Number of Clean Components
  !
  ! Compute the Component Map (no residual)
  mx = hdirty%gil%dim(1)
  my = hdirty%gil%dim(2)
  allocate(comp(mx,my,nc),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%i,'SUBFAST','Component allocation error')
    error = .true.
    return
  endif
  comp = 0
!$OMP PARALLEL DEFAULT(SHARED) &
!$OMP    & PRIVATE(iplane,ic,ix,iy,value) &
!$OMP    & SHARED(elapsed_s,elapsed_e)
!
!$ elapsed_s = omp_get_wtime()
!
!$OMP DO
  do iplane=1,nc
    do ic=1,mc
      if (dcct(3,iplane,ic).eq.0) exit
      !
      ! The NINT is required because of rounding errors
      ix = nint( (dcct(1,iplane,ic)-hdirty%gil%convert(2,1)) /  &
           &        hdirty%gil%convert(3,1) + hdirty%gil%convert(1,1))
      iy = nint( (dcct(2,iplane,ic)-hdirty%gil%convert(2,2)) /  &
           &        hdirty%gil%convert(3,2) + hdirty%gil%convert(1,2))
      value = dcct(3,iplane,ic)
      comp(ix,iy,iplane) = comp(ix,iy,iplane) + value
    enddo
  enddo
!$OMP END DO
!$  elapsed_e = omp_get_wtime()
!$OMP END PARALLEL
  elapsed = elapsed_e - elapsed_s
  write(chain,'(a,f9.2,a)') 'Finished building Clean, Elapsed: ',elapsed
  call map_message(seve%i,'UV_RESTORE',chain)
  !
  ! 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%i,'SUBFAST','Fine Component allocation error')
    error = .true.
    return
  endif
!  call plunge_real (comp,mx,my,cfft,nx,ny,nc)
  !
  ! Compute the FFT
  call doallffts(mx,my,comp,nx,ny,nc,cfft,elapsed)
  call gag_cpu(cpu1)
  write(chain,'(a,f9.2,a,f9.2)') 'Finished FFTs CPU: ',cpu1-cpu0, &
    & ', Elapsed: ',elapsed
  call map_message(seve%i,'UV_RESTORE',chain)
  !
  ouv = duv
  call do_fmodel(ouv,mv,nv,cfft,nx,ny,nc, &
  & freq,hdirty%gil%convert(3,1),hdirty%gil%convert(3,2),1.0,elapsed)
  write(chain,'(a,f9.2,a)') 'Finished Model, Elapsed: ',elapsed
  call map_message(seve%i,'UV_RESTORE',chain)
  !
  deallocate(comp,cfft)
end subroutine uv_subtfast_clean
!
subroutine do_fmodel (visi,nc,nv,a,nx,ny,nf,   &
     &    freq,xinc,yinc,factor,elapsed)
  !$ use omp_lib
  !-----------------------------------------------------------------
  ! @ private
  !
  ! MAPPING   Support for UV_RESTORE
  !     Remove model visibilities from UV data set.
  !     "Fast" Model from an image: Use an intermediate FFT
  !-----------------------------------------------------------------
  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(nc,nv)  ! Computed visibilities
  real(8), intent(in) :: freq           ! Effective frequency
  real, intent(in)  :: factor         ! Flux factor
  complex, intent(in) ::  a(nx,ny,nf) ! FFT
  real(8), intent(in) :: xinc,yinc    ! Pixel sizes
  real(8), intent(out) :: elapsed
  !
  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
  logical inside
  real(8) :: elapsed_s, elapsed_e
  !
  lambda = clight/(freq*1d6)
  stepx = 1.d0/(nx*xinc)*lambda
  stepy = 1.d0/(ny*yinc)*lambda
  !
  ! Loop on visibility
  !$OMP PARALLEL DEFAULT(none) &
  !$OMP    & SHARED(nv,nx,ny,nf,stepx,stepy,factor) &
  !$OMP    & SHARED(visi,a) &
  !$OMP    & PRIVATE(i,kwx,kwy,ia,ja,if,inside,xr,yr,aplus,azero,amoin,afin) &
  !$OMP    & SHARED(elapsed_s,elapsed_e)
  !$ elapsed_s = omp_get_wtime()
  !
  !$OMP DO
  do i = 1, nv
    kwx =  visi(1,i) / stepx + dble(nx/2 + 1)
    kwy =  visi(2,i) / stepy + dble(ny/2 + 1)
    ia = int(kwx)
    ja = int(kwy)
    inside = (ia.gt.1 .and. ia.lt.nx) .and.   &
     &      (ja.gt.1 .and. ja.lt.ny)
    if (inside) then
      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
    !!else
    !!  print *,'Visi ',i,ia,nx,ja,ny,visi(1,i),visi(2,i)
    endif
  enddo
!$OMP END DO
!$  elapsed_e = omp_get_wtime()
!$OMP END PARALLEL
  elapsed = elapsed_e - elapsed_s
end subroutine do_fmodel
!
subroutine doallffts (mx,my,comp,nx,ny,nf,fft,elapsed)
  use gkernel_interfaces, only : fourt, fourt_plan
  use mapping_interfaces, only: plunge_real
  !$ use omp_lib
  !------------------------------------------------------
  ! @ private
  !
  ! MAPPING   Support for UV_RESTORE and others
  !   Could be optimized with Fourt_Plan and intermediate
  !   array
  !------------------------------------------------------
  integer, intent(in) :: mx
  integer, intent(in) :: my
  real, intent(in) :: comp(mx,my,nf)
  integer, intent(in) :: nx ! X size
  integer, intent(in) :: ny ! Y size
  integer, intent(in) :: nf ! Number of frequencies
  complex, intent(inout) :: fft(nx,ny,nf)
  real(8), intent(out) :: elapsed
  !
  integer :: if,dim(2),ndim,ier
  real :: work(2*max(nx,ny)) ! This will be on the stack
  complex, allocatable :: ftbeam(:,:)
  real(8) :: elapsed_s, elapsed_e
  !
  ! Loop on channels
  dim(1) = nx
  dim(2) = ny
  ndim = 2
  allocate(ftbeam(nx,ny),stat=ier)
  call fourt_plan(ftbeam,dim,ndim,1,1)
  !
  !$OMP PARALLEL DEFAULT(none) &
  !$OMP PRIVATE(if,ftbeam,work) &  ! loop & arrays
  !$OMP SHARED(comp,mx,my,fft,nx,ny,dim,nf) &
  !$OMP SHARED(elapsed_s,elapsed_e)
  !$ elapsed_s = omp_get_wtime()
  !$OMP DO
  do if = 1, nf
    call plunge_real (comp(:,:,if),mx,my,ftbeam,nx,ny)
    call fourt(ftbeam,dim,2,1,1,work)
    call recent(nx,ny,ftbeam)
    fft(:,:,if) = ftbeam
  enddo
  !$OMP ENDDO
  !$  elapsed_e = omp_get_wtime()
  !$OMP END PARALLEL
  elapsed = elapsed_e - elapsed_s
  !
end subroutine doallffts
!
subroutine recent(nx,ny,z)
  !------------------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING   Support for UV_RESTORE and others
  !   Recenters the Fourier Transform, for easier display. The present version
  !   will only work for even dimensions.
  !------------------------------------------------------------------------------
  integer, intent(in) :: nx
  integer, intent(in) :: ny
  complex, intent(inout) :: z(nx,ny)
  !
  complex :: tmp
  integer :: i, j
  !
  do j=1,ny/2
    do i=1,nx/2
      tmp = z(i+nx/2,j+ny/2)
      z(i+nx/2,j+ny/2) = z(i,j)
      z(i,j) = tmp
    enddo
  enddo
  !
  do j=1,ny/2
    do i=1,nx/2
      tmp = z(i,j+ny/2)
      z(i,j+ny/2) = z(i+nx/2,j)
      z(i+nx/2,j) = tmp
    enddo
  enddo
  !
  do j=1,ny
    do i=1,nx
      if (mod(i+j,2).ne.0) then
        z(i,j) = -z(i,j)
      endif
    enddo
  enddo
end subroutine recent
!
subroutine plunge_real (r,nx,ny,c,mx,my)
  !------------------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING   Support for UV_RESTORE and others
  !     Plunge a Real array into a Complex array
  !-----------------------------------------------------------------
  integer, intent(in)  :: nx,ny              ! Size of input array
  real, intent(in)     :: r(nx,ny)           ! Input real array
  integer, intent(in)  :: mx,my              ! Size of output array
  complex, intent(out) :: c(mx,my)           ! Output complex array
  !
  integer kx,ky,lx,ly
  integer i,j
  !
  kx = nx/2+1
  lx = mx/2+1
  ky = ny/2+1
  ly = my/2+1
  !
  c = 0.0
  do j=1,ny
    do i=1,nx
      c(i-kx+lx,j-ky+ly) = cmplx(r(i,j),0.0)
    enddo
  enddo
end subroutine plunge_real
!
subroutine generate_clean(hmap,first,last,ccou,mic)
  use clean_arrays
  use mapping_interfaces, except_this => generate_clean
  !
  ! @ private-mandatory
  !
  type(gildas), intent(inout) :: hmap
  integer, intent(in) :: first
  integer, intent(in) :: last
  real, intent(in) :: ccou(:,:,:)  !  (x,y,Value),Component,Plane
  integer, intent(in) :: mic(:)    ! Niter per plane
  !
  type (cct_par), allocatable :: p_cct(:)
  real, pointer :: p_clean(:,:)
  integer :: iplane, jplane, niter, miter, i, ier
  logical :: error
  !
  miter = maxval(mic)
  allocate (p_cct(miter),stat=ier)
  !
  do iplane = first, last
    method%iplane = iplane
    p_clean =>  hmap%r3d(:,:,iplane)
    !
    ! Recover the component list in pixels
    jplane = iplane-first+1
    niter = mic(jplane) 
    do i=1,niter
      if (ccou(3,i,jplane).eq.0) then
        p_cct(i)%value = 0 ! Required
        niter = i-1
        exit
      else
        !
        ! The NINT is required because of rounding errors
        p_cct(i)%ix = nint( (ccou(1,i,jplane)-hmap%gil%convert(2,1)) /  &
            &        hmap%gil%convert(3,1) + hmap%gil%convert(1,1))
        p_cct(i)%iy = nint( (ccou(2,i,jplane)-hmap%gil%convert(2,2)) /  &
            &        hmap%gil%convert(3,2) + hmap%gil%convert(1,2))
        p_cct(i)%value = ccou(3,i,jplane)
      endif
    enddo
    ! Stupid test
    if (niter.gt.0) then
      method%n_iter = niter
      call clean_make90(method,hmap,p_clean,p_cct)
    else
      p_clean = 0
    endif
  enddo
  deallocate(p_cct)
  hmap%file = 'toto.lmv-clean'
  call gdf_write_image(hmap,hmap%r3d,error)
end subroutine generate_clean
