!
! The Whole "fast" way has been re-written in Block Mode like 
! the one_beam.f90 code,  in command-uv-map.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 mapping_default_types
  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
