subroutine sub_uv_residual(comm,line,iarg,huv_call,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 utils
  !$ 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
  type(gildas), intent(inout) :: huv_call           !! UV data to be changed
  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, allocatable, target :: fcou(:,:,:)
  real, pointer :: fctmp(:,:,:)
  real, allocatable :: duv_tmp(:,:)
  real, allocatable :: dmap(:,:,:)          ! Storage for GAUSS method in Mosaics.
  integer, allocatable :: omic(:), nmic(:)
  integer :: ci_nchan, ci_ic, ci_lc         ! Input CCT channel range
  integer :: co_nchan, co_ic, co_lc         ! Compressed CCT channel_range
  integer :: map_nchan, map_ic, map_lc      ! Output UV Chnnell range
  integer :: oic, olc, iic, ilc, mic, maxic, icmax, 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
  real, allocatable :: rprim(:,:)   ! Current primaru beam
  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, mc
  !
  integer :: wcol, cctsize
  integer :: chunk, mx, my
  integer :: itrail
  real :: bstep ! Words per image pixel
  logical :: compact ! Test logical for code development
  integer, allocatable :: teles(:)
  !
  character(len=*), parameter :: prefix='SUB_UV_RESIDUAL -- '
  integer :: othread
  logical :: per_field
  !
  ! Code ---
  !
  ! Change Message header 
  if (comm.eq.'MOSAIC_RESTORE') then
    task = 'MOSAIC_RESIDUAL'
  else
    task = comm
  endif
  call print_buffer_asso('UV Call at SUB_UV_RESIDUAL start',huv_call)
  !
  call imager_tree('SUB_UV_RESIDUAL',.false.)
  debug = .false.
  call sic_get_logi('DEBUG_RESIDUAL',debug,error)
  error = .false.
  !
  ! 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_call%gil%dim(1)
  nv = huv_call%gil%nvisi    ! not %dim(2)
  nchan = huv_call%gil%nchan ! Default value 
  map_nchan = huv_call%gil%nchan ! Default value 
  !
  ! That only works for UV_RESTORE, not for UV_RESIDUAL
  do_mosaic = abs(themap%nfields).gt.1
  if (do_mosaic) then
    ! Saved_chan%bounds may be incorrect in /CONTINUUM mode...`
    ! Unclear for Single fields so far
    saved_chan%bounds = [1,nchan]
    if (debug) then
      Print *,'Enter channel range ',saved_chan%bounds
      read(*,*) saved_chan%bounds
    endif
  endif
  call get_cols(map_nchan,saved_chan%bounds,map_ic,map_lc,wcol)
  if (debug) then
    Print *,'Saved_chan%bound ' ,saved_chan%bounds   !SG
    Print *,'Done GET_COLS Map '//str(map_ic)//'-'//str(map_lc)//' NCHAN '//str(map_nchan)
  endif 
  call print_buffer_asso('UV Call after GET_COLS',huv_call)
  !
  ithread = 1
  nthread = 1
  elapsed_e = 0.
  elapsed_s = 0.
  elapsed = 0.
  error = .false.
  !
  ! Verify number of channels match
  if (hcct%gil%dim(2).ne.huv_call%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')
      if (debug) Print *,'Channel range ',saved_chan%bounds
      ci_nchan = 1
      ci_ic = 1
      ci_lc = 1
    else
      write(chain,'(A,I0,A,I0,A)') 'Number of channels in CCT [', &
      & hcct%gil%dim(2),'] and in UV [',huv_call%gil%nchan,'] do not match'
      if (debug) Print *,'SAVED_MCOL ',saved_chan%bounds 
      call map_message(seve%w,task,chain)
      !
      ci_nchan = map_nchan
      ci_ic = 1
      ci_lc = map_nchan
    endif
  else
    ci_nchan = map_lc-map_ic+1
    ci_ic = 1
    ci_lc = ci_nchan 
  endif  
  co_nchan = ci_nchan
  co_ic = 1
  co_lc = co_nchan
  if (debug) then
    Print *,prefix,'CI ',ci_ic,ci_lc,ci_nchan
    Print *,prefix,'CO ',co_ic,co_lc,co_nchan
    Print *,prefix,'Map ',map_ic,map_lc,map_nchan
  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(co_nchan),nmic(co_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
  if (debug) then
    Print *,prefix,'DCCT size ',size(dcct,1),size(dcct,2),size(dcct,3)
    Print *,prefix,'CO_NCHAN ',co_nchan,' IC LC ',co_ic,co_lc
    Print *,prefix,'CI_NCHAN ',ci_nchan,' IC LC ',ci_ic,ci_lc
  endif
  call uv_clean_sizes(hcct,hcct%r3d,omic,ci_ic,ci_lc)
  icmax = maxval(omic)
  if (debug) Print *,prefix,'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
    call get_bsize(huv_call,task,' ',bsize,error)
    call print_buffer_asso('UV Call after GET_BSIZE',huv_call)
    if (debug) Print *,prefix,'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_call%gil%column_pointer(code_uvt_xoff), &
        & huv_call%gil%column_pointer(code_uvt_yoff), &
        & nfields
      !
      new = 0.D0 ! No change of Phase center
      !
!SG! NON !...      huv_call%r2d => duv
    call print_buffer_asso('UV Call before MOSAIC_SORT',huv_call)
      call mosaic_sort (huv_call,error,sorted,shift,new,uvmax,uvmin, &
        & huv_call%gil%column_pointer(code_uvt_xoff), &
        & huv_call%gil%column_pointer(code_uvt_yoff), &
        & huv_call%gil%column_pointer(code_uvt_id), &
        & nfields,doff,ivoff)
    call print_buffer_asso('UV Call after MOSAIC_SORT',huv_call)
      if (error) return
      teles(1:nfields) = huv_call%mos%fields(:)%jteles
      if (debug) Print *,'Nfields ',nfields
      !
      ! Shift offset coordinates to Phase center 
      call gwcs_projec(huv_call%gil%a0,huv_call%gil%d0,huv_call%gil%pang,huv_call%gil%ptyp,proj,error)
      if (debug) Print *,'Posangle ',huv_call%gil%pang
      ! POS is here the Offset of the Pointing center relative to the Phase center
      call abs_to_rel (proj,huv_call%gil%ra,huv_call%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 *,prefix,'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.
  !
  ! 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,co_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 *,prefix,'uv_squeeze_clean ',co_nchan,omic,co_ic,co_lc
  call uv_squeeze_clean(co_nchan,hcct%r3d, ccou, omic,co_ic, co_lc)
  if (debug) then
    Print *,prefix,'CCOU size ',cctsize,icmax,co_nchan
    Print *,prefix,'DCCT size ',hcct%gil%dim(1:3)
  endif
  ! 
  ! Remember the Full Clean Component List size
  nmic(:) = omic
  !
  if ((cctsize.eq.3).or.(beamsize.eq.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(cctsize,maxic,co_nchan),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,task,'CCT Memory allocation error')
      error = .true.
      return
    endif
  endif
  freq = gdf_uv_frequency(huv_call,0.5d0*(map_ic+map_lc))
  !
  itrail = -huv_call%gil%lcol + huv_call%gil%dim(1) 
  !
  if (debug) Print *,prefix,'LCOL ',huv_call%gil%lcol,' and DIM ',huv_call%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 (do_resi) then
    bstep = 0.05               ! Small memory imprint
    mc = huv_call%gil%nchan
    if (fft) then
      bstep = 2.0     ! 1 complex word
      if (hcct%gil%dim(2).eq.1) bstep = 0.05+2.0/mc ! 1 fft for All
    endif
    mx = (hcct%gil%convert(1,1)-1)*2   ! Reference pixel is at Mx/2+1
    my = (hcct%gil%convert(1,3)-1)*2
    ! Would be better based on Frequency accuracy
    call uv_get_block(fft,mx,my,mc,1,bstep,chunk)
    !
    if ((cctsize.eq.4).and.(nfields.gt.1)) then
      allocate(dmap(mx,my,nchan),stat=ier) !! Which NCHAN ?... co_nchan Probably
      if (ier.ne.0) then
        call map_message(seve%e,task,'DMAP Memory allocation error')
        error = .true.
        return
      endif
    endif
    !
    !
    if ((cctsize.eq.3).or.(beamsize.eq.0)) then
      save_major = the_method%major
      continue
    else
      ! Set the beam size to Zero for this
      save_major = the_method%major
      the_method%major = 0.
      !
      ! FCOU is assigned to CCOU by pointer association here.
      !
      compact = .true.
      call sic_get_logi('RESTORE_COMPACT',compact,error)
      error = .false.
      if (debug) Print *,'User set RESTORE_COMPACT ',compact, error     
    endif
    !
    ! Test -- for parallelism
    per_field = .false.  ! Make sure it is initialized
    !
    othread = 1  
    !$ othread = omp_get_max_threads()
    if (othread.gt.map_nchan) then
      omp_nested = .false.
      nthread = othread
      !$ call ompset_thread_nesting(task, nthread, othread, omp_nested)    
      !$ nthread = ompget_outer_threads()
      per_field = .true.    
      write(chain,'(A,I0,A,I0,A)') 'Using per-field parallel mode. - Threads ',nthread,' Fields ',nfields
    else
      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)
      write(chain,'(A,I0,A,I0,A)') 'Using squential fields - Threads ',nthread,' Fields ',nfields
    endif
    call map_message(seve%i,task,chain,seve%w)
    !
    !
    !$OMP PARALLEL DEFAULT(none) if (per_field) NUM_THREADS (nthread) &
    !$OMP   & SHARED(np,task,themap,huv_call,dprim,dbeam) & 
    !$OMP   & SHARED(hdirty,hbeam,hclean,hprim,hcct,the_method) &
    !$OMP   & SHARED(nfields,error,selected_fieldsize,selected_fields) &
    !$OMP   & SHARED(ivoff,jvoff,fft, doff, duv_a,duv_b, chunk) &
    !$OMP   & SHARED(save_major, beamsize, compact, debug) &
    !$OMP   & SHARED(nmic, cctsize, comm, ccou, itrail) &
    !$OMP   & SHARED(map_lc,map_ic,subtract,co_ic,co_lc,co_nchan,ci_ic,ci_lc) &
    !$OMP   & SHARED(freq, teles, bsize) &
    !$OMP   & PRIVATE(ifield,jfield,ivstart,ivend,kvstart,kvend,nv,iv) &
    !$OMP   & PRIVATE(chain,ibeam,kc,jc,omic, fcou) &
    !$OMP   & PRIVATE(duv_in, duv_tmp, dmap, rprim, fctmp, duv_out) &
    !$OMP   & PRIVATE(ilc, iic, olc, oic, mic, ier) 
    !
    !$OMP DO
    do jfield=1,nfields
      !
      if (sic_ctrlc()) then
        call map_message(seve%w,task,'Aborted by user ^C')
        error = .true.
        cycle
      endif
      !
      ifield = jfield
      if (selected_fieldsize.ne.0) ifield = selected_fields(jfield)
      if (debug) Print *,prefix,'Field ',ifield,jfield
      !
      ! This looks tricky, but is working.
      ! It used to extract an arbitrary subset from 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.0) 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_a,2)) then
        Print *,prefix,'Programming error IVEND',kvend,' > Input Bound ',ubound(duv_a,2)
      endif
      ! 
      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 *,prefix,'Programming error KVEND ',kvend,' > Output Bound ',ubound(duv_b,2)
      endif
      duv_out => duv_b(:,kvstart:kvend)    ! We put in DUV_B
      !
      if (fft) then
        if (allocated(duv_tmp)) then
          call map_message(seve%e,task,'Programming error, DUV_TMP already allocated')
          deallocate(duv_tmp)
        endif
        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.
          cycle
        endif
      endif
      !
      if ((cctsize.eq.3).or.(beamsize.eq.0)) then
        if (beamsize.ne.0) then
          ! Mosaic only
          if (debug) Print *,'prefix','Calling attenuate_clean'
          omic(:) = nmic(:)   ! Restart from un-attenuate Clean Component List size
          call attenuate_clean(co_nchan,ccou,doff(:,ifield), & 
          & bsize(teles(ifield)),fcou,omic)
        endif
        !
        if (.not.fft) then
          if (debug) then
            Print *,prefix,'SLOW case IC ',co_ic,' LC ',co_lc,' OMIC '!! ,omic
            Print *,prefix,'Channels ',map_ic,map_lc, ' IFIELD ',ifield,' SUBTRACT ',subtract
          endif
          call uv_removes_clean(nv,duv_in,duv_out,co_nchan,omic, &
            & fcou,freq, map_ic, map_lc, subtract)
        else
          if (debug) then
            Print *,prefix,'FAST case IC ',co_ic,' LC ',co_lc,' OMIC ',omic, &
            'Channels ',map_ic,map_lc, ' IFIELD ',ifield,' SUBTRACT ',subtract
          endif
          !
          ! By channel chunks
          mic = size(omic)
          do oic=map_ic,map_lc,chunk
            olc = min(map_lc,oic+chunk-1)
            duv_tmp = 0.
            !
            ! Offset in OMIC but Also in FCOU
            if (mic.eq.1) then
              call uv_removef_clean(hcct,duv_in,duv_tmp,olc-oic+1,omic(1:1), &
                & fcou,freq, oic, olc, subtract)
            else
              iic = oic-map_ic+ci_ic ! Or co ???
              ilc = olc-map_ic+ci_ic ! Or co ???
              fctmp => fcou(:,:,oic-co_ic+1:olc-co_ic+1)  ! Ensure size is correct
              call uv_removef_clean(hcct,duv_in,duv_tmp,olc-oic+1,omic(iic:ilc), &
                & fctmp,freq, oic, olc, subtract)
            endif
            !
            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
        !
        omic(:) = nmic(:)   ! Restart from un-attenuate Clean Component List size
        if (.not.compact) then
          if (ifield.eq.1) then
            call map_message(seve%i,task,'Using REMOVEG for GCLEAN on Mosaic')
            allocate(rprim(hprim%gil%dim(2),hprim%gil%dim(3)),stat=ier)
            if (ier.ne.0) then
              call map_message(seve%e,task,'RPRIM Memory allocation error')
              error = .true.
              cycle 
            endif
          endif
          !
          ! Do by Fields, using FFT by channel chunks
          do oic=map_ic,map_lc,chunk
            olc = min(map_lc,oic+chunk-1)
            duv_tmp = 0.
            !
            !SG - Not ready for Continuum residual in Line 
            !SG  FFT could use only 1 plane
            ! Offset in OMIC but also in FCOU
            fctmp => ccou(:,:,oic-map_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,hprim)
            !
            rprim = hprim%r4d(ifield,:,:,ibeam)
            call uv_removeg_clean(hcct,duv_in,duv_tmp,olc-oic+1,omic(oic:olc), &
              & dmap, freq, oic, olc, rprim, 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
          deallocate(rprim)
        else
          if (ifield.eq.1) call map_message(seve%i,task,'Using REMOVEH for GCLEAN on Mosaic')
          ! Do by Fields, using FFT
          !SG - Not ready for Continuum residual in Line 
          !SG - FFT could use only 1 plane
          ! By channel chunks
          do oic=map_ic,map_lc,chunk
            olc = min(map_lc,oic+chunk-1)
            duv_tmp = 0.
            fctmp => ccou(:,:,oic-map_ic+1:)
            !
            call uv_removeh_clean(the_method,hprim,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
      endif
      !
      ! Add leading and trailing data if any
      if (huv_call%gil%lcol.lt.huv_call%gil%dim(1)) then
        do iv=1,nv
          duv_out(1:7,iv) = duv_in(1:7,iv)
          duv_out(huv_call%gil%lcol+1:huv_call%gil%dim(1),iv) = &
            & duv_in(huv_call%gil%lcol+1:huv_call%gil%dim(1),iv)  
        enddo
      else
        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
    !$OMP END DO
    !$OMP END PARALLEL
    the_method%major = save_major  ! Restore the beam for further use.
    !
    if (error) return ! In case of ^C
  endif ! DO_RESI
  !
  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)
  !
  !
  ! 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,co_nchan,ccou,nmic)
    call gag_cpu(cpu1)
    if (elapsed.eq.0) then
      write(chain,102) 'Finished Clean generation CPU ',cpu1-cpu0
    else
      write(chain,102) 'Finished Clean generation Elapsed ',elapsed,'; CPU ',cpu1-cpu0
    endif
    call map_message(seve%i,task,chain)
  endif
  !
  if (allocated(fcou)) deallocate(fcou)
  if (allocated(ccou)) deallocate(ccou)
  !
  call imager_tree('SUB_UV_RESIDUAL',.true.)
  !
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 old_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,Size),Component,Plane
  integer, intent(in) :: mic(:)           !! Niter per plane
  !
  real(kind=8), parameter :: pi=acos(-1d0)
  !
  ! Local ---
  type (cct_par), allocatable :: p_cct(:)
  real, allocatable :: gauss(:)
  type (clean_par) :: my_method 
  integer :: iplane, jplane, niter, miter, i, ier, nthread, isize, nsize
  !
  ! Code ----
  miter = max(1,maxval(mic))
  nsize = 0
  allocate (p_cct(miter),stat=ier)
  isize = size(ccou,1) 
  if (isize.eq.4) then
    Print *,'Multi-Scale CLEAN component not yet handled'
    nsize = 1
    do i=size(amethod%gsize),2,-1
      if (amethod%gsize(i).ne.0) then
        nsize = i
        exit
      endif
    enddo
    Print *,'Scale sizes ',amethod%gsize(1:nsize)
    Print *,'Type / to proceed'
    read(*,*) i
    allocate(gauss(nsize))
    gauss = amethod%gsize(1:nsize)*pi/180/3600
    Print *,'Gaussian sizes in Radian ',gauss
  endif
  !$ 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 & SHARED(isize, nsize, gauss) &
  !$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)
        if (isize.eq.4) then
          p_cct(i)%size = ccou(4,i,jplane)
          if (p_cct(i)%size.ne.0) Print *,'Iter ',i,p_cct(i)%size
        endif
      endif
    enddo
    ! Stupid test
    if (niter.gt.0) then
      my_method%n_iter = niter
      if (nsize.gt.1) then
        call clean_make(my_method,hmap, hmap%r3d(:,:,iplane),p_cct,gauss)
      else
        call clean_make(my_method,hmap, hmap%r3d(:,:,iplane),p_cct)
      endif
    else
      hmap%r3d(:,:,iplane) = 0
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  !
  deallocate(p_cct)
end subroutine old_generate_clean
!
subroutine generate_clean(amethod,hmap,first,last,ccou,mic)
  !$ use omp_lib
  use clean_def
  use image_def
  use imager_interfaces, only : clean_make_cct
  !---------------------------------------------------------------------
  ! @ 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,Size),Component,Plane
  integer, intent(in) :: mic(:)           !! Niter per plane
  !
  real(kind=8), parameter :: pi=acos(-1d0)
  !
  ! Local ---
  real, allocatable :: gauss(:)
  type (clean_par) :: my_method 
  integer :: iplane, jplane, miter, i, isize, nsize
  !
  ! Code ----
  miter = max(1,maxval(mic))
  nsize = 0
  isize = size(ccou,1) 
  if (isize.eq.4) then
    ! !Print *,'Multi-Scale CLEAN component not yet Verified'
    nsize = 1
    do i=size(amethod%gsize),2,-1
      if (amethod%gsize(i).ne.0) then
        nsize = i
        exit
      endif
    enddo
    ! !Print *,'Scale sizes ',amethod%gsize(1:nsize)
    allocate(gauss(nsize))
    gauss = amethod%gsize(1:nsize) ! It must be in ArcSeconds 
  else
    ! !Print *,'Normal Clean Generation'
  endif
  !
  do iplane=first,last
    jplane = iplane-first+1
    my_method = amethod
    my_method%n_iter = mic(jplane)
    if (nsize.gt.1) then
      call clean_make_cct(my_method,hmap,hmap%r3d(:,:,iplane), &
        & ccou(:,1:mic(jplane),jplane:jplane),gauss)
    else
      call clean_make_cct(my_method,hmap,hmap%r3d(:,:,iplane), &
        & ccou(:,1:mic(jplane),jplane:jplane))        
    endif
  enddo
  !
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 or 4,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
  !
  integer, external :: locwrd
  !
  logical, parameter :: debug=.false.
  ! Local ---
  real :: beam_e, b2, fact
  integer :: ic,jc,kc
  logical :: do_shift, gauss
  real :: isum(nchan), osum(nchan)  !! Debug - automatic arrays
  !
  ! Code ----
  if (locwrd(ccou).eq.locwrd(fcou)) then
    Print *,'F-ATTENUATE_CLEAN,  Programming error - Overlapping arrays)'
    STOP
  endif
  do_shift = present(dpha)
  if (do_shift) then
    if ((dpha(1).eq.0).and.(dpha(2).eq.0)) then
      do_shift = .false.
    endif
    if (debug) Print *,'Attenuate_Clean -- DOSHIFT ',do_shift,dpha
  else
    if (debug) Print *,'Attenuate_Clean -- NO Shift'
  endif
  if (debug) then
    Print *,'Attenuate_Clean ',nchan,doff(1:2),size(ccou,1),size(fcou,1)
    Print *,'Adress ccou ',locwrd(ccou),' fcou ',locwrd(fcou)
  endif
  !
  beam_e = bsize/(2.*sqrt(log(2.0)))
  b2 = (1.0/beam_e)**2
  gauss = size(ccou,1).eq.4 ! GCLEAN size
  !
  ! The attenuation here is currently purely Gaussian
  ! We MUST use the beam profile mechanism to do better.
  if (debug) then
    isum = 0.
    osum = 0.
    Print *,'Attenuate_Clean In Components ',mic
  endif
  do ic=1,nchan
    kc = 0
    do jc=1,mic(ic)
      if (debug) isum(ic) = isum(ic)+ccou(3,jc,ic)
      fact = ((ccou(1,jc,ic)-doff(1))**2+(ccou(2,jc,ic)-doff(2))**2)*b2
      if (fact.lt.16) then   ! for 1E-7 precision, more than enough
        kc = kc+1
        fcou(3,kc,ic) = ccou(3,jc,ic)*exp(-fact)
        if (debug) osum(ic) = osum(ic)+fcou(3,kc,ic)
        if (do_shift) then
!Initial          fcou(1:2,kc,ic) = ccou(1:2,jc,ic)-dpha(1:2)
          fcou(1:2,kc,ic) = ccou(1:2,jc,ic)-dpha(1:2)
!Non  with final DPHA        fcou(1:2,kc,ic) = ccou(1:2,jc,ic)+dpha(1:2) !SG
!Non          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
        if (gauss) fcou(4,kc,ic) = ccou(4,jc,ic)
      endif
    enddo
    mic(ic) = kc
  enddo
  if (debug) then
    Print *,'Attenuate_Clean In FLUX ',isum
    Print *,'Attenuate_Clean Out Components ',mic
    Print *,'Attenuate_Clean Out FLUX ',osum
  endif
  !
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
!
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
!
