subroutine cct_merge(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
  !----------------------------------------------------------------------
  ! @ 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'
  !
  integer(kind=address_length) :: ipx, ipy, ipz, addr
  integer(kind=4), save :: memory(2)
  type (sic_descriptor_t) :: desc
  type (gildas) :: hx, hy, hz
  real, allocatable :: dx(:,:,:), dy(:,:,:), dz(:,:,:)
  logical :: x_image, y_image, z_image, found, rdonly
  integer :: i, j, ny, nz, nchan, ier
  !
  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
  !
  if (hy%gil%dim(2).ne.hz%gil%dim(2)) then
    call map_message(seve%e,rname,'Input Clean Component Tables do not match')
    error = .true.
    return
  endif  
  !
  ! Allocate the arrays if needed. 
  !
  ! Get the Z data pointer
  if (z_image) then
    ipz = gag_pointer(hz%loca%addr,memory)
  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
    addr = locwrd(dz)
    ipz = gag_pointer(addr,memory)
    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
    ipy = gag_pointer(hy%loca%addr,memory)
  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
    addr = locwrd(dy)
    ipy = gag_pointer(addr,memory)
    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 (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
    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 
    addr = hx%loca%addr
    ipx = gag_pointer(addr,memory)
    ! But update the Header locally
    call gdf_copy_header(hy,hx,error)
    hx%loca%addr = addr ! This is overwritten ?..
  else
    x_image = .false.
    ! This is  a file, we must create it
    call gdf_copy_header(hy,hx,error)
    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
    addr = locwrd(dx)
    ipx = gag_pointer(addr,memory)
  endif
  !
  ! Do the actual job
  ny = hy%gil%dim(3)
  nz = hz%gil%dim(3)
  nchan = hz%gil%dim(2)
  call sub_cct_collect (nchan,ny,nz,   &     ! Sizes
    & memory(ipx),memory(ipy),memory(ipz) )  ! 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
!
subroutine sub_cct_collect(nchan,ny,nz,x,y,z)
  integer, intent(in) :: nchan
  integer, intent(in) :: ny
  integer, intent(in) :: nz
  !
  real, intent(in) :: y(3,nchan,ny)
  real, intent(in) :: z(3,nchan,nz)
  real, intent(out) :: x(3,nchan,ny+nz)
  !
  integer :: i,j,mx
  !
  x = 0.
  x(1:3,1:nchan,1:ny) = y
  !
  ! Loop on channels
  do i=1,nchan
    ! Concatenate at first null component
    mx = nz
    do j=1,nz
      if (x(3,i,j).eq.0) then
        mx = j
        exit
      endif
    enddo
    x(1:3,i,mx:mx+nz-1) = z(1:3,i,1:nz)
  enddo
end subroutine sub_cct_collect
!
subroutine cct_convert(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
!
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
!
