
subroutine major_cycle90 (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_cycle90
  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%i,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%i,rname,chain)
      !
      ! Make minor cycles   ! Starting iteration ?
      call minor_cycle90 (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_cycle90
!
subroutine minor_cycle90 (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=>minor_cycle90
  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 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 minor_cycle90
!
subroutine major_sdi90 (rname,method,head,clean,beam,resid,nx,ny,   &
     &    tfbeam,fcomp,wcl,mcl,ixbeam,iybeam,ixpatch,iypatch,bgain,   &
     &    box, wfft, comp, list, nl, np, primary, weight, &
     &    major_plot )
  use imager_interfaces, except_this=>major_sdi90
  use clean_def
  use image_def
  use gbl_message
  use gkernel_interfaces, only : sic_ctrlc
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- CLEAN  Method SDI  
  ! Major cycle loop according to Steer Dewdney and Ito idea
  !!
  !----------------------------------------------------------------------
  external :: major_plot                        !! Plotting routine
  character(len=*), intent(in) :: rname         !! Caller name
  type (clean_par), intent(inout) :: method     !! Deconvolution method parameterss
  type (gildas), intent(in)  :: head            !! Data header
  integer, intent(in) :: np                     !! Number of fields
  integer, intent(in) :: nx                     !! X size
  integer, intent(in) :: ny                     !! Y size
  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(nx,ny,np)         !! Dirty beams (per field)
  real, intent(in) ::    tfbeam(nx,ny,np)       !! FT. of beams
  complex, intent(inout) :: fcomp(nx,ny)        !! FT of component list
  type(cct_par), intent(inout) :: wcl(mcl)      !! Work space for Clean 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
  integer, intent(inout) :: list(nx*ny)         !! list of searchable pixels
  integer, intent(inout) :: nl                  !! List size
  real, intent(inout) :: comp(nx,ny)            !! Clean components array
  real, intent(in) :: primary(np,nx,ny)         !! Primary beams
  real, intent(in) :: weight (nx,ny)            !! Flat field array
  !
  ! Local ---
  real    maxc,minc,maxabs     ! max and min of data, absolute max value
  integer imax,jmax,imin,jmin  ! coordinates of the Max and Min pixels
  real    borne                ! Fraction of initial data
  real    limite               ! Minimal intensity retained
  real flux                    ! Total clean flux density
  integer ncl                  ! Number of selected data points
  logical fini                 ! Stopping criterium 
  logical converge             ! Stop by flux convergence
  integer k
  real factor                  ! Scaling factor
  character(len=message_length) :: chain
  type (cct_par) :: tcc(1)     ! Dummy argument for Major_PLOT
  real :: sign, cdif
  integer :: dimcum, jiter
  real, allocatable :: oldcum(:)
  !
  ! Code ----
  dimcum = min(8,method%n_major/2)
  allocate (oldcum(dimcum))
  !
  ! Find maximum residual
  call maxlst (resid,nx,ny,list,nl, maxc,imax,jmax,minc,imin,jmin)
  sign = 1
  if (method%n_iter.lt.method%p_iter) then
    maxabs=abs(maxc)
  elseif ( abs(maxc).lt.abs(minc) ) then
    maxabs=abs(minc)
    sign = -1.0    
  else
    maxabs=abs(maxc)
  endif
  oldcum = 0
  !
  borne= max(method%fres*maxabs,method%ares)
  fini = maxabs.lt.borne
  !   method%n_iter= 0      ! Set at Call sequence
  flux = 0.0
  !
  ! Initialize clean components
  comp = 0.0
  !
  ! Major cycle
  !
  converge = .false.
  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%i,rname,chain)
    limite = max(maxabs*bgain,0.8*borne)
    !
    ! 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
     &      mcl,         &      ! Maximum number of candidates
     &      wcl,         &      ! Selected candidate components
     &      ncl,         &      ! Selected Number of components
     &      maxabs, 0)
    !
    if (ncl.gt.0) then
      write(chain,100) 'Selected ',ncl,' points above ',limite
      call map_message(seve%i,rname,chain)
      !
      ! No minor cycles. Compute scaling factor
      call normal (   &
     &        fcomp,       &    ! Work space for Component TF
     &        tfbeam,      &    ! Beam TF
     &        nx,ny,       &    ! image size
     &        wcl,         &    ! Selected candidate components
     &        ncl,         &    ! Selected Number of components
     &        wfft,        &    ! FFT work space
     &        factor)
      ! !Print *,'Done NORMAL '
      !
      ! Compute Clean Components
      factor = method%gain*maxabs/factor
      call scalec (wcl,          &    ! Selected candidate components
     &        ncl,factor,flux,   &
     &        comp, nx, ny)
      ! !Print *,'Done SCALEC '
      method%n_iter = method%n_iter+ncl
      !
      ! Remove all components by FT : RESIDU = RESIDU - 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,         &    ! Clean components
     &        ncl,         &    ! Number of Clean Components
     &        nx,ny,       &    ! Map size
     &        wfft,        &    ! FFT work space
     &        np, primary, weight, method%trunca)
      ! !Print *,'Done REMISAJOUR '
      write (chain,101)  'Cleaned ',flux,' Jy with ',   &
     &        method%n_iter,' clean components'
      call map_message(seve%i,rname,chain)
      !
      ! Find new extrema
      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 (dimcum.ne.0) then
        jiter = k   ! The Major Loop counter 
        oldcum(mod(jiter,dimcum)+1) = flux
        if (jiter.ge.dimcum) then
          cdif = flux-oldcum(mod(jiter+1,dimcum)+1)
          converge = sign*cdif.lt.0.0
          if (.not.converge) then
            if (abs(cdif/flux).lt.1E-3) converge = .true.
          endif
        endif
      endif
      ! Check if converge
      fini = (maxabs.le.borne)             &
     &        .or. (k.gt.method%n_major)   &
     &        .or. converge
    else
      write(chain,101) 'No point selected above ',limite
      fini = .true.
      call map_message(seve%i,rname,chain)
    endif
    !
    ! Intermediate or final PLOT
    converge = fini
    clean(:,:) = comp               ! Use CLEAN as work space to plot it
    ! !Print *,'Doing MAJOR_PLOT '
    call major_plot (method,head,              &
     &      converge,method%n_iter,nx,ny,np,   &
     &      tcc,clean,resid,weight)
    ! !Print *,'Done MAJOR_PLOT '
    fini = converge
    !
    if (sic_ctrlc()) exit
  enddo
  !
  ! End
  if (maxabs.le.borne) then
    write(chain,100) 'Reached minimum flux density '
  elseif (k.ge.method%n_major) then
    write(chain,100) 'Reached maximum number of cycles'
  elseif (converge) then
    write(chain,100) 'Reached flux convergence'
  else
    write(chain,100) 'End of transcendental causes'
  endif
  call map_message(seve%i,rname,chain)
  !
  ! Store the result
  clean(:,:) = comp
  !
  100   format (a,i0,a,1pg11.4,a)
  101   format (a,1pg11.4,a,i0,a)
end subroutine major_sdi90
!
subroutine normal (fcomp,tfbeam,nx,ny, wcl,ncl,wfft,factor)
  use gkernel_interfaces, only : fourt
  use clean_def
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER  --  CLEAN Method SDI  
  ! Subtract last major cycle components from residual map.
  !!
  !----------------------------------------------------------------------
  integer, intent(in) :: nx               !! X size
  integer, intent(in) :: ny               !! Y size
  integer, intent(in) :: ncl              !! Number of clean components
  type(cct_par), intent(in) :: wcl(ncl)   !! Clean components
  real, intent(in) :: tfbeam(nx,ny)       !! FT. of beam
  complex, intent(out) :: fcomp(nx,ny)    !! FT. of clean components
  real, intent(inout) :: wfft(*)          !! Work array
  real, intent(out) :: factor             !! Max of clean
  !
  ! Local ---
  integer i,j,k,ndim,nn(2)
  !
  ! Code ----
  fcomp = 0.0
  do k=1,ncl
    fcomp(wcl(k)%ix,wcl(k)%iy) = cmplx(wcl(k)%influx,0.0)
  enddo
  ndim = 2
  nn(1) = nx
  nn(2) = ny
  call fourt(fcomp,nn,ndim,-1,0,wfft)
  fcomp = fcomp*tfbeam
  call fourt(fcomp,nn,ndim,1,1,wfft)
  factor = abs(real(fcomp(1,1)))
  do j=1,ny
    do i=1,nx
      factor = max(factor,abs(real(fcomp(i,j))))
    enddo
  enddo
end subroutine normal
!
subroutine scalec(wcl,ncl,f,s,compon,nx,ny)
  use clean_def
  !----------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER  -- CLEAN Method SDI  
  ! Subtract last major cycle components from residual map.
  !!
  !----------------------------------------------------------------------
  integer, intent(in) :: nx               !! X size
  integer, intent(in) :: ny               !! Y size
  integer, intent(in) :: ncl              !! Number of clean components
  type(cct_par), intent(inout) :: wcl(ncl)  !! Clean components
  real, intent(in) :: f                   !! Gain factor
  real, intent(inout) :: s                !! Cumulative flux
  real, intent(inout) :: compon(nx,ny)    !! Cumulative clean component
  !
  ! Local ---
  integer i
  !
  ! Code ----
  do i=1,ncl
    wcl(i)%value = wcl(i)%influx*f
    s = s+wcl(i)%value
    compon(wcl(i)%ix,wcl(i)%iy) = compon(wcl(i)%ix,wcl(i)%iy) + wcl(i)%value
  enddo
end subroutine scalec
!
subroutine hogbom_cycle90 (rname,pflux, beam,mx,my,resid,nx,ny,               &
     &    ixbeam,iybeam, box, fracres, absres, miter, piter, niter,          &
     &    gainloop, converge, cct_list, start_iter, msk, list, nl, np, primary, weight, wtrun, &
     &    cflux, jcode, next_flux)
  use gkernel_interfaces
  use imager_interfaces, except_this=>hogbom_cycle90
  use clean_def
  use clean_default
  use gbl_message
  use omp_control
  !$ use omp_lib
  !----------------------------------------------------------------------
  ! @ private-mandatory
  !*
  ! IMAGER  -- CLEAN Method HOGBOM  
  !     Deconvolve map into residual map and source list
  !-----------------------------------------------------------------------
  external :: next_flux                         !! Cumulative flux display
  character(len=*), intent(in) :: rname         !! Calling command
  logical, intent(in) :: pflux                  !! Plot cumulative flux ?
  integer, intent(in) :: mx                     !! X size of beam
  integer, intent(in) :: my                     !! Y size of beam
  integer, intent(in) :: nx                     !! X size of image
  integer, intent(in) :: ny                     !! Y size of image
  integer, intent(in) :: np                     !! Number of fields
  real, intent(in) :: beam(mx,my,np)            !! Primary beam(s)
  real, intent(inout) :: resid(nx,ny)           !! residual image
  real, intent(in) :: fracres                   !! Fractional residual
  real, intent(in) :: absres                    !! Absolute residual
  integer, intent(inout) :: miter               !! Maximum number of clean components
  integer, intent(in) :: ixbeam, iybeam         !! Beam maximum position
  integer, intent(in) :: box(4)                 !! Cleaning box
  real, intent(in) :: gainloop                  !! Clean loop gain
  integer, intent(in) :: converge               !! Convergence iteration number 
  integer, intent(out) :: niter                 !! Resulting number of Iterations
  integer, intent(in) :: piter                  !! Positive Iterations
  logical, intent(in) :: msk(nx,ny)             !! Mask for clean search
  integer, intent(in) :: nl                     !! Size of search list
  integer, intent(in) :: list(nl)               !! Search list
  real, intent(in) :: primary(np,nx,ny)         !! Primary beams
  real, intent(in) :: weight(nx,ny)             !! Weight function
  real, intent(in) :: wtrun                     !! Safety threshold on primary beams
  type(cct_lst), intent(inout) :: cct_list      !! Clean Component List
  integer, intent(in) :: start_iter             !! Starting Component Number
  integer, intent(out) :: jcode                 !! Stopping code
  real, intent(out) :: cflux                    !! Cleaned Flux
  !
  ! Local ---
  logical :: ok
  integer :: dimcum
  real, allocatable :: oldcum(:)
  real :: cum, conv, sign
  real :: valmax, valmin, f, vnew, borne, gain
  integer :: i, j, ix, iy, ip, imax, jmax, imin, jmin, k, l
  character(len=message_length) :: chain
  integer, allocatable :: imax_it(:), jmax_it(:)
  real, allocatable :: vnew_it(:)
  integer :: it, ier, nthread, mthread, ithread
  integer :: max_iter ! Maximum number of Clean Components
  !
  ! Code ----
  dimcum = converge
  allocate(oldcum(max(1,dimcum)),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    return
  endif
  !
  oldcum = 0.0
  !
  ! Find highest point in region to be searched
  call maxlst (resid,nx,ny,list,nl,valmax,imax,jmax,   &
     &    valmin,imin,jmin)
  write(chain,'(A,1PG10.3,A,I6,I6,A,1PG10.3,A,I6,I6)') &
    &   'Map max. ',valmax,' at ',imax,jmax,  &
    &   ', Min. ',valmin,' at ',imin,jmin
  call map_message(seve%i,rname,chain)
  !
  ! Subtract +ve and -ve peaks
  niter = 0
  if (niter.lt.piter) then
    vnew = valmax
    ix = imax
    iy = jmax
    sign = 1.0
  elseif (abs(valmin) .gt. abs(valmax)) then
    vnew = valmin
    ix = imin
    iy = jmin
    sign = -1.0
  else
    vnew = valmax
    ix = imax
    iy = jmax
    sign = 1.0
  endif
  !
  ! Setup Subtraction loop
  cum    = 0.
  niter  = 0
  conv   = 0.
  borne = max(absres,fracres*abs(vnew))
  if (np.le.1) then
    gain = gainloop / beam(ixbeam,iybeam,1)
  else
    gain = gainloop
  endif
  !
  ! Main subtraction loop
  mthread = 1
  !$  mthread = omp_get_max_threads()
  !$  if (omp_in_parallel()) then
  !$    if (omp_get_nested()) then
  !$      ! Further optimisation requires to know the number of Outer Threads
  !$      mthread = omp_inner_thread
  !$      if (omp_debug) Print *,'Already in parallel mode, Outer THREAD ',omp_outer_thread,' Inner ',omp_inner_thread
  !$    else
  !$      mthread = 1
  !$      if (omp_debug) Print *,'Already in parallel mode, Outer THREAD ',omp_outer_thread,' No Inner threads'
  !$    endif
  !$  else
  !$    mthread = omp_inner_thread
  !$    if (omp_get_nested()) then
  !$      if (omp_debug) Print *,'Activating nesting ',omp_get_max_threads(),' possible, used ',mthread
  !$    else
  !$      if (omp_debug) Print *,'No parallel, and No nesting either, ',mthread
  !$    endif
  !$  endif
  allocate(vnew_it(mthread),imax_it(mthread),jmax_it(mthread),stat=ier)
  if (ier.ne.0) then
    write(chain,'(A,I4)') 'Memory allocation error for Mthread ',mthread
    call map_message(seve%e,rname,chain)
    return
  endif
  !
  if (miter.eq.0) then
    max_iter = 2**30  ! A Large  number
  else
    max_iter = miter
  endif
  !
  niter = start_iter-1 ! Could use the cct_list%cur_iter instead.
  ok = niter.lt.max_iter .and. abs(vnew).gt.borne
  !
  ! !Print *,'VNEW at start ',vnew
  do while (ok)
    !
    ! Get the component flux
    niter = niter+1
    f = vnew * gain
    if (np.gt.1) then
      f = f * weight(ix,iy)    ! Convert to Clean component
    endif
    if (niter.gt.cct_list%max_size) then
      ! !Print *,'Re-allocting CCT list  in HOGBOM_CYCLE'
      call cct_list%reallocate()
    endif
    !
    cct_list%cc(niter)%value = f       ! Store as fractions of beam max
    cct_list%cc(niter)%ix = ix
    cct_list%cc(niter)%iy = iy
    cct_list%cc(niter)%size = 0
    cct_list%cur_size = niter          ! That one was missing...
    ! !Print *,'Niter ',niter,cct_list%cc(niter)
    !
    cum = cum + f
    if (dimcum.ne.0) then
      !
      ! Keep last DIMCUM cumulative fluxes to test convergence
      oldcum(mod(niter,dimcum)+1) = cum
      conv = sign * (cum - oldcum(mod(niter+1,dimcum)+1))
    endif
    !
    ! Plot the new point
    if (pflux) call next_flux(niter,cum,0)
    !
    ! Subtract previous component from residual map
    nthread = 1
    !
    ! Parallel programming comment:
    ! Note that the gain is significant only in case of enough primary beams.
    ! It may slow down the method quite significantly otherwise, unless
    ! the number of inner threads has been properly evaluated.
    !
    !$OMP PARALLEL DEFAULT(none) NUM_THREADS(mthread) &
    !$OMP   &   SHARED(beam,resid,primary,weight,msk) &
    !$OMP   &   SHARED(nx,ny,mx,my,np,box,niter,piter,wtrun) &
    !$OMP   &   SHARED(vnew_it,imax_it,jmax_it) &
    !$OMP   &   SHARED(ixbeam,iybeam,f)  SHARED(ix,iy) &
    !$OMP   &   PRIVATE(j,l,i,k,ip,ithread) SHARED(nthread,omp_debug)
    !
    ithread = 1
    !$  nthread = omp_get_num_threads()
    !$  ithread = omp_get_thread_num()+1
    !$  if (omp_debug.and.niter.eq.1) Print *,'Inner Hogbom Nthread ',nthread,' Ithread ',ithread
    !
    vnew_it(ithread)  = 0
    !$OMP DO SCHEDULE(STATIC,1) 
    !$ ! The type of Scheduling does not seem to affect the timing
    !$ ! significantly.  DYNAMIC may be slightly better.
    do j=1,ny
      !
      ! Proceed Row by Row
      l = j-iy+iybeam
      if (l.ge.1 .and. l.le.my) then
        !
        ! Along that row, subtract clean component if in beam
        do i = 1,nx
          k = i-ix+ixbeam
          if (k.ge.1 .and. k.le.mx) then
            if (np.le.1) then
              resid(i,j) = resid(i,j) - f*beam(k,l,1)
            else
              if (resid(i,j).ne.0) then
                do ip = 1,np
                  !
                  ! Beware of truncating the primary beam.
                  if (primary(ip,i,j).gt.wtrun) then
                    resid(i,j) = resid(i,j) -   &
     &                      f*beam(k,l,ip)*primary(ip,i,j)   &
     &                      *primary(ip,ix,iy)*weight(i,j)
                  endif
                enddo
              endif
            endif
          endif
        enddo
      endif
      !
      ! Find new maximum inside cleaning box in residual map for this row
      if ((j.ge.box(2)).and.(j.le.box(4))) then
        if (niter.lt.piter) then
          ! Force positive components
          do i = box(1), box(3)
            if (msk(i,j)) then
              if (vnew_it(ithread).lt.resid(i,j)) then
                vnew_it(ithread)=resid(i,j)
                imax_it(ithread)=i
                jmax_it(ithread)=j
              endif
            endif
          enddo
        else
          ! Do not force positivity
          do i = box(1), box(3)
            if (msk(i,j)) then
              if (abs(vnew_it(ithread)).lt.abs(resid(i,j))) then
                vnew_it(ithread)=resid(i,j)
                imax_it(ithread)=i
                jmax_it(ithread)=j
              endif
            endif
          enddo
        endif
      endif
      !
      ! Loop for next row
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
    !
    ! Compute VNEW and Position for next iteration
    vnew = vnew_it(1) 
    it = 1
    do i=2,nthread
      if (abs(vnew).lt.abs(vnew_it(i))) then
        it = i
        vnew = vnew_it(i)
      endif
    enddo
    vnew = vnew_it(it)
    ix = imax_it(it)
    iy = jmax_it(it)
    !
    ! !Print *,'Niter ',niter,' < ',max_iter,niter.lt.miter
    ! !Print *,'Converge ',converge, ' > 0',(converge.gt.0)
    ! !Print *,'Vnew = ',vnew,' > Borne = ',borne,abs(vnew).gt.borne
    !
    jcode = 0
    if (sic_ctrlc()) exit
    !
    if (niter.ge.max_iter) then
      jcode = 1
      exit
    endif
    if ((converge.gt.0).and.(conv.le.0)) then
      jcode = 2
      exit
    endif
    if (abs(vnew) .le. borne) then
      jcode = 3
      exit
    endif
  enddo
  !
  cflux = cum
  deallocate(vnew_it,imax_it,jmax_it,stat=ier)
end subroutine hogbom_cycle90
