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 [/MINVAL Value [Unit]]
  !
  ! Dispatch to adequate routine 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
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  if (last_resid.eq.'CCT') then
    call cct_fast_uvmodel(line,error)
  else
    call uvfit_residual_model(line,'MODEL',error)
  endif
end subroutine uv_model_comm
!
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 [/MINVAL Value [Unit]]
  !
  ! 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
  ! 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
  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 (perhaps we should
  ! extract only one channel ?)
  !     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
    call map_message(seve%e,rname,'More than 1 channel')
    error = .true.
    return
  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.
    goto 999
  endif
  call cct_set_image (hcct,dcct,mx,my,nclean,xinc,yinc,nf,dmap,error)
  !
  ! Retrieve minimum value
  narg = sic_narg(1)  ! /MINVAL option
  if (narg.ge.0) then
    call sic_r4(line,1,1,fmin,.true.,error)
    if (error) return
    !
    if (narg.gt.1) then
      call sic_ch(line,1,2,chain,nc,.true.,error)
      if (error) return
      if (chain(1:nc).eq.'sigma') then
        fmin = fmin * max(hclean%gil%noise,hclean%gil%rms)
      elseif (chain(1:nc).eq.'mJy') then
        fmin = 1e-3*fmin
      elseif (chain(1:nc).eq.'K') then
        area = 8*log(2.0)*pi*hclean%gil%majo*hclean%gil%mino
        jyperk = 1.38e3*area/(299792458d0/freq*1d-6)**2
        fmin = fmin * jyperk 
      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.
  endif
  !
  !! pixel_area = abs(xinc*yinc)   ! in radian
  !
  !
  ! Define the image size
  !
  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
    call gag_cpu(cpu1)
  else
    nx = mx
    ny = my
  endif
  !
  ! 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')
    goto 999
  endif
  !
  ! See UV_RESTORE also...
  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')
    goto 999
  endif
  !
  ! 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')
  call gdf_copy_header(huv,huvm,error) ! Will work in all cases
  !
  ! 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
  !! factor = 2*1.38e3/lambda**2*pixel_area
  !! print *,'Factor ',factor,pixel_area
  !! if (factor.eq.0.0) factor = 1.0
  !
  ! We are in Jy, so this is simple
  factor = 1.0
  !
  huvm%gil%dim(1) = 7+3*nf
  huvm%gil%ref(1)  = 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')
    goto 999
  endif
  nt = huvm%gil%dim(1)
  nv = huvm%gil%dim(2)
  mt = huv%gil%dim(1)
  !!Print *,'NT NV MT ',nt,nv,mt
  !!Print *,'DUV ',ubound(duv,1), ubound(duv,2)
  !!Print *,'DUVM ',ubound(duvm,1), ubound(duvm,2)
  !
  ! At this stage, we could extract the relevant channel
  call copyuv (nt,nv,duvm,mt,duv)
  !
  ! OK, compute the model
  call do_uvmodel(duvm, nt, nv,   &
       &    fft,nx,ny,nf,freq,xinc,yinc,factor)
  !
  call gag_cpu(cpu1)
  error = .false.
  return
  !
999 error = .true.
  return
end subroutine cct_fast_uvmodel
!<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
    do j=1,7
      out(j,i) = in(j,i)
    enddo
    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
  !---------------------------------------------------------------------
  ! @ 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
!
