subroutine cct_merge_comm(line,error)
  use gkernel_interfaces
  use gkernel_types
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !
  !   IMAGER  Support for command 
  !
  ! CCT_MERGE OutFile In1 In2 
  !
  !     Merge two Clean Component Tables.
  !---------------------------------------------------------------------
  character(len=*), intent(inout) :: line ! Command line
  logical, intent(out) :: error
  ! global
  character(len=*), parameter :: rname='CCT_MERGE'
  ! Local
  character(len=filename_length) :: table_out, namey, namez
  integer :: n
  !------------------------------------------------------------------------
  ! Code:
  error = .false.
  !
  ! Names from Command line
  call sic_ch(line,0,3,namez,n,.true.,error)
  if (error) return
  call sic_ch(line,0,2,namey,n,.true.,error)
  if (error) return
  !
  call sic_ch(line,0,1,table_out,n,.true.,error)
  if (error) return
  !
  call cct_combine(table_out,namey,namez,error)
  !
contains
!
subroutine cct_combine(namex,namey,namez,error)
  use imager_interfaces, only : sub_readhead, map_message
  use gkernel_types
  use gkernel_interfaces
  use gbl_message
  use iso_c_binding
  !----------------------------------------------------------------------
  ! @ private
  !
  !   IMAGER  Support routine for command
  !
  ! CCT_MERGE  Out In1 In2 
  !     Combine two input Clean Component Tables
  !
  !  Out can be a file name or an existing Image variable. 
  !   The distinction is made by the existence of a "." in the name
  !   If it is a file, it is created like the In1 Variable. 
  !   If it is an Image variable, it must match the number
  !   of channels of the In1 Variable, and  be large enough 
  !   to handle the total number of components.
  !        
  !   In1 and In2 can be file names or existing Image variables.
  !   They must match in terms of number of channels.
  !----------------------------------------------------------------------
  character(len=*), intent(inout) :: namex ! Output file
  character(len=*), intent(inout) :: namey ! Input file 1
  character(len=*), intent(inout) :: namez ! Input file 2
  logical, intent(out) :: error
  !
  character(len=*), parameter :: rname='CCT_MERGE'
  !
  type(c_ptr) :: cptr
  type (sic_descriptor_t) :: desc
  type (gildas) :: hx, hy, hz
  real, pointer :: dx(:,:,:), dy(:,:,:), dz(:,:,:)
  logical :: x_image, y_image, z_image, found, rdonly
  integer :: ier, iline
  !
  error = .true.
  !
  n = len_trim(namez)
  if (n.eq.0) return
  n = len_trim(namex)
  if (n.eq.0) return
  n = len_trim(namey)
  if (n.eq.0) return
  error = .false.
  !
  z_image = .false.
  call sub_readhead (rname,namez,hz,z_image,error,rdonly,fmt_r4,'.cct')
  if (error) return
  call cct_check(hz,error)
  if (error) then
    call map_message(seve%e,rname,trim(namez)//' is not a Clean Component Table')
    return
  endif
  !
  y_image = .false.
  call sub_readhead (rname,namey,hy,y_image,error,rdonly,fmt_r4,'.cct')
  if (error) return  
  call cct_check(hy,error)
  if (error) then
    call map_message(seve%e,rname,trim(namey)//' is not a Clean Component Table')
    return
  endif
  !
  iline = 1
  if (hy%gil%dim(2).ne.hz%gil%dim(2)) then
    if ((hy%gil%dim(2).eq.1).or.(hz%gil%dim(2).eq.1)) then
      call map_message(seve%w,rname,'Merging a Continuum and a Line Clean Component Table')
      if (hy%gil%dim(2).eq.1) iline = 2
    else  
      call map_message(seve%e,rname,'Input Clean Component Tables have different number of channels')
      error = .true.
      return
    endif
  endif  
  !
  ! Allocate the arrays if needed. 
  !
  ! Get the Z data pointer
  if (z_image) then
    call adtoad(hz%loca%addr,cptr,1)
    call c_f_pointer(cptr,dz,hz%gil%dim(1:3))
  else
    allocate(dz(hz%gil%dim(1),hz%gil%dim(2),hz%gil%dim(3)),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation error')
      error = .true.
      return
    endif
    call gdf_read_data(hz,dz,error)
    call gdf_close_image(hz,error) ! I do not need it anymore
  endif
  !
  ! Get the Y data pointer
  if (y_image) then
    call adtoad(hy%loca%addr,cptr,1)
    call c_f_pointer(cptr,dy,hy%gil%dim(1:3))
  else
    allocate(dy(hy%gil%dim(1),hy%gil%dim(2),hy%gil%dim(3)),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation error')
      error = .true.
      return
    endif
    call gdf_read_data(hy,dy,error)
    call gdf_close_image(hy,error) ! I do not need it anymore
  endif
  !
  ! Now handle the Output 
  call gildas_null(hx)
  if (index(namex,'.').eq.0) then 
    x_image = .true.
    ! This must be an existing SIC Image variable
    rdonly = .false.
    call sub_readhead (rname,namex,hx,x_image,error,rdonly,fmt_r4)
    if (error) return
    !
    call cct_check(hx,error)
    if (error) then
      call map_message(seve%e,rname,trim(namex)//' is not a Clean Component Table')
      return
    endif
    !
    ! With a conforming shape 
    if (iline.eq.1) then
      if (hx%gil%dim(2).ne.hy%gil%dim(2)) then
        call map_message(seve%e,rname,'Output SIC variable does not match Input data shape')
        error = .true.
        return
      endif
    else
      if (hx%gil%dim(2).ne.hz%gil%dim(2)) then
        call map_message(seve%e,rname,'Output SIC variable does not match Input data shape')
        error = .true.
        return
      endif
    endif
    !
    if (hx%gil%dim(3).le.(hy%gil%dim(3)+hz%gil%dim(3))) then
      call map_message(seve%e,rname,'Output SIC variable is too small')
      error = .true.
      return
    endif
    !
    ! OK, they match 
    call adtoad(hx%loca%addr,cptr,1)
    call c_f_pointer(cptr,dx,hx%gil%dim(1:3))
    ! But update the Header locally
    call gdf_copy_header(hy,hx,error)
  else
    x_image = .false.
    ! This is  a file, we must create it
    if (iline.eq.1) then
      call gdf_copy_header(hy,hx,error)
    else
      call gdf_copy_header(hz,hx,error)
    endif
    hx%gil%dim(3) = hy%gil%dim(3)+hz%gil%dim(3)
    call sic_parsef(namex,hx%file,' ','.cct')
    hx%gil%extr_words = 0
    hx%gil%blan_words = 2
    allocate(dx(3,hx%gil%dim(2),hx%gil%dim(3)),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation error')
      error = .true.
      return
    endif
  endif
  !
  ! Do the actual job
  call sub_cct_collect (hx%gil%dim(2),hy%gil%dim(2),hz%gil%dim(2), &   ! Sizes and
    & hy%gil%dim(3),hz%gil%dim(3), dx, dy, dz )                        ! Data arrays
  !
  ! Write ouput file
  if (.not.x_image) then
    call gdf_write_image(hx,dx,error)
  else
    ! Update the original SIC variable header
    call sic_descriptor(namex,desc,found)
    call gdf_copy_header(hx,desc%head,error)  
  endif
  !
end subroutine cct_combine
!
subroutine cct_check(hz,error)
  use image_def
  !---------------------------------------------------------------------
  ! @ public
  ! Check input Header is that of a Clean Component Table
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: hz  ! Header to be checked
  logical, intent(out) :: error   ! Error return
  !
  ! CCTs have dim  (3,nchan,mcct)
  if (hz%gil%dim(1).ne.3 .or. hz%char%code(3).ne.'COMPONENT' .or. hz%gil%faxi.ne.2) then
    error = .true.
  else
    error = .false.
  endif
end subroutine cct_check
!  
end subroutine cct_merge_comm
! 
! Things that should not have interfaces
!
subroutine sub_cct_collect(ncx,ncy,ncz,ny,nz,x,y,z)
  use gildas_def
  integer(kind=address_length), intent(in) :: ncx, ncy, ncz
  integer(kind=address_length), intent(in) :: ny
  integer(kind=address_length), intent(in) :: nz
  !
  real, intent(in) :: y(3,ncy,ny)
  real, intent(in) :: z(3,ncz,nz)
  real, intent(out) :: x(3,ncx,ny+nz)
  !
  integer :: i,j,k,mx
  !
  x = 0.
  if (ncy.eq.1) then
    ! Concatenate at first null component
    mx = ny
    do j=1,ny
      if (y(3,1,j).eq.0) then
        mx = j
        exit
      endif
    enddo
    !
    ! Loop on channels
    do i=1,ncx
      x(1:3,i,1:mx) = y(1:3,1,1:mx)
      x(1:3,i,mx:mx+nz-1) = z(1:3,i,1:nz)
    enddo
  else
    ! Concatenate at first null component
    mx = nz
    do j=1,nz
      if (z(3,1,j).eq.0) then
        mx = j
        exit
      endif
    enddo
    !
    ! Loop on channels
    do i=1,ncx
      x(1:3,i,1:mx) = z(1:3,1,1:mx)
      x(1:3,i,mx:mx+ny-1) = y(1:3,i,1:ny)
    enddo
  endif
end subroutine sub_cct_collect
!
subroutine cct_convert_comm(line,error)
  use gkernel_interfaces
  use clean_def
  use clean_arrays
  use clean_types
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER    Support for command 
  !
  !         CCT_CONVERT [Threshold]
  !
  !   Convert the CLEAN image into the CCT table
  !
  !     Theshold is the minimum (asbolute value of) flux per pixel 
  !   retained. Default is 0
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  character(len=*), parameter :: rname='CCT_CONVERT'
  !
  integer :: i, imax, nx, ny, nc
  integer :: ic, ix, iy, ier
  real :: flux, minclean
  !
  if (hclean%loca%size.eq.0) then
    call map_message(seve%w,rname,'No CLEAN image')
    error = .true.
    return
  endif
  !
  ! Delete the CCT 
  save_data(code_save_cct) = .false.
  call sic_delvariable ('CCT',.false.,error)
  error = .false.
  if (allocated(dcct)) deallocate(dcct,stat=ier)
  !
  minclean = 0.0
  if (len_trim(line).ne.0) then
    call sic_r4(line,0,1,minclean,.false.,error)
  endif
  !
  call gdf_copy_header(hclean, hcct, error)
  !
  hcct%gil%ndim = 3
  hcct%char%unit = 'Jy'
  !
  hcct%gil%dim(1) = 3
  ! Keep the same axis description
  hcct%gil%xaxi = 1
  !
  hcct%gil%convert(:,2) = hclean%gil%convert(:,3)
  hcct%gil%convert(:,3) = hclean%gil%convert(:,2)
  hcct%gil%dim(2) = hclean%gil%dim(3)
  hcct%char%code(2) = hclean%char%code(3)
  hcct%gil%faxi = 2
  hcct%char%code(3) = 'COMPONENT'
  hcct%gil%yaxi = 3
  hcct%loca%size = 3*hcct%gil%dim(2)*hcct%gil%dim(3)
  !
  ! Initialize BLCs...
  hcct%blc = 0
  hcct%trc = 0
  !
  !
  ! First pass to determine Number of Clean Components
  imax = 0
  nc = hclean%gil%dim(3)
  nx = hclean%gil%dim(1)
  ny = hclean%gil%dim(2)
  do ic=1,nc
    i = 0
    do iy=1,ny
      do ix=1,nx
        if (abs(dclean(ix,iy,ic)).gt.minclean) i=i+1
      enddo
    enddo
    imax = max(i,imax)
  enddo
  !
  hcct%gil%dim(3) = max(imax,1)  ! Must have one Clean component at least
  allocate(dcct(3,nc,imax),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  !
  dcct = 0. ! Just in case
  flux = 0
  do ic=1,nc
    i = 0
    flux = 0
    do iy=1,ny
      do ix=1,nx
        if (abs(dclean(ix,iy,ic)).gt.minclean) then
          i = i+1
          dcct(1,ic,i) = (dble(ix) -   &
           & hclean%gil%convert(1,1)) * hclean%gil%convert(3,1) + &
           & hclean%gil%convert(2,1)
          dcct(2,ic,i) = (dble(iy) -   &
           & hclean%gil%convert(1,2)) * hclean%gil%convert(3,2) + &
           & hclean%gil%convert(2,2)
          dcct(3,ic,i) = dclean(ix,iy,ic)
          flux = flux+dclean(ix,iy,ic)
        endif
      enddo
    enddo
  enddo
  !
  hcct%loca%size = hcct%gil%dim(2)*hcct%gil%dim(3)*3
  hcct%loca%addr = locwrd(dcct)
  !
  call sic_mapgildas ('CCT',hcct,error,dcct)
end subroutine cct_convert_comm
!
subroutine cct_to_clean(method,hclean,clean,tcc)
  use clean_def
  use image_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Build clean image from Component List
  !---------------------------------------------------------------------
  type (clean_par), intent(inout) :: method    ! Clean method parameters
  type (gildas), intent(inout) :: hclean       ! Clean header
  real, intent(inout) :: clean(hclean%gil%dim(1),hclean%gil%dim(2))
  type (cct_par), intent(in) :: tcc(method%n_iter)  ! Clean components
  !
  integer nx,ny,nc,ix,iy,ic
  real flux
  !
  if (method%method.eq.'SDI'.or.method%method.eq.'MULTI') return
  !
  nx = hclean%gil%dim(1)
  ny = hclean%gil%dim(2)
  clean = 0.0
  nc = method%n_iter
  !
  ! Convolve source list into residual map ---
  if (method%bshift(3).eq.0) then
    do ic=1,nc
      ix = tcc(ic)%ix
      iy = tcc(ic)%iy
      clean(ix,iy) = clean(ix,iy) + tcc(ic)%value
    enddo
  else
    do ic=1,nc
      flux = 0.5*tcc(ic)%value
      ix = tcc(ic)%ix
      iy = tcc(ic)%iy
      clean(ix,iy) = clean(ix,iy) + flux
      ix = ix+method%bshift(1)
      iy = iy+method%bshift(2)
      clean(ix,iy) = clean(ix,iy) + flux
    enddo
  endif
end subroutine cct_to_clean
!
subroutine cct_mask_comm(line,error)
  use gkernel_interfaces
  use clean_def
  use clean_arrays
  use clean_types
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER    Support for command 
  !
  !         CCT_MASK  or rather MASK APPLY CCT
  !
  !   Apply the MASK to the CCT table
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  character(len=*), parameter :: rname='MASK APPLY CCT'
  character(len=120) :: chain
  integer, allocatable :: list(:)
  integer :: nc, ic, iter, niter, liter, iplane, jplane, ix, iy
  !
  !
  !!Print *,'Mask rank ',hmask%gil%ndim,hmask%gil%dim(1:3)
  nc = hcct%gil%dim(2)
  allocate (list(nc))
  !
  if (hmask%gil%dim(3).le.1) then
    list(:) = 1
  else if (hmask%gil%dim(3).ne.hcct%gil%dim(2)) then
    write(chain,'(A,I0,A,I0)') 'Mismatched number of channels between MASK',hmask%gil%dim(3),' and CCT ',hcct%gil%dim(2)
    call map_message(seve%e,rname,chain)
    error = .true.
    return
  else
    if (any(hcct%gil%convert(1:3,2).ne.hmask%gil%convert(1:3,3))) then
      call map_message(seve%e,rname,'Frequency axis mismatch')
      error = .true.
      return
    endif
    do ic=1,nc
      list(ic) = ic
    enddo      
  endif
  !
  ! Verify matching in Pixels 
  if ( (any(hcct%gil%convert(1:3,1).ne.hmask%gil%convert(1:3,1))) &
    &   .or. any(hcct%gil%convert(1:3,3).ne.hmask%gil%convert(1:3,2))) then
    call map_message(seve%e,rname,'Pixel size mismatch')
    error = .true.
    return
  endif
  !
  do iplane=1,nc
    jplane = list(iplane)
    niter = hcct%gil%dim(3)     ! Do not forget initialization
    !
    do iter=1,hcct%gil%dim(3)   ! Max number of iterations
      if (dcct(3,iplane,iter).eq.0) then
        niter = iter-1
        exit
      endif
      !
      ix = (dcct(1,iplane,iter)-hcct%gil%val(1))/hcct%gil%inc(1) + hcct%gil%ref(1) 
      iy = (dcct(2,iplane,iter)-hcct%gil%val(3))/hcct%gil%inc(3) + hcct%gil%ref(3) 
      if (ix.ge.1 .and. ix.le.hmask%gil%dim(1) .and. iy.ge.1 .and. iy.le.hmask%gil%dim(2)) then
        if (dmask(ix,iy,jplane).eq.0) dcct(3,iplane,iter) = 0
      endif
    enddo
    !
    ! OK, list may be with Empty Holes, compact it
    liter = 1
    do iter = 1,niter
      if (dcct(3,iplane,iter).ne.0) then
        if (iter.gt.liter) then
          dcct(:,iplane,liter) = dcct(:,iplane,iter)
          liter = liter+1
        endif
      endif
    enddo
    ! Zero the remainder
    if (liter+1.le.niter) then
      dcct(:,iplane,liter+1:niter) = 0
    endif
    !
  enddo
  !
end subroutine cct_mask_comm
!
subroutine cct_clean_comm(line,error)
  use gkernel_interfaces
  use clean_def
  use clean_arrays
  use clean_types
  use gbl_message
  use imager_interfaces, except_this => cct_clean_comm
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER    Support for command 
  !
  !         CCT_CLEAN [MaxIter]
  !
  !   Convert the CCT table into the CLEAN image
  !
  !     MaxIter is the last iteration retained.
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  character(len=*), parameter :: rname='CCT_CLEAN'
  !
  real, allocatable, target :: ccou(:,:,:)
  integer, allocatable :: omic(:), nmic(:)
  integer :: maxic, ic,lc, icmax, oic, olc, ier
  integer :: nthread, ithread, nchan
  logical :: debug
  real(8) :: elapsed_s, elapsed_e, elapsed
  character(len=80) :: chain
  character(len=12) :: old_method
  !
  error = .false.
  if (.not.allocated(dcct)) then
    call map_message(seve%w,rname,'No CCT Table')
    error = .true.
  endif
  if (.not.allocated(dclean)) then
    call map_message(seve%w,rname,'No CLEAN image')
    error = .true.
  endif
  !
  nchan = hcct%gil%dim(2) 
  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.hclean%gil%dim(3)) then
    write(chain,'(A,I0,A,I0,A)') 'Number of channels in CCT [', &
    & hcct%gil%dim(2),'] and in CLEAN [',hclean%gil%dim(3),'] do not match'
    call map_message(seve%e,rname,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,rname,'Memory allocation error')
    error = .true.
    return
  endif
  !
  ! Compact the Clean components first
  call gdf_print_header(hcct)
  !
  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
  dclean = 0 
  !
  if (icmax.eq.0) then
    call map_message(seve%w,rname,'No valid Clean Component')
    return
  endif  
  !
  ! Spatially compress the Clean Component List
  oic = ic    ! This must be 1
  olc = lc    ! This must be nchan
  !
  allocate(ccou(3,icmax,nchan),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'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
  !
  ! OK, now do the job
  ! Use the Full Clean Component list size
  hclean%r3d => dclean
  if (debug) Print *,'generate_clean ',nchan,omic,ic,lc
  old_method = method%method
  method%method = 'UV_RESTORE'
  method%bshift = 0
  call generate_clean(method,hclean,ic,lc,ccou,nmic)
  method%method = old_method
  !
  ! Delete the CLEAN
  call sic_delvariable ('CLEAN',.false.,error)
  save_data(code_save_clean) = .false.
  call sic_mapgildas ('CLEAN',hclean,error,dclean)
end subroutine cct_clean_comm
!
