subroutine remisajour (nxy,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) :: nxy      ! Problem size
  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
  !
  integer i,j,k,ndim,nn(2),ip
  !
  ndim = 2
  nn(1) = nx
  nn(2) = ny
  if (np.eq.1) then
    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
    !
    ! 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 soustraire (wcl,ncl,        &
     &    dirty,nx,ny,ixbeam,iybeam,   &
     &    ixpatch,iypatch,kcl,gain,    &
     &    nf, primary, weight, wtrun)
  use clean_def
  !----------------------------------------------------------------------
  ! @ public
  !
  ! IMAGER  
  !    CLEAN   Internal routine
  ! Subtract the clean component, convolved with dirty beam
  ! restricted to beam patch, from the list of selected points.
  ! Smaller beam patches yield faster speed, but somewhat larger errors and
  ! thus slower convergence.
  !
  ! Caution : points must be ordered according I and J. In the current
  !   IMAGER implementation, this is done by routine "choice"
  ! The code cannot be parallelized, since it uses explicitely the ordering
  ! of the I and J values to stop exploring beyond the beam patch.
  !----------------------------------------------------------------------
  integer, intent(in) :: nf                   ! Number of fields
  integer, intent(in) :: ncl                  ! nombre de points retenus
  integer, intent(in) :: nx,ny,ixbeam,iybeam  ! dimension et centre du beam
  real, intent(in) :: dirty(nx,ny,nf)         ! Dirty Beam
  integer, intent(in) :: ixpatch,iypatch      ! taille du centre BEAM retenu
  type(cct_par), intent(inout) :: wcl(ncl)
  integer, intent(in) :: kcl                  ! No de la composante introduite
  real, intent(in) :: gain                    ! gain de clean
  real, intent(in) :: primary (nf,nx,ny)      ! Primary beams
  real, intent(in) :: weight (nx,ny)          ! Effective weights on sky
  real, intent(in) :: wtrun
  !
  integer, external :: ompget_inner_threads
  logical, external :: ompget_debug_code
  !
  logical condi,condj,cond,go_on     ! pour les boucles de soustraction
  integer no                   ! No du point courrant
  real f                       ! coefficient a retrancher
  integer k,l
  ! dans la carte du beam translatee sur la composante
  integer l0,k0                ! translation * du beam % a la composante
  integer i0,j0, i,j, if, fo, lo, ithread, nthread
  !
  ! Subtract current component
  i0 = wcl(kcl)%ix
  j0 = wcl(kcl)%iy
  k0 = i0 - ixbeam
  l0 = j0 - iybeam
  f = gain * wcl(kcl)%influx
  wcl(kcl)%influx = wcl(kcl)%influx - f      ! This property is always true
  if (nf.gt.1) then
    f = f * weight(i0,j0)      ! Convert to Clean Component
  else
    f = f / dirty(ixbeam,iybeam,1)
  endif
  !
  lo = kcl + 1
  fo = kcl - 1
  go_on = .true.
  ! Subtract from current component to last valid.
  ! Loop CANNOT be parallelized
  do no = lo,ncl
    if (go_on) then
      i = wcl(no)%ix
      j = wcl(no)%iy
      k = i-k0
      l = j-l0
      condi = abs(k-ixbeam) .lt. ixpatch
      condj = abs(l-iybeam) .lt. iypatch
      cond  = condi .or. condj
      if (.not.cond) then
        go_on = .false.
      else
        !
        if ( (condi.and.condj) .and. (k.gt.0 .and. k.le.nx)   &
         &      .and. (l.gt.0 .and. l.le.ny) ) then
          if (nf.gt.1) then
            do if = 1,nf
              if (primary(if,i,j).gt.wtrun) then
                wcl(no)%influx = wcl(no)%influx - f*dirty(k,l,if)   &
         &              *primary(if,i0,j0)*primary(if,i,j)   &
         &              *weight(i,j)
              endif
            enddo
          else
            wcl(no)%influx = wcl(no)%influx - f*dirty(k,l,1)
          endif
        endif
      endif
    endif
  enddo
  !
  go_on = .true.
  ! Now subtract from first valid to current component
  do no = fo,1,-1
    if (go_on) then
      i = wcl(no)%ix
      j = wcl(no)%iy
      k = i-k0
      l = j-l0
      condi = abs(k-ixbeam) .lt. ixpatch
      condj = abs(l-iybeam) .lt. iypatch
      cond  = condi .or. condj
      if (.not.cond) then
        go_on = .false.
      else
        !
        if ( (condi.and.condj) .and. (k.gt.0 .and. k.le.nx)   &
         &      .and. (l.gt.0 .and. l.le.ny) ) then
          if (nf.gt.1) then
            do if = 1,nf
              if (primary(if,i,j).gt.wtrun) then
                wcl(no)%influx = wcl(no)%influx - f*dirty(k,l,if)   &
         &              *primary(if,i0,j0)*primary(if,i,j)   &
         &              *weight(i,j)
              endif
            enddo
          else
            wcl(no)%influx = wcl(no)%influx - f*dirty(k,l,1)
          endif
        endif
      endif
    endif
  enddo
end subroutine soustraire
!
subroutine comshi (beam,nx,ny,ix,iy,shift)
  use gbl_message
  use imager_interfaces, only : map_message
  !-----------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   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
  !
  real tol
  !
  ! 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
    call map_message(seve%w,'SHIFT','Unknown beam symmetry')
    shift(1) = 0
    shift(2) = 0
    shift(3) = 0
  endif
end subroutine comshi
!
subroutine domima(a,rmi,rma,imi,ima,n)
  !----------------------------------------------------------
  ! @ public
  !
  ! MAPPING
  !   Compute minmax and location
  !----------------------------------------------------------
  integer, intent(in) :: n
  integer, intent(out) :: ima,imi
  real, intent(in) ::  a(n)
  real, intent(inout) :: rmi,rma
  !
  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)
  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
  !
  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
  !
  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
!
