subroutine get_cols(nchan,ucol,fcol,lcol,wcol)
  !------------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Utility routine  
  !     Define Channel range and Weight channel
  !!
  !------------------------------------------------------------------------
  integer, intent(in) :: ucol(2)        !! User input channel range
  integer, intent(inout) :: nchan       !! Number of channels
  integer, intent(out) :: fcol          !! First channel
  integer, intent(out) :: lcol          !! Last channel
  integer, intent(out) :: wcol          !! Default weight channel
  !
  ! Local ---
  integer :: mcol(2)
  !
  ! Code ----
  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 sub_uv_residual(comm,line,iarg,duv_a,duv_b, &
  & do_clean,do_resi,subtract,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 & MODEL
  !
  !   Remove all Clean Components from a UV Table  
  !   [CLEAN\]UV_RESIDUAL CLEAN [Niter] [/FIELDS List]   
  !   -- or --
  !   [CALIBRATE\]MODEL [Niter] [/MINVAL Value]
  ! 
  ! 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) :: comm              !! Calling Command
  character(len=*), intent(inout) :: line           !! Command line
  integer, intent(in) :: iarg                       !! First useful argument
  real, intent(in) , target :: duv_a(:,:)           !! Input buffer
  real, intent(inout), target :: duv_b(:,:)         !! May not be defined here
  logical, intent(in) :: do_clean                   !! Re-image ?
  logical, intent(in) :: do_resi                    !! Evaluate UV residual ?
  logical, intent(in) :: subtract                   !! Subtract model ?
  logical, intent(out) :: error                     !! Error flag
  !
  ! Constants
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: sec_to_rad=pi/3600.d0/180d0
  real(8), parameter :: f_to_k = 2.d0*pi/299792458.d-6
  integer, parameter :: o_field=1
  integer, parameter :: o_minval=1
  ! Minimum number of Visibilities to activate the FFT mode
  integer, parameter :: fft_mode=20000 
  !
  ! Local ---
  character(len=24) :: task
  real(8) :: freq
  character(len=message_length) :: chain
  real :: cpu0, cpu1
  integer :: ier,nu,nv,mv,nchan
  !
  real, pointer :: duv_in(:,:), duv_out(:,:)
  real, allocatable, target :: ccou(:,:,:)
  real, pointer :: fcou(:,:,:)
  real, pointer :: fctmp(:,:,:)
  real, allocatable :: duv_tmp(:,:)
  real, allocatable :: dmap(:,:,:)          ! Storage for GAUSS method in Mosaics.
  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
  logical :: do_mosaic
  type(clean_par) :: my_method
  type(projection_t) :: proj
  real(8) :: pos(2)
  real(4) :: bsize(10), beamsize, save_major
  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, ibeam
  logical :: sorted, shift
  real(8) :: new(3)
  real(4) :: uvmin, uvmax
  logical :: omp_nested
  integer :: outer_threads, inner_threads, jc, kc, j3, j4
  !
  integer :: fcol, lcol, wcol, cctsize
  integer :: chunk, mx, my
  integer :: itrail
  real :: bstep ! Words per image pixel
  logical :: compact ! Test logical for code development
  integer, allocatable :: teles(:)
  !
  ! Code ---
  !
  ! Change Message header 
  if (comm.eq.'MOSAIC_RESTORE') then
    task = 'MOSAIC_RESIDUAL'
  else
    task = comm
  endif
  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_chan%bounds,fcol,lcol,wcol)
  !TEST!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'
      if (debug) Print *,'SAVED_MCOL ',saved_chan%bounds 
      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)
  do_mosaic = (themap%nfields.ne.0).and.(abs(themap%nfields).ne.1)
  !
  bsize = 0.
  if (do_mosaic) then
    !
    ! Get primary beam size
    !!Print *,'SUB_UVRESIDUAL get_bsize ',bsize
    call get_bsize(huv,task,' ',bsize,error)
    if (debug) Print *,'Primary beam size ',bsize/sec_to_rad,' " '
    !
  endif
  !
  if (do_resi) then
    if (do_mosaic) then
      !
      ! True Mosaic case
      nfields = abs(themap%nfields)
      allocate(doff(2,nfields),ivoff(nfields+1),jvoff(nfields+1), &
      &	teles(nfields),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), &
        & huv%gil%column_pointer(code_uvt_id), &
        & nfields,doff,ivoff)
      if (error) return
      teles(1:nfields) = huv%mos%fields(:)%jteles
      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
      !
      ! 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.
      !
      ! Define the Chunk size
    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.
  endif ! DO_RESI
  beamsize = maxval(bsize)
  !
  ! 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
  if (debug) Print *,'IC ',ic,' LC ',lc
  !
  ! Spatially compress the Clean Component List
  cctsize = hcct%gil%dim(1)
  if ((cctsize.eq.4).and.(nfields.gt.1)) fft = .true.    ! For mosaics only
  !
  allocate(ccou(cctsize,icmax,nchan),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,task,'CCOU Memory allocation error')
    error = .true.
    return
  endif
  if (debug) Print *,'uv_squeeze_clean ',nchan,omic,ic,lc, ' FCOL ',fcol
  call uv_squeeze_clean(nchan,hcct%r3d, ccou, omic,ic-fcol+1,lc-fcol+1)
  if (debug) Print *,'Done uv_squeeze_clean' 
  ! 
  ! Remember the Full Clean Component List size
  nmic(:) = omic
  !
  if ((beamsize.ne.0).and.(cctsize.ne.4)) 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(cctsize,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))
  !
  itrail = -huv%gil%lcol + huv%gil%dim(1) 
  !
  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
  !
  !
  if (do_resi) then
    bstep = 0.1            ! Small memory imprint
    if (fft) bstep = 2     ! 1 complex word
    mx = (hcct%gil%convert(1,1)-1)*2   ! Reference pixel is at Mx/2+1
    my = (hcct%gil%convert(1,3)-1)*2
    call uv_get_block(fft,mx,my,huv%gil%nchan,1,bstep,chunk)
    !
    if ((cctsize.eq.4).and.(nfields.gt.1)) then
      allocate(dmap(mx,my,nchan),stat=ier)
      if (ier.ne.0) then
        call map_message(seve%e,task,'DMAP Memory allocation error')
        error = .true.
        return
      endif
    endif
    !
    omp_nested = .true.
    !$ inner_threads = omp_get_max_threads()
    !$ outer_threads = 1 ! Should be nfields if Outer parallel mode is activated
    !$ call ompset_thread_nesting(task, outer_threads, inner_threads, 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
      !OLD!      duv_in => duv_a(:,ivstart:ivend) ! We now start from DUV_PREVIOUS
      !TEST!Print *,'Size DUV_PREVIOUS ',size(duv_a,1)
      !TEST!Print *,'Size DUV',size(duv,1)
      ! We should now start from DUV, not DUV_PREVIOUS
      ! It is not clear why, as normally DUV_PREVIOUS was pointing towards DUV before
      ! but it seems needed to Mosaic... To be elucidated
      duv_in => duv_a(:,ivstart:ivend)    !! DUV_A should be used, DUV associated outside if needed
      if (kvend.gt.ubound(duv_b,2)) then   
        Print *,'Programming error KVEND',kvend,' > Bound ',ubound(duv_b,2)
      endif
      duv_out => duv_b(:,kvstart:kvend)    ! We put in DUV_B
      if (fft) then
        allocate(duv_tmp(7+3*chunk+itrail,kvend-kvstart+1),stat=ier)
        if (ier.ne.0) then
          call map_message(seve%e,comm,'FFT memory allocation error')
          error = .true.
          return
        endif
      endif
      !
      if ((cctsize.eq.3).or.(beamsize.eq.0)) then
        if (beamsize.ne.0) then
          omic(:) = nmic(:)   ! Restart from un-attenuate Clean Component List size
          call attenuate_clean(nchan,ccou,doff(:,ifield), & 
          &	bsize(teles(ifield)),fcou,omic)
        endif
        !
        if (.not.fft) then
          if (debug) Print *,'Slow case IC ',ic,' LC ',lc,' OMIC ',omic,' IFIELD ',ifield
          call uv_removes_clean(nv,duv_in,duv_out,lc-ic+1,omic, &
            & fcou,freq,ic,lc, subtract)
        else
          if (debug) Print *,'Fast case IC ',ic,' LC ',lc,' OMIC ',omic, ' IFIELD ',ifield
          !
          ! By channel chunks
          do oic=ic,lc,chunk
            olc = min(lc,oic+chunk-1)
            duv_tmp = 0.
            !
            ! Offset in OMIC but Also in FCOU
            fctmp => fcou(:,:,oic-ic+1:)
            call uv_removef_clean(hcct,duv_in,duv_tmp,olc-oic+1,omic(oic:olc), &
              & fctmp,freq, oic, olc, subtract)
            !
            do iv=1,nv
              duv_out(5+3*oic:7+3*olc,iv) = duv_tmp(8:7+3*(olc-oic+1),iv)
            enddo
          enddo
        endif
      else    ! GCLEAN on Mosaic
        ! Compute the Clean Component Map, but unsmoothed by the Clean beam
        ! Set the beam size to Zero for this
        save_major = the_method%major
        the_method%major = 0.
        !
        compact = .true.
        call sic_get_logi('RESTORE_COMPACT',compact,error)
        error = .false.
        if (debug) Print *,'User set RESTORE_COMPACT ',compact, error
        !
        if (.not.compact) then
          !
          ! Do by Fields, using FFT
          omic(:) = nmic(:)   ! Restart from un-attenuate Clean Component List size
          ! By channel chunks
          do oic=ic,lc,chunk
            olc = min(lc,oic+chunk-1)
            duv_tmp = 0.
            !
            ! Offset in OMIC but Also in FCOU
            fctmp => fcou(:,:,oic-ic+1:)
            ! Loop over channels to compute the Clean Component Cube
            do jc=oic,olc
              kc = jc-oic+1
              call clean_make_cct(the_method,hclean,dmap(:,:,kc:kc),fctmp(:,:,kc:kc),the_method%gsize)
            enddo
            !
            ! This is approximate
            jc = (oic+olc)/2
            ibeam = beam_for_channel(jc,hdirty,hbeam)
            if (hbeam%gil%faxi.eq.3) then
              j3 = ibeam
              j4 = ifield
            else
              j3 = ifield
              j4 = ibeam
            endif
            !
            call uv_removeg_clean(hcct,duv_in,duv_tmp,olc-oic+1,omic(oic:olc), &
              & dmap,freq, oic, olc, hbeam%r4d(:,:,j3,j4), subtract)
            !
            do iv=1,nv
              duv_out(5+3*oic:7+3*olc,iv) = duv_tmp(8:7+3*(olc-oic+1),iv)
            enddo
          enddo
        else
          if (ifield.eq.1) call map_message(seve%w,task,'Using REMOVEH for GCLEAN on Mosaic')
          ! Do by Fields, using FFT
          omic(:) = nmic(:)   ! Restart from un-attenuate Clean Component List size
          ! By channel chunks
          do oic=ic,lc,chunk
            olc = min(lc,oic+chunk-1)
            duv_tmp = 0.
            fctmp => fcou(:,:,oic-ic+1:)
            !
            call uv_removeh_clean(the_method,hbeam,hclean, &
            & hcct,duv_in,duv_tmp,olc-oic+1,omic,fctmp,freq,oic,olc,ifield,subtract) !
            !
            do iv=1,nv
              duv_out(5+3*oic:7+3*olc,iv) = duv_tmp(8:7+3*(olc-oic+1),iv)
            enddo
          enddo
        endif
        the_method%major = save_major
      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
      !
      if (allocated(duv_tmp)) deallocate (duv_tmp)
    enddo ! Fields
    !
  endif ! DO_RESI
  !
  ! Compute the CLEAN image
  if (do_clean) then
    call copy_method(the_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
    ! We need a Clean Beam size    
    !
    call mosaic_set_beam(task,my_method)
    !
    ! Use the Full Clean Component list size
    call generate_clean(my_method,hsky,1,lc-ic+1,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
  !*
  ! IMAGER --  Support for UV_RESTORE  
  !   Compute the actual number of components
  !!
  !-----------------------------------------------------------------
  type(gildas), intent(in) :: hcct    !! header of CCT data set
  real, intent(in) :: ccin(hcct%gil%dim(1),hcct%gil%dim(2),hcct%gil%dim(3))  !! CCT data set
  integer, intent(out) :: mic         !! Last valid component
  !
  ! Local ---
  integer :: nc, ic, i, ni, ki, mi
  !
  ! Code ----
  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
    if (ki.ne.0) then
      mi = max(mi,ki)
    endif
  enddo
  if (mi.eq.0) mi = ni
  mic = mi
end subroutine uv_clean_size
!
subroutine generate_clean(amethod,hmap,first,last,ccou,mic)
  !$ use omp_lib
  use clean_def
  use image_def
  use imager_interfaces, only : clean_make
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !*
  ! IMAGER -- Support for UV_RESTORE
  !
  !   Generate the Clean image (without residuals) from the 
  !   (compressed or not) list of Clean components, over
  !   the specified range of channels
  !!
  !---------------------------------------------------------------------
  type(clean_par), intent(in) :: amethod  !! Clean Method
  type(gildas), intent(inout) :: hmap     !! Clean Header
  integer, intent(in) :: first            !! First channel
  integer, intent(in) :: last             !! Last channel
  real, intent(in) :: ccou(:,:,:)         !!  (x,y,Value),Component,Plane
  integer, intent(in) :: mic(:)           !! Niter per plane
  !
  ! Local ---
  type (cct_par), allocatable :: p_cct(:)
  type (clean_par) :: my_method 
  integer :: iplane, jplane, niter, miter, i, ier, nthread
  !
  ! Code ----
  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_make(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,dpha)
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !*
  ! IMAGER -- Support for UV_RESIDUAL
  !
  !   Apply primary beam attenuation to Clean Components
  ! at specified offset. Compress Clean component based on position
  ! while doing so.
  !
  ! If a Phase Offset argument DPHA is present, shift the Clean
  ! Component positions to this new phase center.
  !!
  !---------------------------------------------------------------------
  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), intent(in), optional :: dpha(2)  !! Phase offsets if any
  !
  ! Local ---
  real :: beam_e, b2, fact
  integer :: ic,jc,kc
  logical :: do_shift
  !
  ! Code ----
  do_shift = present(dpha)
  if (do_shift) then
    if ((dpha(1).eq.0).and.(dpha(2).eq.0)) then
      do_shift = .false.
    endif
  endif
  !
  beam_e = bsize/(2.*sqrt(log(2.0)))
  b2 = (1.0/beam_e)**2
  !
  ! The attenuation here is currently purely Gaussian
  ! We MUST use the beam profile mechanism to do better.
  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)
        if (do_shift) then
          fcou(1:2,kc,ic) = ccou(1:2,jc,ic)-dpha(1:2)
        else
          fcou(1:2,kc,ic) = ccou(1:2,jc,ic)
        endif
      endif
    enddo
    mic(ic) = kc
  enddo
  !
end subroutine attenuate_clean
!
subroutine mosaic_set_beam(task,my_method)
  use gkernel_interfaces
  use imager_interfaces, only : fibeam, map_message
  use clean_def
  use clean_arrays
  use clean_types
  use clean_default
  use clean_beams
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !
  !! IMAGER -- Define the Mosaic Clean Beam
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: task        !! Caller name
  type(clean_par), intent(inout) :: my_method !! Clean parameters 
  !! to be completed by Clean beam
  !
  ! Constants
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: sec_to_rad=pi/3600.d0/180d0
  !
  ! Local ---
  character(len=80) :: mess
  integer :: nx,ny
  logical :: error
  !
  ! Code ----
  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)
      error = .false.
      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)
    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
    write(mess,'(A,F8.2)') 'Spatial Resolution was already defined ', &
      & hsky%gil%majo*180*3600/pi
    call map_message(seve%w,task,mess)
  endif
end subroutine mosaic_set_beam
