subroutine get_cols(nchan,ucol,fcol,lcol,wcol)
  ! @ private
  integer, intent(in) :: ucol(2)
  integer, intent(inout) :: nchan
  integer, intent(out) :: fcol
  integer, intent(out) :: lcol
  integer, intent(out) :: wcol
  !
  integer :: mcol(2)
  !
  mcol = ucol
  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
end subroutine get_cols
!
subroutine uv_residual_clean(line,task,iarg,error)
  use gkernel_interfaces
  use imager_interfaces, except_this=>uv_residual_clean
  use clean_def
  use clean_arrays
  use clean_types
  use clean_default
  use gbl_message
  !------------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER   Support for routine UV_RESIDUAL [FIELDS List]
  !     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
  character(len=*), intent(in) :: task
  integer, intent(in) :: iarg
  logical, intent(out) :: error
  !
  integer, parameter :: o_field=1
  character(len=*), parameter :: rname='UV_RESIDUAL'
  !
  real, pointer :: duv_previous(:,:), duv_next(:,:)
  logical :: do_clean  
  !
  error = .false.
  if (themap%nfields.ne.0) then
    call map_message(seve%w,rname,'UV data is a Mosaic - UNDER TESTS !!!')
    call uv_shift_mosaic(line,rname,error)
    if (error) return
  endif
  !
  call map_message(seve%i,rname,'Subtracting CLEAN components')
  nullify(duv_previous,duv_next)
  call sic_delvariable('UV_RESIDUAL',.false.,error)
  !
  ! Do the job. 
  uv_resid_updated = .true.
  ! do_clean = .false.  means do not re-image with Clean components added, 
  ! and thus, do not store in duv_next, but rather in DUVF 
  ! ("Fit" or "Residual" buffer)
  do_clean = .false. 
  if (.not.do_clean) duv_previous => duv   ! Start from current UV buffer
  call sub_uv_residual(task,line,iarg,duv_previous,duv_next,do_clean,error)
  if (error) return
  !
  call sic_mapgildas('UV_RESIDUAL',huvf,error,duvf)
  !  
end subroutine uv_residual_clean
!
subroutine sub_uv_residual(task,line,iarg,duv_previous,duv_next,do_clean,error)
  use gkernel_interfaces
  use imager_interfaces, except_this=>sub_uv_residual
  use clean_def
  use clean_arrays
  use clean_types
  use clean_default
  use clean_beams
  use gbl_message
  !$ use omp_lib
  !------------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER   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            ! Calling Command
  character(len=*), intent(inout) :: line         ! Command line
  integer, intent(in) :: iarg                     ! First useful argument
  real, pointer, intent(inout) :: duv_previous(:,:) ! Input buffer
  real, pointer, intent(inout) :: duv_next(:,:)   ! May not be defined here
  logical, intent(in) :: do_clean                 ! Re-image ?
  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_field=1
  ! Minimum number of Visibilities to activate the FFT mode
  integer, parameter :: fft_mode=20000 
  !
  real(8) :: freq
  character(len=message_length) :: chain
  real :: cpu0, cpu1
  integer :: ier,nu,nv,mv,nchan,nx,ny
  !
  real, pointer :: duv_in(:,:), duv_out(:,:)
  real, allocatable, target :: ccou(:,:,:)
  real, pointer  :: fcou(:,:,:)
  integer, allocatable :: omic(:), nmic(:)
  integer :: maxic, ic,lc, icmax, oic, olc, iv
  integer :: nthread, ithread, np
  logical :: fft, debug
  real(8) :: elapsed_s, elapsed_e, elapsed
  !
  ! For mosaics
  type(clean_par) :: my_method
  type(projection_t) :: proj
  real(8) :: pos(2)
  real(8), parameter :: sec_to_rad=pi/3600.d0/180d0
  real(4) :: 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 :: ivstart, ivend, kvstart, kvend, it
  logical :: sorted, shift
  real(8) :: new(3)
  real(4) :: uvmin, uvmax
  logical :: omp_nested
  integer :: max_inner, nouter
  !
  integer :: fcol, lcol, wcol
  !
  call map_message(seve%d,task,'Calling SUB_UV_RESIDUAL',3)
  !
  ! 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
  !
  if (allocated(doff)) then
    Print *,'DOFF is still allocated '
    deallocate(doff)
  endif
  if (allocated(ivoff)) then
    Print *,'IVOFF is still allocated '
    deallocate(ivoff)
  endif
  !
  ! Basic initializations
  nu = huv%gil%dim(1)
  nv = huv%gil%nvisi    ! not %dim(2)
  nchan = huv%gil%nchan ! Default value 
  !
  ! That only works for UV_RESTORE, not for UV_RESIDUAL
  call get_cols(nchan,saved_mcol,fcol,lcol,wcol)
  Print *,'Done GET_COLS ',fcol,lcol, ' NCHAN ',nchan
  !
  ithread = 1
  nthread = 1
  elapsed_e = 0.
  elapsed_s = 0.
  elapsed = 0.
  debug = .false.
  call sic_get_logi('DEBUG',debug,error)
  error = .false.
  !
  ! Verify number of channels match
  if (hcct%gil%dim(2).ne.huv%gil%nchan) then
    if (hcct%gil%dim(2).eq.1) then
      call map_message(seve%w,task,'Subtracting a Continuum CCT from a Line data set')
    else
      write(chain,'(A,I0,A,I0,A)') 'Number of channels in CCT [', &
      & hcct%gil%dim(2),'] and in UV [',huv%gil%nchan,'] do not match'
      Print *,'SAVED_MCOL ',saved_mcol
      call map_message(seve%w,task,chain)
!      error = .true.
!      return
    endif
  endif  
  !
  maxic = hcct%gil%dim(3)
  if (iarg.gt.0) then
    call sic_i4(line,0,iarg,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...
  endif
  !
  allocate (omic(nchan),nmic(nchan),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,task,'Memory allocation error')
    error = .true.
    return
  endif
  !
  ! Compact the Clean components first
  ic = fcol
  lc = lcol
  hcct%r3d => dcct
  call uv_clean_sizes(hcct,hcct%r3d,omic,ic-fcol+1,lc-fcol+1)
  icmax = maxval(omic)
  if (debug) Print *,'Max number of clean components ',icmax
  !
  ! Nothing to do if no Clean component
  if (icmax.eq.0) then
    call map_message(seve%w,task,'No valid Clean Component')
    return
  endif  
  !
  call gag_cpu(cpu0)
  !
  if ((themap%nfields.ne.0).and.(abs(themap%nfields).ne.1)) then
    !
    ! True Mosaic case
    nfields = abs(themap%nfields)
    allocate(doff(2,nfields),ivoff(nfields+1),jvoff(nfields+1),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,task,'Memory allocation error')
      error = .true.
      return
    endif
    shift = .false.
    sorted = .false.
    error = .false.
    if (debug) Print *,'Sorting Mosaic ',themap%nfields, &
      & huv%gil%column_pointer(code_uvt_xoff), &
      & huv%gil%column_pointer(code_uvt_yoff), &
      & nfields
    !
    new = 0.D0 ! No change of Phase center
    !
    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
    if (debug) Print *,'Nfields ',nfields
    !
    ! Shift offset coordinates to Phase center 
    call gwcs_projec(huv%gil%a0,huv%gil%d0,huv%gil%pang,huv%gil%ptyp,proj,error)
    if (debug) Print *,'Posangle ',huv%gil%pang
    ! POS is here the Offset of the Pointing center relative to the Phase center
    call abs_to_rel (proj,huv%gil%ra,huv%gil%dec,pos(1),pos(2),1)
    if (debug) Print *,'POS ',pos
    do ifield=1,nfields
      doff(:,ifield) = doff(:,ifield)+pos
      if (debug) Print *,doff(1,ifield)/sec_to_rad, doff(2,ifield)/sec_to_rad
    enddo
    !
    ! Get primary beam size
    bsize = 0
    !!Print *,'SUB_UVRESIDUAL get_bsize ',bsize
    call get_bsize(huv,task,' ',bsize,error)
    if (debug) Print *,'Primary beam size ',bsize/sec_to_rad,' " '
    !
    ! For tests per field - not useable in production
    if (task.eq.'UV_RESIDUAL'.and.sic_present(o_field,0)) then
      call select_fields(task,line,o_field,nfields,np,selected_fields,error)
      if (error) return
      selected_fieldsize = np
    endif
    !
    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
      if (debug) Print *,'Selected Fields ',selected_fields(1:selected_fieldsize) !!
      nv = 1
      mv = 0
      do jfield=1,selected_fieldsize
        ifield = selected_fields(jfield)
        jvoff(jfield) = nv
        mv = max(ivoff(ifield+1)-ivoff(ifield),mv)
        nv = nv + ivoff(ifield+1)-ivoff(ifield)
        jvoff(jfield+1) = nv
      enddo
      nv = nv-1
      nfields = selected_fieldsize
    else
      jvoff(:) = ivoff
      mv = 0
      do ifield=1,nfields
        mv = max(ivoff(ifield+1)-ivoff(ifield),mv)
      enddo
    endif
  else
    nfields = 1
    mv = nv
    allocate(doff(2,1),ivoff(2),jvoff(2),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,task,'Memory allocation error')
      error = .true.
      return
    endif
    doff = 0.0
    bsize = 0.
    ivoff(1) = 1
    ivoff(2) = nv+1
    jvoff(:) = ivoff
    !
    if (debug) Print *,'Single Field case'
  endif 
  !
  ! Select the FFT or DIRECT mode by default, according to the
  ! problem size. This may need to be tested in more details
  if (mv.lt.fft_mode) then
    fft = .false.
  else
    fft = .true.
  endif
  if (debug) Print *,'Default FFT ',fft, mv
  call sic_get_logi('FAST',fft,error)
  if (debug) Print *,'User set FFT ',fft, error
  error = .false.
  !
  ! Prepare appropriate array...
  if (do_clean) then 
    ! Allocate work arrays
    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
  else
    ! Assume DUV_PREVIOUS has been already set by caller
    ! Set DUV_NEXT to point to DUVF
    call gdf_copy_header(huv,huvf,error)
    huvf%gil%dim(2) = nu
    huvf%gil%dim(2) = nv
    huvf%gil%nvisi = nv
    !
    if (allocated(duvf)) deallocate(duvf) !NEW!
    allocate(duvf(nu,nv),stat=ier)   !NEW!
    if (ier.ne.0) then
      call map_message(seve%e,task,'MODEL Memory allocation failure')
      error = .true.
      return
    endif
    duv_next => duvf
  endif
  if (debug) Print *,'Found buffers',nu,nv
  !
  ! Redo that by block - At this stage NFIELDS is the actual number of selected fields.
  !
  oic = ic    ! This must be FCOL
  olc = lc    ! This must be LCOL
  Print *,'IC ',ic,' LC ',lc
  !
  ! Spatially compress the Clean Component List
  allocate(ccou(3,icmax,nchan),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,task,'Memory allocation error')
    error = .true.
    return
  endif
  if (debug) Print *,'uv_squeeze_clean ',nchan,omic,ic,lc
  call uv_squeeze_clean(nchan,hcct%r3d,ccou, omic,ic,lc)
  if (debug) Print *,'Done uv_squeeze_clean' 
  ! 
  ! Remember the Full Clean Component List size
  nmic(:) = omic
  !
  if (bsize.ne.0) then
    maxic = maxval(omic)
    write(chain,'(A,I0,A,I0,A)') 'Compressing CCT from ',icmax,' to ',maxic,' components'
    call map_message(seve%i,task,chain)
    allocate(fcou(3,maxic,nchan),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,task,'Memory allocation error')
      error = .true.
      return
    endif
  else
    fcou => ccou
  endif
  freq = gdf_uv_frequency(huv,0.5d0*(ic+lc))
  !
  if (debug) Print *,'LCOL ',huv%gil%lcol,' and DIM ',huv%gil%dim(1)
  !
  ! Simple sequential stuff - parallelism is inside the
  !   uv_remove_...  subroutines to avoid memory issues
  ! Unfortunately, this parallelism is only efficient if
  ! the number of visibilities is sufficient.
  !
  ! So a mode with per-field parallelism would be good.
  ! But one has to be careful about IC and LC
  !
  if (debug) Print *,'IC LC ',ic,lc,' OIC OLC ',oic,olc
  !
  !$ nouter = 1   ! Should be nfields if Outer parallel mode is activated
  !$ max_inner = omp_get_max_threads()
  !$ call ompset_thread_nesting(task, nouter, max_inner, omp_nested)
  !
  do jfield=1,nfields
    if (sic_ctrlc()) then
      call map_message(seve%w,task,'Aborted by user ^C')
      error = .true.
      return
    endif
    !
    ifield = jfield
    if (selected_fieldsize.ne.0) ifield = selected_fields(jfield)
    if (debug) Print *,'Field ',ifield,jfield
    !
    ! This looks tricky, but is working.
    ! It used to extract an arbitrary subset of all fields
    ! In input Ifield
    ivstart = ivoff(ifield)      ! Starting Visibility of field
    ivend   = ivoff(ifield+1)-1  ! Ending Visibility of field
    ! In output Jfield
    kvstart = jvoff(jfield)      ! Starting Visibility of field
    kvend   = jvoff(jfield+1)-1  ! Ending Visibility of field
    if (nfields.gt.1) then
      write(chain,'(A,I0,4(1X,I0),2F10.2)') 'Processing field # ',ifield, &
        & ivstart,ivend, kvstart, kvend, doff(1,ifield)/sec_to_rad, doff(2,ifield)/sec_to_rad
      call map_message(seve%i,task,chain)
    endif
    !
    nv = ivend-ivstart+1
    if (ivend.gt.ubound(duv,2)) then
      Print *,'Programming error IVEND',kvend,' > Bound ',ubound(duv,2)
    endif
    duv_in => duv_previous(:,ivstart:ivend) ! We now start from DUV_PREVIOUS
    if (kvend.gt.ubound(duv_next,2)) then   
      Print *,'Programming error KVEND',kvend,' > Bound ',ubound(duv_next,2)
    endif
    duv_out => duv_next(:,kvstart:kvend)    ! We put in DUV_NEXT
    !
    if (bsize.ne.0) then
      omic(:) = nmic(:)   ! Restart from un-attenuate Clean Component List size
      call attenuate_clean(nchan,ccou,doff(:,ifield),bsize,fcou,omic)
      if (debug) then
        do it=1,min(10,omic(1))
          Print *,it,ccou(1:3,it,1),fcou(1:3,it,1),omic(1),nmic(1)
        enddo
      endif
    endif
    !
    if (.not.fft) then
      if (debug) Print *,'Slow case IC ',ic,' LC ',lc,' OMIC ',omic
      call uv_removes_clean(nv,duv_in,duv_out,lc-ic+1,omic, &
        & fcou,freq,ic,lc)
      if (debug) Print *,'Done Slow ',ifield  
    else
      if (debug) Print *,'Fast case '
      call uv_removef_clean(hcct,duv_in,duv_out,lc-ic+1,omic, &
        & fcou,freq,ic,lc)
      if (debug) Print *,'Done Fast ',ifield  
    endif
    !
    ! Add leading and trailing data if any
    if (debug) Print *,'NV ',nv,' Bounds ',ubound(duv_in,2),ubound(duv_out,2)
    if (huv%gil%lcol.lt.huv%gil%dim(1)) then
      do iv=1,nv
        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
    else
      if (debug) Print *,'WARNING no trailing column'
      do iv=1,nv
        duv_out(1:7,iv) = duv_in(1:7,iv)
      enddo
    endif
  enddo
  !
  ! Compute the CLEAN image
  if (do_clean) then
    call copy_method(method,my_method)
    my_method%method = 'UV_RESTORE'
    my_method%bshift = 0      ! This looks uninitialized
    if (debug) Print *,'Calling GENERATE_CLEAN ',my_method%method,my_method%bshift
    ! Use the Full Clean Component list size
    ! We need a Clean Beam size    
    !
    if (hsky%gil%majo.eq.0) then
      if (beam_defined) then
        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...
      else
        my_method%major = 0
        my_method%minor = 0
        my_method%angle = 0
        nx = hbeam%gil%dim(1)
        ny = hbeam%gil%dim(2)
        call fibeam (task,dbeam,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)
!!        Print *,'Using Clean beam ',beam_fitted(1),' x ',beam_fitted(2),' at PA ',beam_fitted(3)
      endif
      !
      hsky%gil%majo = my_method%major
      hsky%gil%mino = my_method%minor
      hsky%gil%posa = my_method%angle*pi/180.
      hsky%gil%reso_words = 3
    else
      Print *,'Resolution was already defined ',hsky%gil%majo*180*3600/pi
    endif
    !
    call generate_clean(my_method,hsky,ic,lc,ccou,nmic)
  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 (associated(fcou)) then
    if (.not.associated(fcou,ccou)) deallocate(fcou)
  endif
  if (allocated(ccou)) deallocate(ccou)
  !
  call map_message(seve%d,task,'Finished SUB_UV_RESIDUAL',3)
  !
102 format(a,f9.2,a,f9.2)
end subroutine sub_uv_residual
!
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 generate_clean(amethod,hmap,first,last,ccou,mic)
  !$ use omp_lib
  use clean_def
  use image_def
  use imager_interfaces, only : clean_make90
  !
  ! @ private-mandatory
  !
  type(clean_par), intent(in) :: amethod
  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(:)
  type (clean_par) :: my_method 
  integer :: iplane, jplane, niter, miter, i, ier, nthread
  !
  miter = max(1,maxval(mic))
  allocate (p_cct(miter),stat=ier)
  !$ nthread = omp_get_max_threads()
  !  !$ Print *,'OMP Already parallel ',omp_in_parallel(),' Nesting ',omp_get_nested(),
  !$ nthread = min(nthread,last-first+1)
  !$OMP PARALLEL DEFAULT(NONE) NUM_THREADS(nthread) &
  !$OMP & SHARED(amethod, first, last, hmap, mic, ccou, nthread) &
  !$OMP & PRIVATE(my_method, iplane, jplane, p_cct, niter, i) 
  !
  !$OMP DO
  do iplane = first, last
    my_method = amethod
    !
    my_method%iplane = 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
      my_method%n_iter = niter
      call clean_make90(my_method,hmap, hmap%r3d(:,:,iplane),p_cct)
    else
      hmap%r3d(:,:,iplane) = 0
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  !
  deallocate(p_cct)
end subroutine generate_clean
!
subroutine attenuate_clean(nchan,ccou,doff,bsize,fcou,mic)
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !
  ! IMAGER
  !   Apply primary beam attenuation to Clean Components
  ! at specified offset
  !   Input   CCOU(3,Nclean,Nchan)
  !   Output  FCOU(3,Ncomp,Nchan)
  ! Ncomp is lower than Nclean: Clean components at same position
  !   have been averaged first
  ! MIC(nchan) contains the number of effective Clean Components
  ! for this channel (after attenuation).
  !---------------------------------------------------------------------
  integer, intent(in) :: nchan      ! Number of channels
  real, intent(in) :: ccou(:,:,:)   ! Shape (3,Ncomp,Nplane)
  real, intent(out) :: fcou(:,:,:)  ! Same shape, but different sizes 
  real, intent(in) :: doff(2)       ! Offset value
  real, intent(in) :: bsize         ! Beam size
  integer, intent(inout) :: mic(nchan)  ! Effective number of Clean components
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: sec_to_rad=pi/3600.d0/180d0
  real :: beam_e, b2, fact
  integer :: ic,jc,kc
  !
  !!Print *,'Into ATTENUATE ',maxval(mic)
  !!Print *,'CCOU shape ',ubound(ccou)
  !!Print *,'FCOU shape ',ubound(fcou)
  !!Print *,'Doff ',doff(1)/sec_to_rad,doff(2)/sec_to_rad
  beam_e = bsize/(2.*sqrt(log(2.0)))
  b2 = (1.0/beam_e)**2
  !
  do ic=1,nchan
    kc = 0
    do jc=1,mic(ic)
      fact = ((ccou(1,jc,ic)-doff(1))**2+(ccou(2,jc,ic)-doff(2))**2)*b2
      if (fact.lt.32) then
        kc = kc+1
        fcou(3,kc,ic) = ccou(3,jc,ic)*exp(-fact)
        fcou(1:2,kc,ic) = ccou(1:2,jc,ic)
      endif
    enddo
    mic(ic) = kc
  enddo
  !
end subroutine attenuate_clean
