!
subroutine cct_write(file,error)
  use gkernel_interfaces
  use clean_def
  use clean_arrays
  use gbl_message
  use imager_interfaces, only : map_message
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER --  Support routine for command  
  !   WRITE CCT File [/RANGE Start End Kind]
  !!
  !----------------------------------------------------------------------
  character(len=*), intent(in) :: file  
  !! Input file name
  logical, intent(out) :: error         
  !! Error return code
  !
  ! Local ---
  type (gildas) :: hout, htmp
  integer :: mclean,ier,i,j
  logical :: new
  !
  ! Code ----
  error = .false.
  !
  ! Define the Output image header
  call gildas_null (hout, type = 'IMAGE')
  call gdf_copy_header (hcct,hout, error)
  !
  ! Count the actual number of components
  hout%file = file
  mclean = hout%gil%dim(3)
  do i=1,hout%gil%dim(3)
    if (all(dcct(:,:,i).eq.0)) then
      mclean = i-1
      exit
    endif
  enddo
  !
  ! Write data
  hout%blc = 0
  hout%trc = 0
  hout%gil%dim(3) = max(mclean,1)  ! At least one (possibly empty) component
  hout%loca%size = product(hout%gil%dim(1:3))
  !
  new = .false.
  call sic_get_logi('CCT_NEW',new,error)
  if (.not.new) then
    call gdf_write_image(hout,dcct(:,:,1:mclean),error)
    return
  endif
  call map_message(seve%w,'WRITE CCT','Writing transposed version (CCT_NEW = YES)')
  !
  call gildas_null(htmp,type='IMAGE')
  call gdf_transpose_header(hout,htmp,'1324',error)
  htmp%file = file 
  htmp%gil%dim(1) = 4
  allocate(htmp%r3d(htmp%gil%dim(1),htmp%gil%dim(2),htmp%gil%dim(3)),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,'WRITE CCT','Memory allocation error')
    error = .true.
    return
  endif
  do i=1,htmp%gil%dim(2) 
    do j=1,htmp%gil%dim(3)
      htmp%r3d(1:3,i,j) = dcct(:,j,i)
    enddo
  enddo
  call gdf_write_image(htmp,htmp%r3d,error)
  deallocate(htmp%r3d)
  !
end subroutine cct_write

subroutine cct_append(file,data,head,mgap,error)
  use gkernel_interfaces
  use clean_def
  use clean_arrays
  use gbl_message
  use imager_interfaces, only : map_message
  !-------------------------------------------------------
  ! @ private
  !*
  ! IMAGER - Support routine for WRITE CCT /APPEND
  !!
  !-------------------------------------------------------
  character(len=*), intent(in) :: file    
  !! File name
  type(gildas), intent(inout) :: head     
  !! Header of buffer
  real(kind=4), intent(in) :: data(:,:,:) 
  !! Data
  integer, intent(in) :: mgap             
  !! Max Gap size
  logical, intent(inout) :: error         
  !! Error return flag
  !
  ! Local ---
  type(gildas) :: hall
  integer :: i, ier, mclean, imin, imax, igap
  real, allocatable :: dinp(:,:,:), dout(:,:,:)
  integer :: inchan, inclean, onchan, onclean
  !
  ! Code ----
  error = .false.
  !
  if (head%loca%size.eq.0) then
    call map_message(seve%e,'WRITE','CCT data undefined ')
    error = .true.
    return
  endif
  !
  ! Read old file header
  call gildas_null(hall, type='IMAGE')
  hall%file = file
  call gdf_read_header(hall,error)
  if (error) return
  !
  ! Check match with specified input set
  call gdf_match_header(head,hall,mgap,imin,imax,igap,error)
  if (error) then
    call gdf_close_image(hall,error)
    return
  endif
  !
  inclean = hall%gil%dim(3) ! Current Number of input Clean Component
  mclean = head%gil%dim(3)
  do i=1,head%gil%dim(3)
    if (all(dcct(:,:,i).eq.0)) then
      mclean = i-1
      exit
    endif
  enddo
  onclean = max(inclean,mclean) ! Number of clean components
  onclean = max(1,onclean)      ! At least 1 (possibly empty) component
  !
  ! Resize array to new dimension
  onchan = imax+igap
  inchan = hall%gil%dim(2)      ! Current number of channels
  allocate(dout(3,onchan,onclean), & 
    & dinp(hall%gil%dim(1),hall%gil%dim(2),hall%gil%dim(3)),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,'WRITE','Memory allocation error')
    call gdf_close_image(hall,error)
    error = .true.
    return
  endif
  !
  ! Set everything to Zero
  dout = 0.0
  ! Put old one in place
  hall%blc= 0
  hall%trc= 0
  call gdf_read_data(hall,dinp,error)
  dout(1:3,1:inchan,1:inclean) = dinp(:,:,:)
  deallocate(dinp)
  ! Close image
  call gdf_close_image(hall,error)
  ! Put new one in place  
  dout(1:3,imin+igap:onchan,1:mclean) = data(:,:,1:mclean)
  !
  ! Write everything
  hall%gil%dim(1:3) = [3,onchan,onclean]
  hall%blc = 0
  hall%trc = 0
  call gdf_write_image(hall,dout(:,:,:),error)
end subroutine cct_append
!
subroutine gdf_match_header(hinp,hout,mgap,imin,imax,igap,error)
  use gkernel_types
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message
  !-------------------------------------------------------
  ! @ private
  !*
  !  IMAGER -- Support routine for WRITE /APPEND  
  ! Verify axis compatibility and return first new channel. 
  ! The routine is generic for CCT and Cubes.
  !-------------------------------------------------------
  type(gildas), intent(in) :: hinp    
  !! CCT or Cube to be appended
  type(gildas), intent(in) :: hout    
  !! Output CCT or Cube
  integer, intent(in) :: mgap         
  !! Allowed Gap in channels
  integer, intent(out) :: igap        
  !! Actual Gap in channels
  integer, intent(out) :: imin        
  !! Start channel 
  integer, intent(out) :: imax        
  !! End channel
  logical, intent(out) :: error       
  !! Logical Error flag
  !
  ! Constants
  real(8), parameter :: tolerance=2d-7
  real(8), parameter :: epsilon=1d-5
  character(len=*), parameter :: rname='WRITE /APPEND'
  !
  ! Local ---
  character(len=128) :: chain
  integer :: faxi,xaxi,yaxi
  integer :: itmp
  real(8) :: velo, rval
  !
  ! Code ----
  faxi = hinp%gil%faxi
  if (faxi.ne.hout%gil%faxi) then
    call map_message(seve%e,rname,'Data set ordering does not match')
    error = .true.
    return
  endif
  error = .false.
  xaxi = hinp%gil%xaxi
  yaxi = hinp%gil%yaxi
  !
  ! At this stage, verify the consistency check
  ! (spectral resolution, pixel sizes, gap size)
  if ( any(hout%gil%convert(:,xaxi).ne.hinp%gil%convert(:,xaxi)) .or. &
    any(hout%gil%convert(:,yaxi).ne.hinp%gil%convert(:,yaxi)) ) then
    call map_message(seve%e,rname,'Positions do not match')
    Print *,'Hinp ',hinp%gil%convert(:,1:3)
    Print *,'Hout ',hout%gil%convert(:,1:3)
    Print *,'X Difference ',hinp%gil%convert(:,xaxi)-hout%gil%convert(:,xaxi)
    Print *,'Y Difference ',hinp%gil%convert(:,yaxi)-hout%gil%convert(:,yaxi)
    error = .true.
  endif
  !
  if (abs (abs(hinp%gil%inc(faxi))-abs(hout%gil%inc(faxi))) & 
    & .ge.tolerance*abs(hout%gil%inc(faxi)) ) then
    call map_message(seve%e,rname,'Frequency resolution do not match')
    error = .true.
  endif
  if (error) return
  !
  ! Check which range in the file is needed - Match the velocities
  velo = (1.d0-hinp%gil%ref(faxi))*hinp%gil%inc(faxi) + hinp%gil%val(faxi)
  rval = (velo-hout%gil%val(faxi))/hout%gil%inc(faxi) + hout%gil%ref(faxi)
  imin = nint(rval)
  !
  if (abs(dble(imin)-rval).gt.epsilon*abs(hinp%gil%inc(faxi))) then
    call map_message(seve%e,rname,'Frequency axis does not match')
    error = .true.
  endif
  if (error) return
  !
  ! Compute channel alignment
  velo = (hinp%gil%dim(faxi)-hinp%gil%ref(faxi))*hinp%gil%inc(faxi) + hinp%gil%val(faxi)
  rval = (velo-hout%gil%val(faxi))/hout%gil%inc(faxi) + hout%gil%ref(faxi)
  imax = nint(rval)
  if (imin.gt.imax) then
    itmp = imin
    imin = imax
    imax = itmp
  endif
  !
  ! Tolerate a 1 channel error overlap, but no big gap
  igap = imin - hout%gil%dim(faxi)
  if (igap.ne.0 .and. igap.ne.1) then
    Print *,'Dimensions ',hinp%gil%dim(faxi), hinp%gil%dim(faxi)+1, imin, imax
    write(chain,'(A,A,I0,A,I0)') 'CCT',' is not contiguous, starts at ',imin, &
      & ' current end at ',hinp%gil%dim(faxi)
    if (igap.gt.0.and.igap.lt.mgap) then
      call map_message(seve%w,rname,chain)
      write(chain,'(A,I0,A)') 'Creating ',igap-1,' empty channels in between'
      call map_message(seve%w,rname,chain)
    else
      call map_message(seve%e,rname,chain)
      if (igap.ge.mgap) call map_message(seve%e,rname,'Gap size exceeded')
      error = .true.
      return
    endif
  else
    igap = 0 ! Even if 1 channel overlap
  endif
  !
end subroutine gdf_match_header
!
subroutine cct_read(nc,head,error)
  use gkernel_interfaces
  use imager_interfaces, only : map_range, map_message
  use gbl_message
  use clean_arrays
  use clean_types
  !-------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support routine for READ CCT [/RANGE Min Max Type]
  !
  ! Supports any type of CCT Table
  !!
  !-------------------------------------------------------
  integer, intent(in) :: nc(2)          
  !! Channel range
  type(gildas), intent(inout) :: head   
  !! CCT Header
  logical, intent(inout) :: error       
  !! Error flag
  !
  ! Local ---
  integer :: ier,i,j,ni
  type(gildas) :: htmp
  !
  ! Code ----
  save_data(code_save_cct) = .false.
  call sic_delvariable ('CCT',.false.,error)
  if (allocated(dcct)) deallocate(dcct,stat=ier)
  !
  if (head%char%code(2).ne."COMPONENT") then
    ! Conforming organization - Simple read, with a subset
    ! specified through call to "map_range"
    call gdf_copy_header(head,hcct,error)
    error = map_range(nc,head,hcct)
    if (error) return
    hcct%loca = head%loca
    allocate(dcct(hcct%gil%dim(1),hcct%gil%dim(2),   &
     &        hcct%gil%dim(3)),stat=ier)
    call gdf_read_data(head,dcct,error)
    if (error) return
    !
  else  
    ! Transposed organization - Contiguous read, and in memory
    ! transposition, as CCT Tables are small
    call gildas_null(htmp,type='IMAGE')
    call gdf_copy_header(head,htmp,error)
    error = map_range(nc,head,htmp)
    if (error) return
    allocate(htmp%r3d(htmp%gil%dim(1),htmp%gil%dim(2),htmp%gil%dim(3)), &
      & dcct(hcct%gil%dim(1),hcct%gil%dim(2),hcct%gil%dim(3)),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,'READ CCT','Memory allocation error')
      error = .true.
      return
    endif
    call gdf_read_data(head,htmp%r3d,error)
    if (error) return
    !
    call gdf_transpose_header(htmp,hcct,'132',error)
    ni = min(hcct%gil%dim(1),htmp%gil%dim(1)) ! Ensure no overflow 
    do i=1,htmp%gil%dim(2) 
      do j=1,htmp%gil%dim(3)
        dcct(1:ni,j,i) = htmp%r3d(1:ni,i,j) 
      enddo
    enddo
    deallocate(htmp%r3d)
  endif
  !
  call sic_mapgildas ('CCT',hcct,error,dcct)
end subroutine cct_read
