!
subroutine major_clark (rname,method,head,   &
     &    beam,beam_nx,beam_ny,nx,ny,clean,resid,tfbeam,fcomp,   &
     &    wcl,mcl,ixbeam,iybeam,ixpatch,iypatch,bgain,   &
     &    box, wfft, cct_list, list, nl, np, primary, weight,       &
     &    major_plot, next_flux)
  use imager_interfaces, except_this=>major_clark
  use clean_def
  use image_def
  use gbl_message
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER --  Support for CLARK command  
  !   Major cycle loop according to B.Clark idea
  !!
  !----------------------------------------------------------------------
  external :: major_plot                        !! Major cycle Display
  external :: next_flux                         !! Cumulative flux display
  !
  character(len=*), intent(in) :: rname         !! Calling command
  type (clean_par), intent(inout) :: method     !! Method parameters
  type (gildas), intent(in)  :: head            !! Data header
  integer, intent(in) :: nx                     !! X size
  integer, intent(in) :: ny                     !! Y size
  integer, intent(in) :: beam_nx,beam_ny        !! Beam size
  integer, intent(in) :: np                     !! Number of pointings
  integer, intent(in) :: mcl                    !! Maximum number of clean components
  real, intent(inout) :: clean(nx,ny)           !! Clean map
  real, intent(inout) :: resid(nx,ny)           !! Residual map
  real, intent(in) ::    beam(beam_nx,beam_ny,np)         !! Dirty beams (per pointing)
  real, intent(in) ::    tfbeam(nx,ny,np)       !! FT. of dirty beams
  complex, intent(inout) :: fcomp(nx,ny)        !! FT. of components 
  real, intent(in) :: bgain                     !! Maximum sidelobe level
  integer, intent(in) :: ixbeam, iybeam         !! Beam maximum position
  integer, intent(in) :: ixpatch, iypatch       !! Beam patch radius
  integer, intent(in) :: box(4)                 !! Cleaning box
  real, intent(inout) :: wfft(*)                !! Work space for FFT
  type(cct_lst), intent(inout) :: cct_list      !! Clean components array
  type(cct_par), intent(inout) :: wcl(mcl)      !! Work space for Clean components
  integer, intent(inout) :: list(nx*ny)         !! list of searchable pixels
  integer, intent(inout) :: nl                  !! Pixel list size
  real, intent(in) :: primary(np,nx,ny)         !! Primary beams
  real, intent(in) :: weight (nx,ny)            !! Flat field response
  !
  ! Local ---
  real    maxc,minc,maxabs     ! max and min of data, absolute max value
  real    lastabs              ! Check for oscillations
  integer imax,jmax,imin,jmin  ! coordinates of the Max and Min pixels
  real    borne                ! Fraction of initial data
  real    limite               ! Minimal intensity retained
  real    clarkl               ! Clark worry limit
  real flux                    ! Total clean flux density
  integer ncl                  ! Number of selected data points
  logical fini                 ! Stopping criterium 
  logical converge             ! Stop by flux convergence
  integer m_iter
  integer k, kcl
  character(len=message_length) :: chain
  !
  ! Code ----
  !
  ! Find maximum residual
  call maxlst (resid,nx,ny,list,nl, maxc,imax,jmax,minc,imin,jmin)
  !
  if (method%n_iter.lt.method%p_iter) then
    maxabs=abs(maxc)
  elseif ( abs(maxc).lt.abs(minc) ) then
    maxabs=abs(minc)
  else
    maxabs=abs(maxc)
  endif
  borne= max(method%fres*maxabs,method%ares)
  fini = maxabs.lt.borne
  !  method%n_iter= 0       ! This is now set in the Call Sequence to allow re-starting
  m_iter = method%m_iter
  if (method%m_iter.eq.0) then
    method%m_iter = 2**30  ! A Large enough number
  else
    method%m_iter = m_iter
  endif
  flux = 0.0
  !
  ! Major cycle
  k = 0
  do while (.not.fini)
    !
    ! Define minor cycle limit
    k = k+1
    write(chain,100) 'Major cycle ',k,' loop gain ',method%gain
    call map_message(seve%d,rname,chain)
    limite = max(maxabs*bgain,0.8*borne)
    clarkl = maxabs*bgain
    !
    kcl = mcl
    !
    ! Select points of maximum strength and load them in
    call choice (            &
     &      resid,           & ! Current residuals
     &      nx,ny,           & ! image size
     &      list, nl,        & ! Search list
     &      limite,          & ! Detection threshold
     &      kcl,             & ! Maximum number of candidates
     &      wcl,             & ! CCT
     &      ncl,             & ! Selected Number of components
     &      maxabs, method%ngoal)
    !
    if (ncl.gt.0) then
      write(chain,100) 'Selected ',ncl,' points above ',limite
      call map_message(seve%d,rname,chain)
      !
      ! Make minor cycles   ! Starting iteration ?
      call clark_minor (method,   &
     &        wcl,            &  ! CCT
     &        ncl,            &  ! Number of candidates
     &        beam,beam_nx,beam_ny,     &  ! Dirty beams and Size
     &        nx,ny,          &  ! Image size
     &        ixbeam,iybeam,  &  ! Beam center
     &        ixpatch,iypatch,&  ! Beam patch
     &        clarkl,limite,  &
     &        converge,       &  !
     &        cct_list,       &  ! Cumulated components
     &        np, primary, weight, method%trunca,   &
     &        flux,           &  ! Total Flux
     &        method%pflux, next_flux)
      !
      call compresswcl(wcl,ncl)
      !
      ! Remove all components by FT : RESID = RESID - BEAM # WCL(*,4)
      call remisajour (    &
     &        clean,       &    ! CLEAN map used as work space
     &        resid,       &    ! Updated residuals
     &        tfbeam,      &    ! Beam TF
     &        fcomp,       &    ! Work space for Component TF
     &        wcl,         &    ! CCT
     &        ncl,         &    ! Number of Clean Components
     &        nx,ny,       &    ! Map size
     &        wfft,        &    ! FFT work space
     &        np, primary, weight, method%trunca)
      write (chain,101)  'Cleaned ',flux,' Jy with ',method%n_iter,' clean components'
      call map_message(seve%i,rname,chain)
      !
      ! Find new extrema
      lastabs = maxabs
      call maxlst (resid,nx,ny,list,nl, maxc,imax,jmax,minc,imin,jmin)
      if (method%n_iter.lt.method%p_iter) then
        maxabs=abs(maxc)
      elseif ( abs(maxc).lt.abs(minc) ) then
        maxabs=abs(minc)
      else
        maxabs=abs(maxc)
      endif
      if (maxabs.gt.1.15*lastabs) then
        write(chain,'(a,1pg10.3,a,1pg10.3)') &
     &      'Detected beginning of oscillations',maxabs,' > ',lastabs
        call map_message(seve%w,rname,chain)
      endif
      !
      ! Check if converge
      fini = (maxabs.le.borne)   &
     &        .or. (method%m_iter.le.method%n_iter)   &
     &        .or. converge
    else
      ! No component found: finish...
      write(chain,101) 'No points selected above ',limite
      call map_message(seve%i,rname,chain)
      fini = .true.
    endif
    !
    ! Intermediate or final PLOT
    converge = fini
    call major_plot (method,head,              &
     &      converge,method%n_iter,nx,ny,np,   &
     &      cct_list%cc,clean,resid,weight)
    fini = converge
    !
    ! Limit number of major cycles...
    if (k.gt.method%n_major) fini = .true.
    !
  enddo
  method%m_iter = m_iter
  !
  ! End
  if (maxabs.le.borne) then
    call map_message(seve%i,rname,'Reached minimum flux density')
  elseif (method%m_iter.le.method%n_iter) then
    call map_message(seve%i,rname,'Reached maximum number of components')
  elseif (converge) then
    call map_message(seve%i,rname,'Reached minor cycle convergence')
  elseif (k.gt.method%n_major) then
    write(chain,'(I0)') method%n_major
    call map_message(seve%i,rname,'Reached maximum number of cycles '//chain)
  else
    call map_message(seve%i,rname,'End of transcendental causes')
  endif
  !
  100   format (a,i6,a,1pg10.3,a)
  101   format (a,1pg10.3,a,i7,a)
end subroutine major_clark
!
subroutine clark_minor (method, wcl, ncl,           &
     &    beam,beam_nx,beam_ny,nx,ny,ixbeam,iybeam,ixpatch,iypatch,   &
     &    clarkmin,limite,converge,   &
     &    cct_list, np, primary, weight, wtrun, cum, pflux, next_flux )
  use gkernel_interfaces
  use imager_interfaces, except_this=>clark_minor
  use clean_def
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- CLARK Internal routine  
  !   B.Clark minor cycles.
  !   Deconvolve as in standard clean a list of NCL points
  !   selected in the map until the residuals is less than CLARKMIN
  !!
  !----------------------------------------------------------------------
  external :: next_flux                         !! Cumulative flux display
  type (clean_par), intent(inout) :: method     !! Method parameters
  integer, intent(in) :: np                     !! Number of fields in mosaic
  integer, intent(in) :: ncl                    !! Number of pixels selected
  integer, intent(in) :: beam_nx,beam_ny        !! Beam size
  integer, intent(in) :: nx,ny,ixbeam,iybeam    !! Size and cente pixel of beam
  integer, intent(in) :: ixpatch,iypatch        !! Used size of beam
  real, intent(in) :: beam(beam_nx,beam_ny,np)  !! Dirty beams
  type(cct_par), intent(inout) :: wcl(*)        !! Clean components
  real, intent(in) :: clarkmin                  !! Stopping criterium for minor cycles
  real, intent(in) :: limite                    !! Clean Stopping criterium
  logical, intent(out) :: converge              !! Convergence indicator
  type (cct_lst), intent(inout) :: cct_list     !! Effective clean components
  real, intent(in) :: primary(np,nx,ny)         !! Primary beams of mosaics
  real, intent(in) :: weight(nx,ny)             !! Effective weights on sky
  real, intent(in) :: wtrun                     !! Threshold of primary beam
  real, intent(inout) :: cum                    !! Cumulative flux
  logical, intent(in) :: pflux                  !! Plot cumulative flux
  !
  ! Local ---
  real gain                    ! CLEAN gain 
  logical goon                 ! Continue after convergence
  integer kcl                  ! Current Clean component
  integer nomax, nomin         ! Clean component of Max and Min 
  real rmax, rmin, sign, cdif  ! current Max and Min 
  real worry, xfac             ! Conservative and speedup factor
  integer kiter
  integer :: dimcum            ! Flux convergence control
  real, allocatable :: oldcum(:)
  real f, bmax
  integer n,ier,i,jiter
  logical abor
  character(len=20) comm
  !
  ! Code ----
  dimcum = method%converge
  allocate(oldcum(max(1,dimcum)),stat=ier)
  if (ier.ne.0) then
    Print *,'Convergence array allocation error ',ier,dimcum
    return
  endif
  oldcum = cum
  !
  abor = .false.
  do i=1,ncl
    wcl(i)%value = 0.0
  enddo
  gain = method%gain
  !
  call maxcct (wcl,ncl,nomin,rmin,nomax,rmax)
  !
  ! Remember the sign if cumulative
  if (cum.gt.0) then
    sign = 1.0
  else if (cum.lt.0) then
    sign = -1.0
  else
    sign = 0.0
  endif
  !
  ! Identify the max, and set the sign if not already done
  if (method%n_iter.lt.method%p_iter) then
    kcl=nomax
    rmax=abs(rmax)
    sign = 1.0
  elseif (abs(rmin).gt.rmax) then
    kcl=nomin
    rmax=abs(rmin)
    if (sign.eq.0) sign = -1.0
  else
    kcl=nomax
    rmax=abs(rmax)
    if (sign.eq.0) sign = 1.0
  endif
  !
  converge = rmax.le.limite
  worry = 1.0
  xfac = (clarkmin/rmax)**method%spexp
  kiter = 0
  goon = (method%n_iter.lt.method%m_iter) .and. (.not.converge)
  bmax = beam(ixbeam,iybeam,1)
  !
  do while (goon)
    method%n_iter = method%n_iter + 1
    kiter = kiter + 1
    if (np.gt.1) then
      f = gain * wcl(kcl)%influx* weight(wcl(kcl)%ix,wcl(kcl)%iy)
    else
      f = gain / bmax * wcl(kcl)%influx
    endif
    !
    ! Store clean component list
    cum = cum+f
    if (pflux) call next_flux(method%n_iter,cum,0)
    !
    if (method%n_iter.ge.cct_list%max_size) call cct_list%reallocate()
    wcl(kcl)%value = wcl(kcl)%value + f
    cct_list%cc(method%n_iter)%value = f    ! Store as fractions of beam max
    cct_list%cc(method%n_iter)%ix = wcl(kcl)%ix
    cct_list%cc(method%n_iter)%iy = wcl(kcl)%iy
    cct_list%cc(method%n_iter)%size = 0.
    cct_list%cur_size = method%n_iter
    !
    ! Subtract from iterated values VCL
    call clark_soustraire (wcl,ncl,           &
     &      beam,beam_nx,beam_ny,nx,ny,ixbeam,iybeam,   &
     &      ixpatch,iypatch,kcl,gain,   &
     &      np,primary,weight,wtrun)
    !
    ! Find maximum again
    call maxcct (wcl,ncl,nomin,rmin,nomax,rmax)
    if (method%n_iter.lt.method%p_iter) then
      kcl=nomax
      rmax=abs(rmax)
    elseif (abs(rmin).gt.rmax) then
      kcl=nomin
      rmax=abs(rmin)
    else
      kcl=nomax
      rmax=abs(rmax)
    endif
    !
    ! B.CLARK Magic confidence factor
    worry = worry+xfac/float(kiter)
    !
    ! Check convergence
    abor = sic_ctrlc()
    goon = (rmax.gt.worry*clarkmin) .and. (rmax.gt.limite)   &
     &      .and. (method%n_iter.lt.method%m_iter)
    goon = goon .and. .not.abor
    if (dimcum.ne.0) then
      jiter = kiter-1 ! Not method%n_iter
      oldcum(mod(jiter,dimcum)+1) = cum
      if (jiter.ge.dimcum) then
        cdif = cum-oldcum(mod(jiter+1,dimcum)+1)
        converge = sign*cdif.lt.0.0
        goon = goon .and. .not.converge
      endif
    endif
  enddo
  !
  if (abor) then
    comm = ' '
    call sic_wprn('I-CLARK,  Enter last valid component ',comm,n)
    if (n.eq.0) return
    n = len_trim(comm)
    if (n.eq.0) return
    read(comm(1:n),*,iostat=ier) method%n_iter
    if (ier.ne.0) return
    converge = .true. ! It must be converged
    cct_list%cur_size = method%n_iter
  endif
end subroutine clark_minor
!
subroutine clark_soustraire (wcl,ncl,        &
     &    dirty,beam_nx,beam_ny,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) :: beam_nx,beam_ny      !! dimension du beam
  integer, intent(in) :: ixbeam,iybeam        !! centre du beam
  integer, intent(in) :: nx,ny                !! dimension des images
  real, intent(in) :: dirty(beam_nx,beam_ny,nf)    !! Dirty Beam
  integer, intent(in) :: ixpatch,iypatch      !! Beam patcj size
  type(cct_par), intent(inout) :: wcl(ncl)    !! Clean component list
  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                   !! Weight truncation
  !
  ! Local ---
  logical condi,condj,cond     ! 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 i0,j0, i,j, if, fo, lo, up, st, iloop
  !
  ! Code ----
  !
  ! Subtract current component
  !
  ! In large map pixels
  i0 = wcl(kcl)%ix
  j0 = wcl(kcl)%iy
  !
  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
  ! Loop CANNOT be parallelized
  do iloop = 1,2
    if (iloop.eq.1) then
      ! Subtract from current component to last valid.
      lo = kcl+1
      up = ncl
      st = 1
    else
      ! Now subtract from first valid to current component
      lo = kcl-1
      up = 1
      st = -1
    endif
    do no = lo,up,st
      i = wcl(no)%ix
      j = wcl(no)%iy
      k = i-i0
      l = j-j0
      condi = abs(k) .lt. ixpatch
      condj = abs(l) .lt. iypatch
      cond  = condi .or. condj
      if (.not.cond) exit
      !
      if (condi.and.condj) then
        k = k+ixbeam
        l = l+iybeam
        !
        if ( (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
    enddo
  enddo
  !
end subroutine clark_soustraire
!
