subroutine major_cycle90 (rname,method,head,   &
     &    clean,beam,resid,nx,ny,tfbeam,fcomp,   &
     &    wcl,mcl,ixbeam,iybeam,ixpatch,iypatch,bgain,   &
     &    box, wfft, tcc, 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
  !   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) :: 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(nx,ny,np)       ! Dirty beams (per pointing)
  real, intent(in) ::    tfbeam(nx,ny,np)     ! T.F. du beam
  complex, intent(inout) :: fcomp(nx,ny)      ! T.F. du vecteur modification
  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_par), intent(inout) :: tcc(method%m_iter) ! 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   ! 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 k, kcl
  integer nn(2),ndim
  character(len=message_length) :: chain
  !
  ! 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
  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
      call minor_cycle90 (method,   &
     &        wcl,            &  ! CCT
     &        ncl,            &  ! Number of candidates
     &        beam,nx,ny,     &  ! Dirty beams and Size
     &        ixbeam,iybeam,  &  ! Beam center
     &        ixpatch,iypatch,&  ! Beam patch
     &        clarkl,limite,  &
     &        converge,       &  !
     &        tcc,            &  ! Cumulated components
     &        np, primary, weight, method%trunca,   &
     &        flux,           &  ! Total Flux
     &        method%pflux, next_flux)
      !
      ! Remove all components by FT : RESID = RESID - BEAM # WCL(*,4)
      call remisajour (nx*ny,   &  ! Total size
     &        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,   &
     &      tcc,clean,resid,weight)
    fini = converge
    !
    ! Limit number of major cycles...
    if (k.gt.method%n_major) fini = .true.
    !
    ! Get new list
!!    if (.not.fini) then
!!      !
!!      ! Get a new list if in QUERY mode
!!      ! Query mode does not exist for MRC
!!      if (method%qcycle) then
!!        ! For MRC, method is s_method, while
!!        ! head is the normal stuff... This would create a problem
!!        call get_newmask (method,head,nl,error)
!!        !
!!        ! Reset the List in its defined range.
!!        list(1:nl) = method%list(1:nl)
!!      endif
!!    endif
  enddo
  !
  ! 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,nx,ny,ixbeam,iybeam,ixpatch,iypatch,   &
     &    clarkmin,limite,converge,   &
     &    tcc, np, primary, weight, wtrun, cum, pflux, next_flux )
  use gkernel_interfaces
  use imager_interfaces, except_this=>minor_cycle90
  use clean_def
  !----------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER    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) :: nx,ny,ixbeam,iybeam  ! Size and cente pixel of beam
  integer, intent(in) :: ixpatch,iypatch      ! Used size of beam
  real, intent(in) :: beam(nx,ny,np)          ! Dirty beam
  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_par), intent(out) :: tcc(*)       ! 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
  !
  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)
    !
    wcl(kcl)%value = wcl(kcl)%value + f
    tcc(method%n_iter)%value = f    ! Store as fractions of beam max
    tcc(method%n_iter)%ix = wcl(kcl)%ix
    tcc(method%n_iter)%iy = wcl(kcl)%iy
    tcc(method%n_iter)%type = 0
    !
    ! Subtract from iterated values VCL
    call soustraire (wcl,ncl,           &
     &      beam,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
    converge = .true. ! It must be converged
  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
  !----------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  ! 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)     ! T.F. du beam
  complex, intent(inout) :: fcomp(nx,ny)      ! T.F. du vecteur modification
  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)
  !
  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(:)
  !
  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
  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 (nx*ny,   &
     &        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
    !
    ! Get new list
!!    if (.not.fini) then
!!      ! Get a new list if in QUERY mode
!!      ! Query mode does not exist for MRC
!!      if (method%qcycle) then
!!        ! For MRC, method is s_method, while
!!        ! head is the normal stuff... This would create a problem
!!        call get_newmask (method,head,nl,error)
!!        !
!!        ! Reset the List in its defined range.
!!        list(1:nl) = method%list(1:nl)
!!      endif
!!    endif
  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,i6,a,1pg11.4,a)
  101   format (a,1pg11.4,a,i7,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    Support routine for 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)     ! Beam TF
  complex, intent(out) :: fcomp(nx,ny)  ! TF of clean components
  real, intent(inout) :: wfft(*)        ! Work array
  real, intent(out) :: factor           ! Max of clean
  !
  integer i,j,k,ndim,nn(2)
  !
  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   Support routine for 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 comp.
  real, intent(in) :: f                 ! Gain factor
  real, intent(inout) :: s              ! Cumulative flux
  real, intent(inout) :: compon(nx,ny)  ! Cumulative clean component
  !
  integer i
  !
  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, 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
  !
  ! IMAGER    Support routine for 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(in) :: 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               ! 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_par), intent(out) :: cct(miter)   ! Clean Component Table
  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
  !
  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
  !
  ok = niter.lt.miter .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
    cct(niter)%value = f       ! Store as fractions of beam max
    cct(niter)%ix = ix
    cct(niter)%iy = iy
    cct(niter)%type = 0
    !
    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,' < ',miter,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.miter) 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
