subroutine mx_major (u,beam,residu,nx,ny, nz,   &
     &    fwork,wclean,mclean,box,maxiter,compon,niter,   &
     &    grid, mapu, mapv, mapx, mapy, wfft, fft, sblock, cpu0)
  use gildas_def
  use image_def
  use gkernel_interfaces
  use mapping_interfaces
  use mx_parameters
  use clean_def
  !---------------------------------------------------------------------
  ! CLEAN
  !	Major cycle loop according to MX idea
  !---------------------------------------------------------------------
  type(gildas) :: u                 !
  integer :: nx                     !
  integer :: ny                     !
  real ::    beam(nx,ny)            !
  integer :: nz                     !
  real ::    residu(nx,ny,nz)       !
  complex :: fwork(nx,ny)           ! Work space for T.F.
  integer :: mclean                 !
  type(cct_par) :: wclean(mclean)   ! Work space for clean components
  integer :: box(4)                 ! Cleaning box
  integer :: maxiter                ! Maximum number of clean components
  real ::  compon(3,maxiter,nz)     ! Clean component table
  integer :: niter(nz)              ! Number of Clean components
  real ::    grid(nx,ny)            ! Grid correction
  real :: mapu(nx)                  ! Coordinates of UV grid
  real :: mapv(ny)                  ! Coordinates of UV grid
  real :: mapx(nx)                  ! Coordinates of XY map in 1/m
  real :: mapy(ny)                  ! Coordinates of XY map in 1/m
  real :: wfft(*)                   ! FFT work space
  complex :: fft(nz+1,nx,ny)        ! FFTs of planes
  integer :: sblock                 !
  real :: cpu0                      !
  ! Local
  real :: cpu1, a
  !
  ! Some automatic arrays
  real ::    flux(nz)             !Total clean flux density
  logical :: converge(nz)         ! Indique la conv par acc de flux
  !
  integer :: iblock,nblock,istart,kz,jz
  integer :: jc,nv,iz,nn(2),ndim
  real ::    maxcarte,mincarte,   &   !max et min de la carte
     &    maxabs               !le plus grand en absolu
  integer :: imax,jmax,imin,jmin  !leurs coordonnees
  real ::    borne                !fraction de la carte initiale
  ! Critere d'arret pour le Clean de Clark
  real ::    clarkl
  real ::    limite               !intensite minimum des pts retenus
  integer :: nclean               !nb de pts reellement retenus
  logical :: fini                 !critere d'arret
  logical :: done                 ! All planes finished
  integer :: ncycle               ! Nombres de cycles majeurs
  logical :: select               ! Select some component  in CHOICE
  integer :: jo
  !
  ! Make ONE major cycle per plane
  ncycle = 0
  done = .false.
  !
  niter(1:nz) = 0
  flux(1:nz) = 0.0
  converge(1:nz) = .false.
  !
  jc = u%gil%dim(1)
  nv = u%gil%dim(2)
  select = .true.
  !
  do ! The big loop
    done = .true.
    call gag_cpu(cpu1)
    write(6,1000) 'I-MX_MAJOR,  Start major cycle at ',cpu1-cpu0
    do iz = 1,nz
      write(6,1001) 'I-MX,  Processing plane ',iz
      !
      ! Find maximum residual
      call maxmap (residu(:,:,iz),nx,ny,box,   &
      &        maxcarte,imax,jmax,mincarte,imin,jmin)
      maxabs = max(abs(maxcarte),abs(mincarte))
      if (ncycle.eq.0)  borne  = max(frac_res*maxabs,abs_res)
      fini = (maxabs.le.borne) .or. (maxiter.le.niter(iz))   &
      &        .or. converge(iz)
      if (.not.fini) then
        !
        ! Define minor cycle limit
        clarkl = maxabs*beam_gain
        limite = max(clarkl,0.9*borne)
        write(6,1000) 'I-MX,  Using residuals higher than ',limite
        !
        ! Select points of maximum strength and load them in
        call choice_box (residu(:,:,iz),nx,ny,box,limite,   &
      &          mclean,wclean,nclean,   &
      &          maxabs,select)
        !
        ! Make minor cycles
        write(6,1001) 'I-MX,  Selected ',nclean,' points'
        call mx_minor (wclean,   &
      &          nclean,beam,nx,ny,ix_beam,iy_beam,ix_patch,iy_patch,   &
      &          gain_loop,maxiter,clarkl,limite,converge(iz),   &
      &          .not.keep_cleaning,compon(:,:,iz), niter(iz))
        write(6,1001) 'I-MX,  Found ',niter(iz),' clean components'
        !
        ! Remove all components by FT : RESIDU = RESIDU - BEAM # WCLEAN(*,4)
        !
        jo = mcol(1)-1+iz
        call mx_uvsub (nx,ny,mapx,mapy,   &
      &          wclean,nclean,flux(iz),   &
      &          jc,nv,u%r2d,5+3*jo)
        write(6,1000) 'I-MX,  Total cleaned flux density ',flux(iz)
        done = .false.
      endif
    enddo
    !
    ! OK END
    if (done) then
      do iz=1,nz
        if (maxabs.le.borne) then
          write(6,1001) 'I-MX,  Plane ',iz,   &
      &            ' reached minimum flux density '
        elseif (maxiter.le.niter(iz)) then
          write(6,1001) 'I-MX,  Plane ',iz,   &
      &            ' reached maximum number of components '
        elseif (converge(iz)) then
          write(6,1001) 'I-MX,  Plane ',iz,   &
      &            ' reached minor cycle convergence'
        else
          write(6,1001) 'I-MX,  Plane ',iz,   &
      &            ' end of transcendental causes'
        endif
      enddo
      write(6,1001) 'I-MX,  Converged after ',ncycle,' cycles'
      call gag_cpu(cpu1)
      write(6,1000) 'I-MX,  Finish major cycle at ',cpu1-cpu0
      return
    endif
    !
    ! Else Compute FFT's and loop again
    call gag_cpu(cpu1)
    write(6,1000) 'I-MX,  Start FFT back at ',cpu1-cpu0
    nn(1) = nx
    nn(2) = ny
    ndim = 2
    if (sblock.le.0) then
      sblock = nz
      nblock = 1
    else
      nblock = (nz+sblock-1)/sblock
    endif
    !
    do iblock = 1,nblock
      fft = 0 ! 
      
      istart = mcol(1)+(iblock-1)*sblock
      kz = min (sblock,nz-sblock*(iblock-1))
      call dofft (jc,nv,   & ! Size of visibility array
      &        u%r2d,      & ! Visibilities
      &        1,2,        &         ! U, V pointers
      &        istart,     &      ! First channel to map
      &        kz,nx,ny,   &    ! Cube size
      &        fft,        &         ! FFT cube
      &        mapu,mapv,  &   ! U and V grid coordinates
      &        support,uv_cell,uv_taper,   &    ! Gridding parameters
      &        weight, vcoor,   &    ! Weight & V coordinates
      &        conv%ubias,conv%vbias,conv%ubuff,conv%vbuff,ctype)
      !
      ! Make maps with grid correction
      do iz=1,kz
        jz = iz+sblock*(iblock-1)
        call extrac (kz+1,nx,ny,iz,fft,fwork)
        call fourt  (fwork,nn,ndim,-1,1,wfft)
        call cmtore (fwork,residu(:,:,jz),nx,ny)
        call docorr (residu(:,:,jz),grid,nx*ny)
      enddo
    enddo
    write(6,1000) 'I-MX,  Finished gridding again'
    ncycle = ncycle+1
  enddo ! The big loop
  !
  1000  format(a,1pg11.3)
  1001  format(a,i12,a)
end subroutine mx_major
!
subroutine mx_uvsub (nx,ny,mapx,mapy,   &
    &      wclean,nclean,flux,jc,nv,visi,io)
  use clean_def
  !-------------------------------------------------------------------
  ! GILDAS:	CLEAN 	Internal routine
  !	Subtract last major cycle components from residual map.
  !-------------------------------------------------------------------
  integer :: nx                   !
  integer :: ny                   !
  real :: mapx(nx)                !
  real :: mapy(ny)                !
  integer :: nclean               !
  type(cct_par) :: wclean(nclean) !
  real :: flux                    !
  integer :: jc                   !
  integer :: nv                   !
  real :: visi(jc,nv)             !
  integer :: io                   !
  ! Local
  integer :: ncomp
  integer :: ic,iv
  real :: x,y,phase,rvis,ivis
  !
  ! Compress clean component list
  ncomp = 0
  do ic=1,nclean
    if (wclean(ic)%value.ne.0.0) then
      flux = flux+wclean(ic)%value 
      ncomp = ncomp+1
      wclean(ncomp) = wclean(ic)
    endif
  enddo
  !
  ! Remove clean component from UV data set
  do iv=1,nv
    do ic = 1,ncomp
      x = mapx(wclean(ic)%ix)
      y = mapy(wclean(ic)%iy)
      phase = visi(1,iv)*x+visi(2,iv)*y
      rvis = wclean(ic)%value*cos(phase)
      ivis = wclean(ic)%value*sin(phase)
      visi(io,iv) = visi(io,iv) - rvis
      visi(io+1,iv) = visi(io+1,iv) - ivis
    enddo
  enddo
end subroutine mx_uvsub
!
subroutine mx_minor (wclean,nbpoint,   &
    &      beam,nx,ny,ixbeam,iybeam,ixpatch,iypatch,   &
    &      gain,maxiter,clarkmin,limite,converge,check,   &
    &      compon,niter)
  use mapping_interfaces
  use clean_def
  !-------------------------------------------------------------------
  ! MX:
  !     CLEAN    Internal routine
  !        B.Clark minor cycles
  !     Deconvolve as in standard clean a list of NBPOINT points
  !     selected in the map until the residuals is less than CLARKMIN
  !-------------------------------------------------------------------
  type(cct_par) :: wclean(*)      ! Clean component
  integer :: nbpoint              ! nombre de points retenus
  integer :: nx                   ! dimension et centre du beam
  integer :: ny                   ! dimension et centre du beam
  real :: beam(nx,ny)             ! beam
  integer :: ixbeam               ! dimension et centre du beam
  integer :: iybeam               ! dimension et centre du beam
  integer :: ixpatch              ! rayon utile du Beam
  integer :: iypatch              ! rayon utile du Beam
  real :: gain                    ! gain de clean
  integer :: maxiter              ! nombre max d'iteration
  real :: clarkmin                ! borne d'arret de clean
  real :: limite                  ! borne d'arret de clean
!  real :: cclean(*)               ! valeur des composantes
  logical :: converge             ! Controle de la convergence
  logical :: check                ! ibid.
  real :: compon(3,maxiter)       ! Effective clean components
  integer :: niter                ! Number of clean components
  ! Local
  logical :: goon
  !
  integer :: nocomp, nomin, nomax             ! No de la composante courante
  real :: rabs, sign, rmin, rmax            ! MaxAbs et Signe courant
  real :: worry, xfac, spexp    ! Conservative and speedup factor
  !
  integer :: dimcum             !Controle de la convergence
  parameter (dimcum=10)      !par accumulation de flux positif
  real :: cum, oldcum(dimcum), f
  integer :: i
  !
  oldcum = 0.0
  cum = 0.
  call absmax (wclean,nbpoint,nocomp,rabs)
  if (wclean(nocomp)%influx.gt.0) then
    sign = 1
  else
    sign = -1
  endif
  !
  worry = 1.0
  spexp = 0.5
  xfac = (clarkmin/rabs)**spexp
  goon = niter.lt.maxiter
  do while (goon)
    niter = niter + 1
    f = gain / beam(ixbeam,iybeam) * wclean(nocomp)%influx
    wclean(nocomp)%value = wclean(nocomp)%value + f
    compon(1,niter) = f
    compon(2,niter) = wclean(nocomp)%ix
    compon(3,niter) = wclean(nocomp)%iy
    call soustraire (wclean,nbpoint,   &
    &        beam,nx,ny,ixbeam,iybeam,      &
    &        ixpatch,iypatch,nocomp,gain,   &
    &        1,beam,beam,0.0)  ! These are dummies for 1 plane
    !
    ! B.CLARK Magic confidence factor
    call absmax (wclean,nbpoint,nocomp,rabs)
    worry = worry+xfac/float(niter)
    !
    ! Check convergence
     goon = (rabs.gt.worry*clarkmin) .and. (niter.lt.maxiter)   &
    &        .and. (rabs.ge.limite)
    if (check) then
      cum = cum + f
      oldcum(mod(niter,dimcum)+1) = cum
      converge = (sign*(cum-oldcum(mod(niter+1,dimcum)+1)).lt.0.)
      goon = goon .and. .not.converge
    endif
  enddo
  write(6,1000) 'I-MX,  Major cycle stops at ',   &
    &      rabs,limite,worry*clarkmin
  !
  1000  format(a,3(1x,1pg11.4))
end subroutine mx_minor
!
subroutine absmax (x,n,num,rabs)
  use clean_def
  !-------------------------------------------------------------------
  ! @ private
  !
  ! GILDAS:	Utility routine
  ! 	Compute position and values of Min and Max of array X
  !-------------------------------------------------------------------
  integer, intent(in) :: n                    !
  type(cct_par), intent(in) :: x(n)            !
  integer, intent(out) :: num                  !
  real, intent(out) :: rabs                    !
  ! Local
  integer :: no
  !
  rabs = 0.0
  num = 1
  do no=1,n
    if (x(no)%influx.ge.rabs) then
      num = no
      rabs = x(no)%influx
    elseif  (-x(no)%influx.gt.rabs) then
      num = no
      rabs = -x(no)%influx
    endif
  enddo
end subroutine absmax
!
subroutine choice_box (r,nx,ny,box,limite,   &
     &    nclean,wclean,nbpoin,rmax,select)
  use clean_def
  !---------------------------------------------------------------------
  ! @ private
  !
  ! MAP TASKS 	Internal routine
  !	  Select possible clean components in residual map.
  !	  Components are returned ordered in increasing I and J.
  !   Uses a BOX instead of a LIST
  !   Differs from one in map/lib by using a Box 
  !   and a slightly different test to rebuild the histogram.
  !---------------------------------------------------------------------
  integer, intent(in) :: nx          ! X size
  integer, intent(in) :: ny          ! Y size
  integer, intent(in) :: nclean      ! Maximum number of components
  integer, intent(out) :: nbpoin     ! Number of components found
  real, intent(in) :: r(nx,ny)       ! Input array
  integer :: box(4)                  !
  type(cct_par), intent(inout) :: wclean(nclean)            !
  real, intent(inout) ::  limite     ! selection threshold
  real, intent(in) :: rmax           ! Maximum value
  logical, intent(in) :: select                 !
  ! Local
  integer :: i,j,nh,ngoal
  parameter (nh=64)
  parameter (ngoal=10000)
  integer :: hx(nh)
  real :: hmin, hstep
  !
  if (select) then
    !
    ! Make histogram
    hmin = 0.0
    hstep = rmax/(nh-2)
    call histos_box (r,nx,ny,box,hx,nh,hmin,hstep)
    !
    ! Locate a "reasonable" number of components
    hmin = 0.0
    do i=1,7*nh/8
      if (hmin.ne.0.0) then
        continue
      elseif  (hx(i).lt.ngoal) then
        hmin = (i-1)*hstep
      endif
    enddo
    limite = max(limite,hmin)
  endif
  !
  ! Select possible components in Clean Box
  nbpoin = 0
  do j=box(2),box(4)
    do i=box(1),box(3)
      if ( abs(r(i,j)).ge.limite ) then
        nbpoin=nbpoin+1
        wclean(nbpoin)%influx = r(i,j)
        wclean(nbpoin)%ix = i
        wclean(nbpoin)%iy = j
        wclean(nbpoin)%value = 0.0
      endif
    enddo
  enddo
end subroutine choice_box
!
subroutine histos_box (r,nx,ny, box, hx,nh,hmin,hstep)
  !---------------------------------------------------------------------
  ! @ private
  !
  ! MAP TASKS
  !	  Computes the histogram of part of an image
  !   Differs from one in map/lib: uses a box instead
  !   of a list of pixels.
  !---------------------------------------------------------------------
  integer, intent(in) :: nx        ! X size
  integer, intent(in) :: ny        ! Y size
  real, intent(in)  :: r(nx,ny)    ! Input array 
  integer, intent(in)  :: box(4)   ! Search box
  integer, intent(in) :: nh        ! Histogram size
  integer, intent(out) :: hx(nh)   ! Histogram
  real, intent(in) :: hmin         ! Min bin
  real, intent(in) :: hstep        ! Bin size
  ! Local
  real :: steph
  integer :: i,j,nin,nout,n
  !
  nin = 0
  nout = 0
  hx(1:nh) = 0
  steph = 1.0/hstep
  !
  do j = box(2),box(4)
    do i= box(1),box(3)
      n = nint((abs(r(i,j))-hmin)*steph + 1.0)
      if (n.ge.1 .and. n.le.nh) then
        hx(n) = hx(n)+1
        nin = nin+1
      else
        nout= nout+1
      endif
    enddo
  enddo
  !
  ! Convert to cumulative form
  do n=nh-1,1,-1
    hx(n) = hx(n)+hx(n+1)
  enddo
end subroutine histos_box

