!
subroutine uv_residual(line,error)
  use gkernel_interfaces
  use imager_interfaces, except_this=>uv_residual
  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
  logical, intent(out) :: error
  !
  integer, parameter :: o_field=1
  !
  real, pointer :: duv_previous(:,:), duv_next(:,:)
  character(len=*), parameter :: task='UV_RESIDUAL'
  logical do_weight
  !
  nullify(duv_previous,duv_next)
  !
  ! Do the job. The .false. means do not re-image with Clean 
  ! components added.
  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
  !
  ! Resize UV data and redefine SIC variables 
  huv%gil%nvisi = ubound(duv,2)
  huv%gil%dim(2) = huv%gil%nvisi
  !
  do_weight = sic_present(o_field,0)
  call uv_new_data(weight=do_weight)  ! Re-compute weight if needed
end subroutine uv_residual
!
subroutine sub_uv_residual(task,line,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 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
  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
  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
  !
  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(projection_t) :: proj
  real(8) :: pos(2)
  real(8), parameter :: sec=3600.d0*180d0/pi
  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
  !
  ! 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 !! (nu-7)/3
  !
  ic = 1
  lc = 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
    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'
    call map_message(seve%e,task,chain)
    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 (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
  hcct%r3d => dcct
  call uv_clean_sizes(hcct,hcct%r3d,omic,ic,lc)
  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) then
    !
    ! 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, doff(2,ifield)*sec
    enddo
    !
    ! Get primary beam size
    call get_bsize(huv,task,' ',bsize,error)
    if (debug) Print *,'Primary beam size ',bsize*sec
    !
    ! 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,error)
      if (error) return
    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
  !! Print *,'Default FFT ',fft, mv
  call sic_get_logi('FAST',fft,error)
  !! Print *,'User set FFT ',fft, error
  error = .false.
  !
  ! 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
  !!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 1
  olc = lc    ! This must be nchan
  !
  ! 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)
  ! 
  ! 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
  !
  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
    write(chain,'(A,I0,4(1X,I0),2F10.2)') 'Processing field # ',ifield, &
      & ivstart,ivend, kvstart, kvend, doff(1,ifield)*sec, doff(2,ifield)*sec
    call map_message(seve%i,task,chain)
    !
    nv = ivend-ivstart+1
    if (ivend.gt.ubound(duv,2)) then
      Print *,'Programming error IVEND',kvend,' > Bound ',ubound(duv,2)
    endif
    duv_in => duv(:,ivstart:ivend)
    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)
    !
    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
    ! Use the Full Clean Component list size
    call generate_clean(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)
  !
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(hmap,first,last,ccou,mic)
  use clean_arrays
  use imager_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
  !
  miter = max(1,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
!
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=3600.d0*180d0/pi
  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,doff(2)*sec
  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
