subroutine uv_model_comm(line,error)
  use gildas_def
  use gbl_message
  use gkernel_interfaces
  use clean_default
  use imager_interfaces, except_this => uv_model_comm
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Support routine for command
  !     MODEL [Args] [/MINVAL Value [Unit]] [/OUTPUT]
  !           [/MODE CCT|UV_FIT|IMAGE]
  !
  ! Dispatch to adequate routine as specified by /MODE option to   
  !  - Compute the MODEL UV data set from the current CCT table
  ! or
  !  - Compute the MODEL UV data set from the current UV_FIT results
  ! or
  !  - Compute the MODEL UV data set from the specified IMAGE variable
  !
  !   If no /MODE option is specified, the operation depends on whether 
  ! CLEAN or UV_FIT was executed last.
  !   The /OUTPUT option is dummy, being present only for compatibility
  ! with the UV_RESIDUAL command
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  character(len=*), parameter :: rname='MODEL'
  integer, parameter :: o_minval=1 ! 
  integer, parameter :: o_output=2 ! Must be 2 ...
  integer, parameter :: o_mode=3   
  integer, parameter :: mmode=3
  integer :: imode
  character(len=8) argu,vocs(mmode),cmode
  data vocs/'CCT','IMAGE','UV_FIT'/ 
  !
  if (sic_present(o_mode,0)) then
    call sic_ch(line,o_mode,1,argu,imode,.true.,error)
    if (error) return
    call sic_ambigs(rname,argu,cmode,imode,vocs,mmode,error)
    if (error) return
  else
    cmode = last_resid ! CCT or UV_FIT
  endif
  !
  uv_model_updated = .true.
  if (cmode.eq.'UV_FIT') then
    call uvfit_residual_model(line,'MODEL',error)
  else if (cmode.eq.'CCT') then
    call cct_fast_uvmodel(line,error)
  else
    call map_fast_uvmodel(line,error)
  endif
end subroutine uv_model_comm
!<FF>
subroutine map_fast_uvmodel(line,error)
  use gildas_def
  use gbl_message
  use gkernel_interfaces
  use clean_arrays
  use imager_interfaces, except_this => map_fast_uvmodel
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Support routine for command
  !     MODEL ImageName [/MINVAL Value [Unit]] /MODE IMAGE
  !
  ! Compute the MODEL UV data set from the specified image 
  !
  ! Uses an intermediate FFT with further interpolation for better speed
  !    than UV_CCT
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  character(len=*), parameter :: rname='MODEL'
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  integer, parameter :: o_minval=1 ! 
  integer, parameter :: o_output=2 ! Must be 2 ...
  integer, parameter :: o_mode=3   
  ! Local
  logical :: large
  type(gildas) :: hmap
  complex, allocatable :: fft(:,:,:)
  real, allocatable :: dmap(:,:,:)
  real, allocatable :: work(:)
  integer :: if,nf,nx,ny,mx,my,kx,ky,nt,nv,mt, ier
  real :: cpu0, cpu1
  real :: rx, ry, factor, fmin
  real(8) :: xinc, yinc, area, jyperk
  character(len=8) :: chain
  integer :: nc, narg
  real(8) :: freq, fres, vres
  real :: lambda, pixel_area
  !
  large = sic_present(0,2) ! Test
  !
  if (.not.associated(duv)) then
    call map_message(seve%e,rname,'DUV is not associated') 
    error = .true.
    return
  endif
  ! Code
  error = .false.
  call gag_cpu(cpu0)
  !
  ! Input data is the current UV Data  huv & duv
  !
  ! Input MAP is specified as first argument...
  !
  ! The problem is to recover it in some more or less general way
  ! (SIC variable or Data file)
  !
  call map_message(seve%w,rname,'MODE IMAGE is still experimental, using CLEAN as input')
  ! 
  ! Use the CLEAN image so far for a test...
  if (hclean%loca%size.eq.0) then
    call map_message(seve%w,rname,'No CLEAN image')
    error = .true.
    return
  endif
  call gildas_null(hmap)
  call gdf_copy_header(hclean,hmap,error)
  !
  ! There must be some match of the Velocity axis (not the frequency axis)
  ! This match may imply a change of number of channels, i.e.
  ! we should be able to define the intersection of the two velocity
  ! axis.  For the time being, just assume they are identical,
  ! or take the Image axis if the UV data is just 1 channel.
  if (huv%gil%nchan.ne.1) then
    if (hmap%gil%dim(3).ne.huv%gil%nchan) then
      call map_message(seve%e,rname,'Velocity axis mis-match')
      error = .true.
      return
    endif
  endif
  nf = hmap%gil%dim(3) ! In all cases
  mx = hmap%gil%dim(1)
  my = hmap%gil%dim(2)
  !
  ! Then do the job as in the CCT case, except for the Scale factor...
  allocate (dmap(mx,my,nf),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'MAP Allocation error')
    error = .true.
    return
  endif
  !
  ! We need a copy because we ignore edges
  dmap = dclean 
  !
  ! Define observing frequency
  freq = hmap%gil%freq+hmap%gil%fres*(nf*0.5-hmap%gil%ref(3))
  vres = hmap%gil%vres
  xinc = hmap%gil%inc(1)
  yinc = hmap%gil%inc(2)
  !
  ! Retrieve minimum value
  call mod_min_image (line,hmap,freq,dmap,error)
  if (error) return
  !
  ! Avoid edges by default - Do not even bother to check for a mask
  ! or whatever - It is needed to avoid aliasing in any case
  do if=1,nf
    dmap(1:(mx/8),:,if) = 0
    dmap((7*mx)/8:mx,:,if) = 0
    dmap(:,1:(my/8),if) = 0
    dmap(:,(7*my)/8:my,if) = 0
  enddo
  !
  ! Define the image size
  call mod_fft_size(large,mx,my,nx,ny)
  call gag_cpu(cpu1)
  !
  ! Get Virtual Memory & compute the FFT
  allocate (fft(nx,ny,nf),work(2*max(nx,ny)),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'FFT space allocation error')
    error = .true.
    return
  endif
  !
  ! See UV_RESTORE also for this code
  if (nx.eq.mx .and. ny.eq.my) then
    fft(:,:,:) = cmplx(dmap,0.0)
  else
    do if = 1,nf
      call plunge_real (dmap(:,:,if),mx,my,fft(:,:,if),nx,ny)
    enddo
  endif
  ! Free map - Note that we may use a Pointer for built-in buffers...
  deallocate (dmap,stat=ier)
  !
  ! Compute the FFT
  !!Print *,'NX NY NF ', nx,ny,nf
  call do_fft(nx,ny,nf,fft,work)
  call gag_cpu(cpu1)
  !
  call gildas_null(huvm, type = 'UVT')
  !
  ! Do we want the same velocity layout as the UV data or that of the MAP? 
  ! The UV data specifies the appropriate UV coverage, 
  ! but the MAP specifies the Spectroscopy 
  call gdf_copy_header(huv,huvm,error) 
  !
  huvm%gil%dim(1) = 7+3*nf
  huvm%gil%ref(1)  = hmap%gil%ref(3)
  huvm%gil%val(1)  = freq
  !
  ! Set the velocity resolution
  huvm%gil%vres = vres
  huvm%gil%fres = -vres*freq/299792.458d0  ! Velocity in km/s
  huvm%gil%inc(1)  = huvm%gil%fres 
  !
  huvm%gil%freq = freq
  huvm%char%line = hmap%char%line 
  huvm%gil%voff = hmap%gil%voff
  !
  ! Set the number of channels
  huvm%gil%nchan = nf
  huvm%gil%convert(:,1) = hmap%gil%convert(:,3)
  !
  ! TO BE SOLVED ACCORDING TO IMAGE CHARACTERISTICS
  !
  if (hmap%char%unit.eq.'Jy/beam') then
    ! Get the scale factor of the input data. We want
    ! a model image in K for the rest of the job.
    area = pi*hmap%gil%majo*hmap%gil%mino/4/log(2.0)
    jyperk = 2*1.38e3*area/(299792458d0/freq*1d-6)**2
  else if (hmap%char%unit.eq.'K') then
    jyperk = 1.0
  endif
  !
  ! Define scaling factor from Brightness to Flux (2 k B^2 / l^2)
  lambda = 299792.458e3/(freq*1e6) ! in meter
  ! 1.38E3 is the Boltzmann constant times 10^26 to give result in Jy
  pixel_area = abs(xinc*yinc)   ! in radian
  factor = 2*1.38e3/lambda**2*pixel_area
  !! print *,'Factor ',factor,pixel_area
  !! if (factor.eq.0.0) factor = 1.0
  !
  factor = factor/jyperk  
  !
  huvm%gil%dim(1) = 7+3*nf
  !
  if (allocated(duvm)) deallocate(duvm)
  allocate (duvm(huvm%gil%dim(1),huvm%gil%dim(2)),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'UV Model allocation error')
    error = .true.
    return
  endif
  nt = huvm%gil%dim(1)
  nv = huvm%gil%dim(2)
  mt = huv%gil%dim(1)
  !
  ! At this stage, we just copy the DAPs and the weights.
  call copyuv (nt,nv,duvm,mt,duv)
  !
  ! Now compute the model
  call do_uvmodel(duvm, nt, nv, fft,nx,ny,nf,freq,xinc,yinc,factor)
  !
  call gag_cpu(cpu1)
  error = .false.
  !
end subroutine map_fast_uvmodel
!<FF>
subroutine cct_fast_uvmodel(line,error)
  use gildas_def
  use gbl_message
  use gkernel_interfaces
  use clean_arrays
  use imager_interfaces, except_this => cct_fast_uvmodel
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Support routine for command
  !     MODEL [MaxIter] [/MINVAL Value [Unit]] [/MODE CCT]
  !
  ! Compute the MODEL UV data set from the current CCT table
  !
  !     Uses an intermediate FFT with further interpolation for
  !     better speed than UV_CCT
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  character(len=*), parameter :: rname='MODEL'
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  integer, parameter :: o_minval=1 ! 
  integer, parameter :: o_output=2 ! Must be 2 ...
  integer, parameter :: o_mode=3   
  ! Local
  integer :: nclean ! Number of clean components retained
  logical :: large
  !
  complex, allocatable :: fft(:,:,:)
  real, allocatable :: dmap(:,:,:)
  real, allocatable :: work(:)
  integer :: if,nf,nx,ny,mx,my,kx,ky,nt,nv,mt, ier
  real :: cpu0, cpu1
  real :: rx, ry, factor, fmin
  real(8) :: xinc, yinc, freq, area, jyperk, vres
  character(len=8) :: chain
  integer :: nc, narg
  !
  nclean = 0
  call sic_i4(line,0,1,nclean,.false.,error)
  if (error) return
  large = sic_present(0,2) ! Test
  !
  if (.not.associated(duv)) then
    call map_message(seve%e,rname,'DUV is not associated') 
    error = .true.
    return
  endif
  ! Code
  error = .false.
  call gag_cpu(cpu0)
  !
  ! Input data is the current UV Data  huv & duv
  !
  ! Input CCT is the current CCT Data (it should match the UV data)
  !
  ! Compact it into an image
  ! This depends on the CCT type, and is done in a subroutine
  !    First, define the sampling and image size 
  call cct_def_image (hcct,mx,my,nf,freq,xinc,yinc,error)
  if (error) return

  if (nf.ne.1) then
    if (nf.ne.huv%gil%nchan) then
      call map_message(seve%e,rname,'Velocity axis mis-match')
      error = .true.
      return
    endif
  endif
  !
  !    Then do the job
  allocate (dmap(mx,my,nf),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'MAP Allocation error')
    error = .true.
    return
  endif
  call cct_set_image (hcct,dcct,mx,my,nclean,xinc,yinc,nf,dmap,error)
  !
  ! Retrieve minimum value
  if (hclean%loca%size.ne.0) then
    call mod_min_image (line,hclean,freq,dmap,error)
  else
    call mod_min_image (line,hcct,freq,dmap,error)
  endif
  if (error) return
  !
  ! Define the image size
  call mod_fft_size(large,mx,my,nx,ny)
  call gag_cpu(cpu1)
  !
  ! Get Virtual Memory & compute the FFT
  allocate (fft(nx,ny,nf),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'FFT space allocation error')
    error = .true.
    return
  endif
  !
  ! See UV_RESTORE also for this code
  if (nx.eq.mx .and. ny.eq.my) then
    fft(:,:,:) = cmplx(dmap,0.0)
  else
    do if = 1,nf
      call plunge_real (dmap(:,:,if),mx,my,fft(:,:,if),nx,ny)
    enddo
  endif
  ! Free map
  deallocate (dmap,stat=ier)
  allocate (work(2*max(nx,ny)),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'FFT work allocation error')
    error = .true.
    return
  endif
  !
  ! Compute the FFT
  call do_fft(nx,ny,nf,fft,work)
  call gag_cpu(cpu1)
  !
  call gildas_null(huvm, type = 'UVT')
  call gdf_copy_header(huv,huvm,error) ! Will work in all cases


  !
  ! Do we want the same velocity layout as the UV data or that of the MAP? 
  ! The UV data specifies the appropriate UV coverage, 
  ! but the MAP specifies the Spectroscopy 
  call gdf_copy_header(huv,huvm,error) 
  !
  huvm%gil%dim(1) = 7+3*nf
  huvm%gil%ref(1)  = hcct%gil%ref(hcct%gil%faxi)
  huvm%gil%val(1)  = freq
  !
  ! Set the velocity resolution
  vres = hcct%gil%vres
  huvm%gil%vres = vres
  huvm%gil%fres = -vres*freq/299792.458d0  ! Velocity in km/s
  huvm%gil%inc(1)  = huvm%gil%fres 
  !
  huvm%gil%freq = freq
  huvm%char%line = hcct%char%line 
  huvm%gil%voff = hcct%gil%voff
  !
  ! Set the number of channels
  huvm%gil%nchan = nf
  huvm%gil%convert(:,1) = hcct%gil%convert(:,hcct%gil%faxi)
  ! 
  ! Define scaling factor to Flux: we are in Jy, so this is simple
  factor = 1.0
  !
  if (allocated(duvm)) deallocate(duvm)
  allocate (duvm(huvm%gil%dim(1),huvm%gil%dim(2)),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'UV Model allocation error')
    error = .true.
    return
  endif
  nt = huvm%gil%dim(1)
  nv = huvm%gil%dim(2)
  mt = huv%gil%dim(1)
  !
  ! At this stage, copy the DAPs and Weights
  call copyuv (nt,nv,duvm,mt,duv)
  !
  ! Now compute the model
  call do_uvmodel(duvm, nt, nv, fft,nx,ny,nf,freq,xinc,yinc,factor)
  !
  call gag_cpu(cpu1)
  error = .false.
end subroutine cct_fast_uvmodel
!<FF>
subroutine mod_min_image(line,hmap,freq,dmap,error)
  use gkernel_types
  use gkernel_interfaces
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  type(gildas), intent(in) :: hmap
  real(8), intent(in) :: freq
  real, intent(inout) :: dmap(:,:,:)
  logical, intent(inout) :: error
  !
  integer, parameter :: o_minval=1
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  character(len=*), parameter :: rname='MODEL'
  integer :: narg, nc
  real :: fmin, area, jyperk
  character(len=16) :: chain
  !
  narg = sic_narg(o_minval)  ! /MINVAL option
  if (narg.le.0) return
  !
  fmin = 0.
  call sic_r4(line,o_minval,1,fmin,.true.,error)
  if (error) return
  !
  if (narg.gt.1) then
    call sic_ch(line,o_minval,2,chain,nc,.true.,error)
    if (error) return
    if (chain(1:nc).eq.'sigma') then
      fmin = fmin * max(hmap%gil%noise,hmap%gil%rms)
    elseif (chain(1:nc).eq.'mJy') then
      fmin = 1e-3*fmin
    elseif (chain(1:nc).eq.'K') then
      if (hmap%gil%majo.ne.0) then
        area = pi*hmap%gil%majo*hmap%gil%mino/4/log(2.0)
        jyperk = 2*1.38e3*area/(299792458d0/freq*1d-6)**2
        fmin = fmin * jyperk 
      else
        call map_message(seve%e,rname,'Unit K unsupported in this context')
        error = .true.
        return
      endif      
    elseif (chain(1:nc).eq.'Jy') then
      fmin = fmin
    else
      call map_message(seve%e,rname,'Unrecognized unit '//chain(1:nc))
      error = .true.
      return
    endif
  endif
  where (dmap.lt.fmin)  dmap = 0.
end subroutine mod_min_image
!<FF>
subroutine do_uvmodel (visi,nc,nv,a,nx,ny,nf,   &
     &    freq,xinc,yinc,factor)
  !---------------------------------------------------------------------
  ! @ public
  !
  ! IMAGER
  !
  ! Compute the MODEL UV data set from the current CCT table
  !
  !     Uses an intermediate FFT with further interpolation for
  !     better speed than UV_CCT
  ! CAUTION
  !     Frequency (and hence Lambda/D) is assumed constant 
  !---------------------------------------------------------------------
  !
  integer, intent(in) :: nc                     ! Size of visibility
  integer, intent(in) :: nv                     ! Number of visibilities
  real, intent(inout) :: visi(nc,nv)            ! Visibilities
  integer, intent(in) :: nx                     ! X Size of image
  integer, intent(in) :: ny                     ! Y Size of image
  integer, intent(in) :: nf                     ! Number of frequencies
  complex, intent(in) :: a(nx,ny,nf)            ! Clean Component Image
  real(8), intent(in) :: freq                   ! Reference frequency
  real(8), intent(in) :: xinc                   ! X Pixel increment
  real(8), intent(in) :: yinc                   ! Y Pixel increment
  real, intent(in) :: factor                    ! Flux scale factor
  ! Local
  real(kind=8), parameter :: clight=299792458d0
  real(kind=8) :: kwx,kwy,stepx,stepy,lambda,bfin(2),xr,yr
  complex(kind=8) :: aplus,amoin,azero,afin
  integer :: i,if,ia,ja
  logical :: inside
  equivalence (afin,bfin)
  !
  lambda = clight/(freq*1d6)
  stepx = 1.d0/(nx*xinc)*lambda
  stepy = 1.d0/(ny*yinc)*lambda
  !
  ! Loop on visibility
  do i = 1, nv
    kwx =  visi(1,i) / stepx + dble(nx/2 + 1)
    kwy =  visi(2,i) / stepy + dble(ny/2 + 1)
    ia = int(kwx)
    ja = int(kwy)
    inside = (ia.gt.1 .and. ia.lt.nx) .and.   &
        &      (ja.gt.1 .and. ja.lt.ny)
    if (inside) then
      xr = kwx - ia
      yr = kwy - ja
      do if=1,nf
        !
        ! Interpolate (X or Y first, does not matter in this case)
        aplus = ( (a(ia+1,ja+1,if)+a(ia-1,ja+1,if)   &
            &          - 2.d0*a(ia,ja+1,if) )*xr   &
            &          + a(ia+1,ja+1,if)-a(ia-1,ja+1,if) )*xr*0.5d0   &
            &          + a(ia,ja+1,if)
        azero = ( (a(ia+1,ja,if)+a(ia-1,ja,if)   &
            &          - 2.d0*a(ia,ja,if) )*xr   &
            &          + a(ia+1,ja,if)-a(ia-1,ja,if) )*xr*0.5d0   &
            &          + a(ia,ja,if)
        amoin = ( (a(ia+1,ja-1,if)+a(ia-1,ja-1,if)   &
            &          - 2.d0*a(ia,ja-1,if) )*xr   &
            &          + a(ia+1,ja-1,if)-a(ia-1,ja-1,if) )*xr*0.5d0   &
            &          + a(ia,ja-1,if)
        ! Then Y (or X)
        afin = ( (aplus+amoin-2.d0*azero)   &
            &          *yr + aplus-amoin )*yr*0.5d0 + azero
        !
        visi(5+3*if,i) =  bfin(1)*factor
        ! There was a - sign in the precedent version
        visi(6+3*if,i) =  bfin(2)*factor
      enddo
    else
      print *,'Error Visi ',i,ia,nx,ja,ny
    endif
  enddo
end subroutine do_uvmodel
!<FF>
subroutine do_fft (nx,ny,nf,fft,work)
  integer, intent(in)  :: nx                     !
  integer, intent(in)  :: ny                     !
  integer, intent(in)  :: nf                     !
  complex, intent(inout) :: fft(nx,ny,nf)
  real, intent(inout)  :: work(2*max(nx,ny))
  ! Local
  integer :: if,dim(2)
  !
  ! Loop on channels
  dim(1) = nx
  dim(2) = ny
  do if = 1, nf
    call fourt(fft(:,:,if),dim,2,1,1,work)
    call recent(nx,ny,fft(:,:,if))
  enddo
end subroutine do_fft
!<FF>
subroutine copyuv (nco,nv,out,nci,in)
  !---------------------------------------------------------------------
  ! @ public
  !
  ! IMAGER
  !
  ! Copy structure of UV data, but not the (Real,Imag) columns
  !---------------------------------------------------------------------
  integer, intent(in)  :: nco                    ! Size of output visi.
  integer, intent(in)  :: nv                     ! Number of visibilities
  real, intent(out)  :: out(nco,nv)              ! Output Visibilities
  integer, intent(in) :: nci                     ! Size of input visi.
  real, intent(in)  :: in(nci,nv)                ! Input visibilities
  ! Local
  integer :: i,j
  !
  ! This does not handle extra columns
  do i=1,nv
    out(1:7,i) = in(1:7,i)
    do j=8,nco,3
      out(j,i) = 0
      out(j+1,i) = 0
      out(j+2,i) = in(10,i)
    enddo
  enddo
end subroutine copyuv
!
subroutine cct_def_image (hima,mx,my,nf,freq,xinc,yinc,error)
  use image_def
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !
  ! Define Image size from CCT information.
  ! Supports both layouts of CCT tables.
  !---------------------------------------------------------------------
  type (gildas), intent(in) :: hima
  integer, intent(out) :: mx,my,nf
  real(8), intent(out) :: freq
  real(8), intent(out) :: xinc,yinc
  logical, intent(out) :: error
  !
  error = .false.
  if (hima%char%code(3).eq.'COMPONENT') then
    call gagout('I-UV_FCCT,  Clean Components from IMAGER')
    nf = hima%gil%dim(2)  ! Number of channels
    mx = (hima%gil%ref(1)-1)*2
    xinc = hima%gil%inc(1)
    my = (hima%gil%ref(3)-1)*2
    yinc = hima%gil%inc(3)
    ! Define observing frequency
    freq = hima%gil%freq + hima%gil%fres*((nf+1)*0.5-hima%gil%ref(2))
  else
    call gagout('I-UV_FCCT,  Clean Components from Task CLEAN')
    nf = hima%gil%dim(3)
    mx = (hima%gil%ref(1)-1)*2
    xinc = hima%gil%inc(1)
    my = (hima%gil%ref(2)-1)*2
    yinc = hima%gil%inc(2)
    freq = hima%gil%freq + hima%gil%fres*((nf+1)*0.5-hima%gil%ref(3))
  endif
end subroutine cct_def_image
!
subroutine cct_set_image (hcct,clean,mx,my,mc,xinc,yinc,nf,image,error)
  use image_def
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !
  ! Fill an Image from the list of Clean Components 
  !---------------------------------------------------------------------
  type (gildas), intent(in) :: hcct
  real clean(hcct%gil%dim(1),hcct%gil%dim(2),hcct%gil%dim(3))
  integer, intent(in) :: mx,my,nf
  integer, intent(in) :: mc
  real(8), intent(in) :: xinc,yinc
  real, intent(out) :: image(mx,my,nf)
  logical, intent(out) :: error
  !
  integer lc,nc,kc
  integer ic,jf
  integer ix,iy
  character(len=80) :: mess
  !
  image = 0
  if (hcct%char%code(3).eq.'COMPONENT') then
    lc = hcct%gil%dim(1)
    nc = hcct%gil%dim(2)  ! Number of channels
    if (nc.ne.nf) then
      write(mess,*) 'Channel mismatch ',nc,nf
      call map_message(seve%e,'MODEL',mess)
      error = .true.
      return
    endif
    if (mc.eq.0) then
      kc = hcct%gil%dim(3)  ! Number of components
    else
      kc = min(mc,hcct%gil%dim(3))
    endif
    !
    do jf = 1,nf
      do ic = 1,kc
        if (clean(3,jf,ic).ne.0) then
          ix = nint(clean(1,jf,ic)/xinc)+mx/2+1
          iy = nint(clean(2,jf,ic)/yinc)+my/2+1
          image(ix,iy,jf) = image(ix,iy,jf) + clean(3,jf,ic)
        else
          exit ! No more components for this channel
        endif
      enddo
    enddo
  else
    lc = hcct%gil%dim(1)
    if (mc.eq.0) then
      kc = hcct%gil%dim(2)  ! Number of components
    else
      kc = min(mc,hcct%gil%dim(2))
    endif
    nc = hcct%gil%dim(3)
    if (nc.ne.nf) then
      write(mess,*) 'Channel mismatch ',nc,nf
      call map_message(seve%e,'MODEL',mess)
      error = .true.
      return
    endif
    do jf = 1,nf
      do ic = 1,kc
        if (clean(1,ic,jf).ne.0) then
          ix = nint(clean(2,ic,jf))
          iy = nint(clean(3,ic,jf))
          image(ix,iy,jf) = image(ix,iy,jf) + clean(1,ic,jf)
        else
          exit ! No more components for this channel
        endif
      enddo
    enddo
  endif
end subroutine cct_set_image
!
subroutine mod_fft_size(large,mx,my,nx,ny)
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Define the intermediate FFT size
  !---------------------------------------------------------------------
  logical, intent(in) :: large
  integer, intent(in) :: mx,my
  integer, intent(out) :: nx,ny
  !
  integer :: kx,ky
  real :: rx,ry
  !
  if (large) then
    rx = log(float(mx))/log(2.0)
    kx = nint(rx)
    if (kx.lt.rx) kx = kx+1
    nx = 2**kx
    ry = log(float(my))/log(2.0)
    ky = nint(ry)
    if (ky.lt.ry) ky = ky+1
    ny = 2**ky
    kx = max(nx,ny)
    kx = min(4*kx,4096)
    kx = max(mx,kx)
    kx = max(my,kx)
    nx = kx
    ny = kx
  else
    nx = mx
    ny = my
  endif
end subroutine mod_fft_size
