subroutine compresswcl(wcl,ncl)
  use clean_def
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- CLEAN   Internal routine!
  !   Compress list of component in (cct_par) format
  !!
  !----------------------------------------------------------------------
  integer, intent(inout) :: ncl          !! Number of clean components
  type(cct_par), intent(inout) :: wcl(*) !! Clean component list
  !
  ! Local
  integer :: i,mcl
  !
  ! Code
  mcl = 1
  do i=2,ncl
    if (wcl(i)%value.ne.0) then
      mcl = mcl+1
      if (mcl.ne.i) then
        wcl(mcl) = wcl(i)
      endif
    endif
  enddo
  !
  if (mcl.lt.ncl) then
    wcl(mcl+1)%ix = 0
    wcl(mcl+1)%iy = 0
    wcl(mcl+1)%value= 0
  endif
  ncl = mcl
end subroutine compresswcl
!
subroutine remisajour (clean,resid,tfbeam,fcomp,   &
     &    wcl,ncl,nx,ny,wfft,   &
     &    np,primary,weight,wtrun)
  use gkernel_interfaces, only : fourt
  use clean_def
  use clean_default
  !----------------------------------------------------------------------
  ! @ public
  !*
  ! IMAGER --  CLEAN   Internal routine
  !
  !   Subtract last major cycle components from residual map.
  !!
  !----------------------------------------------------------------------
  integer, intent(in) :: nx,ny    !! Problem size
  integer, intent(in) :: ncl      !! Number of clean components
  integer, intent(in) :: np       !! Number of primary beams
  type(cct_par), intent(in) :: wcl(ncl)   !! Clean component list
  real, intent(in) :: tfbeam(nx,ny,np)    !! TF of dirty beams
  complex, intent(inout) :: fcomp(nx,ny)  !! Work area
  real, intent(inout) :: clean(nx,ny)     !! Clean map
  real, intent(inout) :: resid(nx,ny)     !! Residual map
  real, intent(in) :: primary(np,nx,ny)   !! Primary beams
  real, intent(in) :: weight(nx,ny)       !! Flat field weights
  real, intent(in) :: wtrun               !! Truncation of mosaic
  real, intent(in) :: wfft(*)             !! work fft area
  !
  ! Local ---
  integer i,j,k,ndim,nn(2),ip
  !
  ! Code ----
  ndim = 2
  !
  ! One could compress in place the Clean Component List
  if (np.eq.1) then
    nn(1) = nx
    nn(2) = ny
    fcomp = 0.0
    do k = 1,ncl
      fcomp(wcl(k)%ix,wcl(k)%iy) = cmplx(wcl(k)%value,0.0)
    enddo
    call fourt(fcomp,nn,ndim,-1,0,wfft)
    fcomp = fcomp*tfbeam(:,:,1)
    call fourt(fcomp,nn,ndim,1,1,wfft)
    resid = resid-real(fcomp)
  else
    ! This may change later, when using smaller dirty beams
    nn(1) = nx
    nn(2) = ny
    !
    ! Optimized by using CLEAN to store sum of components before multiplying
    ! by the weights to subtract from the Residuals
    clean = 0.0
    do ip=1,np
      fcomp = 0.0
      do k=1,ncl
        fcomp(wcl(k)%ix,wcl(k)%iy) = wcl(k)%value   &
     &          * primary(ip,wcl(k)%ix,wcl(k)%iy)
      enddo
      call fourt(fcomp,nn,ndim,-1,0,wfft)
      fcomp = fcomp*tfbeam(:,:,ip)
      call fourt(fcomp,nn,ndim,1,1,wfft)
      do j=1,ny
        do i=1,nx
          if (primary(ip,i,j).gt.wtrun) then
            clean(i,j) = clean(i,j) + real(fcomp(i,j))   &
     &              *primary(ip,i,j)
          endif
        enddo
      enddo
    enddo
    resid = resid - clean*weight
  endif
end subroutine remisajour
!
subroutine comshi (beam,nx,ny,ix,iy,shift)
  use gbl_message
  use imager_interfaces, only : map_message
  !-----------------------------------------------------
  ! @ private
  !
  ! IMAGER -- Shift beam if needed
  !-----------------------------------------------------
  integer, intent(in) :: nx,ny     !! X,Y Size
  integer, intent(in) :: ix,iy     !! Position of maximum
  real, intent(in) :: beam(nx,ny)  !! Beam
  integer, intent(out) :: shift(3) !! Shift information
  !
  ! Local ---
  real :: tol
  character(len=120) :: mess
  !
  ! Code
  ! Attempt to find where is the true maximum of the (SYMMETRIC) beam
  ! based on a fit by a parabola in 9 points around maximum
  !
  tol = 1e-4*beam(ix,iy)
  shift(3) = 1
  if (abs(beam(ix-1,iy-1)-beam(ix+1,iy+1)).lt.tol) then
    shift(1) = 0
    shift(2) = 0
    shift(3) = 0
  elseif (abs(beam(ix+1,iy+1)-beam(ix,iy)).lt.tol) then
    shift(1) = 1
    shift(2) = 1
  elseif (abs(beam(ix-1,iy-1)-beam(ix,iy)).lt.tol) then
    shift(1) = -1
    shift(2) = -1
  elseif (abs(beam(ix+1,iy-1)-beam(ix,iy)).lt.tol) then
    shift(1) =  1
    shift(2) = -1
  elseif (abs(beam(ix-1,iy+1)-beam(ix,iy)).lt.tol) then
    shift(1) = -1
    shift(2) = 1
  elseif (abs(beam(ix+1,iy-1)-beam(ix,iy+1)).lt.tol) then
    shift(1) = 1
    shift(2) = 0
  elseif (abs(beam(ix-1,iy-1)-beam(ix,iy+1)).lt.tol) then
    shift(1) = -1
    shift(2) = 0
  elseif (abs(beam(ix-1,iy-1)-beam(ix+1,iy)).lt.tol) then
    shift(1) = 0
    shift(2) = -1
  elseif (abs(beam(ix-1,iy+1)-beam(ix+1,iy)).lt.tol) then
    shift(1) = 0
    shift(2) = 1
  else
    !
    write(mess,*) 'No Beam symmetry NX NY ',nx,ny,' IX IY ',ix,iy
    call map_message(seve%w,'SHIFT',mess,seve%e)
    shift(1) = 0
    shift(2) = 0
    shift(3) = 0
  endif
end subroutine comshi
!
subroutine domima(a,rmi,rma,imi,ima,n)
  !----------------------------------------------------------
  ! @ public
  !!*
  ! IMAGER  --  Utility
  !
  !   Compute minmax and location
  !!
  !----------------------------------------------------------
  integer, intent(in) :: n        !! Problem size
  integer, intent(out) :: ima,imi !! Min Max positions
  real, intent(in) ::  a(n)       ! Values
  real, intent(inout) :: rmi,rma  ! Min Max values
  !
  integer :: i
  !
  ima = 0
  imi = 0
  if (a(1).gt.rma) then
    rma = a(1)
    ima = 1
  endif
  if (a(1).lt.rmi) then
    rmi = a(1)
    imi = 1
  endif
  do i=2,n
    if (a(i).gt.rma) then
      rma = a(i)
      ima = i
    elseif (a(i).lt.rmi) then
      rmi = a(i)
      imi = i
    endif
  enddo
end subroutine domima
!
subroutine progress_report(action,iv,nv,mv,percentage_step)
  !--------------------------------------------------------------
  ! @ public
  !
  !!   IMAGER  -- Utility: Printout progress report
  !--------------------------------------------------------------
  character(len=*), intent(in) :: action !! Action name
  integer, intent(in) :: iv    !! Current index
  integer, intent(in) :: nv    !! Number of values per block
  integer, intent(in) :: mv    !! Total number of values
  integer, intent(in) :: percentage_step !! Frequency of report
  !
  ! Local ---
  real, save :: next_percentage  ! Next report value
  integer, save :: next          ! Next report index
  integer :: nleft
  integer, save :: last_step     ! Current percentage step
  integer, save :: next_step     ! Next percentage step
  !
  ! Code ----
  if (iv.eq.1) then
    next_percentage = percentage_step
    next = nint((next_percentage*mv)/100.)
    next_step = percentage_step
    write(*,'(A)',ADVANCE="NO") trim(action)//' % '
  else
    last_step = next_step
    nleft = min(nv,mv-iv+1)
    !! Print *,'Iv ',iv,' Next ',next,' Nleft ',nleft 
    if (iv.lt.next.and.iv+nleft.ge.next) then
      if (last_step.eq.1) then
        if (next_percentage.ge.100.) then
          write(*,'(A)',ADVANCE="NO") ' 100.'
        else
          write(*,'(A)',ADVANCE="NO") '.'
        endif
      else
        write(*,'(F5.0)',ADVANCE="NO") next_percentage
      endif
      if (next_percentage.ge.95) then
        next_step = 1 
      else if (next_percentage.ge.90) then
        next_step = 5
      else
        next_step = percentage_step
      endif
      next_percentage = next_percentage+next_step 
      next = nint((next_percentage*mv)/100.)
    endif
  endif
end subroutine progress_report
!
