subroutine mx_uvmap_clean(task,line,error)
  use gkernel_interfaces
  use imager_interfaces, except_this=>mx_uvmap_clean
  use clean_def
  use clean_arrays
  use clean_types
  use clean_default
  use gbl_message
  !------------------------------------------------------------------------
  ! @ private
  !
  !*
  ! "Historical" version of UV_MAP, deprecated in IMAGER,
  ! only used for debugging and comparison.
  !
  ! TASK  Compute a map from a CLIC UV Sorted Table
  ! by Gridding and Fast Fourier Transform, using adequate
  ! scratch space for optimisation. Will work for
  ! up to 128x128x128 cube data size, may be more...
  !
  ! Input : 
  !     a precessed UV table  
  ! Output :  
  !     a precessed, rotated, shifted UV table, sorted in V,
  !     ordered in (U,V,W,D,T,iant,jant,nchan(real,imag,weig))  
  !     a beam image or cube.   
  !     a LMV cube.  
  !!
  !------------------------------------------------------------------------
  character(len=*), intent(in) :: task   !! Caller (MX or UV_MAP)
  character(len=*), intent(in) :: line   !! Command line
  logical, intent(out) :: error          !! Logical error flag
  !
  ! Constantes
  character(len=1), parameter :: question_mark='?'
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: f_to_k = 2.d0*pi/299792458.d-6
  !
  ! Local ---
  real, allocatable :: w_mapu(:), w_mapv(:), w_grid(:,:)
  real, allocatable :: res_uv(:,:)
  real(8) new(3)
  real(4) rmega,uvmax,uvmin,uvma
  integer wcol,mcol(2),nfft,sblock
  integer n,ier, nsizes(3)
  logical one, sorted, shift, abort
  character(len=24) ra_c,dec_c
  character(len=message_length) :: chain
  real cpu0, cpu1
  real(8) :: freq
  real, allocatable :: fft(:)
  integer nx,ny,nu,nv,nc,np,nb
  !
  character(len=4) :: argum
  logical limits, needed
  real ylimn,ylimp
  integer ipen, miter
  !
  integer :: mx_version
  type(channel_par) :: channels
  type(cct_lst) :: cct_list
  type(gridding) :: conv
  !
  ! Code ----
  call imager_tree('MX_UVMAP_CLEAN',.false.)
  !
  call map_prepare(task,huv,themap,error)
  if (error) return
  !
  ! Test the ? argument
  if (sic_narg(0).eq.1) then
    call sic_ch(line,0,1,argum,n,.false.,error)
    if (argum(1:1).eq.question_mark) then
      call exec_program("@ i_mx "//argum)
      return
    endif
  endif
  !
  if (themap%beam.ne.0) then
    call map_message(seve%e,task,'Only works of 1 beam in total (so far)')
    error = .true.
    return
  endif
  !
  call uvmap_cols(task,line,huv,channels,error)
  if (error) return 
  mcol = channels%bounds
  wcol = channels%weight
  !
  one = .true.
  !
  call sic_get_logi('UV_SHIFT',shift,error)
  if (shift) then
     call sic_get_char('MAP_RA',ra_c,n,error)
     call sic_get_char('MAP_DEC',dec_c,n,error)
     call sic_get_dble('MAP_ANGLE',new(3),error)
  else
     new = 0.d0
  endif
  !
  ! First sort the input UV Table, leaving UV Table in UV_*
  if (shift) then
     call sic_decode(ra_c,new(1),24,error)
     if (error) then
        write(chain,'(A)') 'Input conversion error on phase center'
        call map_message(seve%e,task,chain)
        return
     endif
     call sic_decode(dec_c,new(2),360,error)
     if (error) then
        write(chain,'(A)') 'Input conversion error on phase center'
        call map_message(seve%e,task,chain)
        return
     endif
     new(3) = new(3)*pi/180.0d0
  endif
  call gag_cpu(cpu0)
  needed = themap%uniform(2).ne.0
  call uv_sort (huv,duv,error,sorted,shift,new,uvmax,uvmin,needed)
  if (error) return
  if (.not.sorted) then
    ! Redefine SIC variables (mandatory)
    call map_uvgildas('UV',huv,error,duv)
  endif
  call gag_cpu(cpu1)
  write(chain,102) 'Finished sorting ',cpu1-cpu0
  call map_message(seve%i,task,chain)
  !
  call map_parameters(task,themap,huv,freq,uvmax,uvmin,error) ! huv%gil%majo)
  if (error) return
  uvma = uvmax/(freq*f_to_k)
  !
  themap%xycell = themap%xycell*pi/180.0/3600.0
  !
  ! Get work space, ideally before mapping first image, for
  ! memory contiguity reasons.
  !
  nx = themap%size(1)
  ny = themap%size(2)
  nu = huv%gil%dim(1)
  nv = huv%gil%nvisi ! not %%dim(2)
  !
  ! Define the number of output channels
  nc = mcol(2)-mcol(1)+1
  !
  write(chain,'(A,I0,A,I0,A)') 'Imaging channel range [',mcol(1),',',mcol(2),']'
  call map_message(seve%i,task,chain)
  !
  ! Check if Weights have changed by MCOL choice
  if (any(saved_chan%bounds.ne.mcol)) do_weig = .true.
  saved_chan%bounds = mcol
  !
  !
  if (the_method%method.eq.'MX') do_weig = .true. ! Test
  if (do_weig) then
    call map_message(seve%i,task,'Computing weights ')
    if (allocated(g_weight)) deallocate(g_weight)
    if (allocated(g_v)) deallocate(g_v)
    allocate(g_weight(nv),g_v(nv),stat=ier)
    if (ier.ne.0) goto 98
  else
    call map_message(seve%d,task,'Re-using weight space')
  endif
  !
  rmega = 8.0
  ier = sic_ramlog('SPACE_MAPPING',rmega)
  sblock = max(int(256.0*rmega*1024.0)/(nx*ny),1)
  !
  ! New Beam place
  if (allocated(dbeam)) then
    call sic_delvariable ('BEAM',.false.,error)
    deallocate(dbeam)
  endif
  call gildas_null(hbeam)
  !
  ! New dirty image
  if (allocated(ddirty)) then
    call sic_delvariable ('DIRTY',.false.,error)
    deallocate(ddirty)
  endif
  allocate(ddirty(nx,ny,nc),stat=ier)
  !
  call gildas_null(hdirty)
  hdirty%gil%ndim = 3
  hdirty%gil%dim(1:3) = (/nx,ny,nc/)
  call sic_mapgildas('DIRTY',hdirty,error,ddirty)
  !
  hdirty%r3d => ddirty
  !
  ! Find out how many beams are required
  call map_beams(task,themap%beam,huv,nx,ny,nb,nc)
  !
  mx_version = 1
  call sic_get_inte('MX_VERSION',mx_version,error)
  !
  ! Process sorted UV Table according to the number of beams produced
  if (mx_version.eq.1) then
    ! This MX patch is temporary
    !
    ! Use old code only when explicitely requested
    hbeam%gil%ndim = 2
    hbeam%gil%dim(1:2)=(/nx,ny/)
    allocate(dbeam(nx,ny,1,1),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,task,'Memory allocation error on DBEAM')
      error =.true.
      return
    endif
    !
    nfft = 2*max(nx,ny)
    allocate(w_mapu(nx),w_mapv(ny),w_grid(nx,ny),fft(nfft),stat=ier)
    if (ier.ne.0) goto 98
    !
    hbeam%r3d => dbeam(:,:,:,1)
    call mx_beam (task,themap,   &
       &    huv, hbeam, hdirty,   &
       &    nx,ny,nu,nv, duv,   &
       &    w_mapu, w_mapv, w_grid, &
       &    g_weight, g_v, do_weig,  &
       &    wcol,mcol,fft,   &
       &    sblock,cpu0,error,uvma,conv)
    if (error) return
    !
    call sic_mapgildas('BEAM',hbeam,error,dbeam)
  else
    ! The MX part still needs debugging - because the W_GRID array
    ! is not there ...
    !
    hbeam%gil%ndim = 3
    hbeam%gil%dim(1:4)=[nx,ny,nb,1]
    if (nb.gt.1) then
      allocate(hbeam%r3d(nx,ny,nb),dbeam(nx,ny,1,nb),stat=ier)
    else
      allocate(dbeam(nx,ny,1,1),stat=ier)
      hbeam%r3d => dbeam(:,:,:,1)
    endif
    if (ier.ne.0) then
      call map_message(seve%e,task,'Memory allocation error on DBEAM')
      error =.true.
      return
    endif
    !
    call many_beams_para (task,themap,channels,   &
       &    huv, hbeam, hdirty,   &
       &    nx,ny,nu,nv, duv,   &
       &    g_weight, do_weig,  &
       &    sblock,cpu0,error,uvma,0,abort,0)
    if (abort) then
      call map_message(seve%w,task,'Aborted by user')
      error = .true.
      return
    endif
    !
    hdirty%loca%addr = locwrd(ddirty)
    call gdf_get_extrema (hdirty,error)
    !
    ! Re-shape the beam, and reset the 4-D pointer, 
    ! but show it as a 3-D array in SIC
    if (nb.gt.1) then
      dbeam(:,:,:,:) = reshape(hbeam%r3d,[nx,ny,1,nb])
      deallocate(hbeam%r3d)
    endif
    call sic_mapgildas('BEAM',hbeam,error,dbeam)
    !
    hbeam%r4d => dbeam
    hbeam%gil%dim(1:4)=[nx,ny,1,nb]
    hbeam%gil%ndim = 4
    !
    ! Transpose the header appropriately
    hbeam%gil%convert(:,4) = hbeam%gil%convert(:,3)
    hbeam%gil%faxi = 4
    hbeam%char%code(4) = 'VELOCITY' ! Frequency would be better...
    hbeam%gil%convert(:,3) = 1.d0
    hbeam%char%code(3) = 'FIELD'    ! Pseudo-mosaic
    hbeam%gil%ndim = 4
    !
    hbeam%loca%addr = locwrd(dbeam)
    call gdf_get_extrema (hbeam,error)
  endif
  save_data(code_save_beam) = .true.
  save_data(code_save_dirty) = .true.
  !
  call new_dirty_beam
  !
  ! Define Min Max
  d_max = hdirty%gil%rmax
  if (hdirty%gil%rmin.eq.0) then
     d_min = -0.03*hdirty%gil%rmax
  else
     d_min = hdirty%gil%rmin
  endif
  !
  ! Prepare MX part
  limits = sic_present(1,1)
  if (limits) then
    call sic_r4 (line,1,1,ylimn,.true.,error)
    if (error) return
    call sic_r4 (line,1,2,ylimp,.true.,error)
    if (error) return
  else
    ylimp = sqrt (float(the_method%m_iter+200) *   &
        &      log(float(the_method%m_iter+1)) ) * the_method%gain
    if (ylimp.eq.0.) ylimp = 1.0
    if (-hdirty%gil%rmin.gt.1.3*hdirty%gil%rmax) then
      ylimn = ylimp*hdirty%gil%rmin
      ylimp = 0.0
    elseif (-1.3*hdirty%gil%rmin.gt.hdirty%gil%rmax) then
      ylimn = 0.0
      ylimp = ylimp*hdirty%gil%rmax
    else
      ylimn = ylimp*hdirty%gil%rmin
      ylimp = ylimp*hdirty%gil%rmax
    endif
  endif
  np = max(1,hprim%gil%dim(1))
  !
  ! Data checkup
  call clean_data (error)
  if (error) return
  !
  ! Copy the UV Data (eh eh)
  allocate (res_uv(nu,nv),stat=ier)
  res_uv(:,:) = duv
  !
  ! Get the right pointers before starting...
  hclean%r3d => dclean
  hresid%r3d => dresid
  dresid(:,:,:) = ddirty
  hbeam%r4d => dbeam ! Also required for MX
  !
  ! Parameter Definitions
  call beam_unit_conversion(user_method)
  call copy_method(user_method,the_method)
  the_method%method = 'MX'
  the_method%pflux = sic_present(1,0)
  the_method%pcycle = sic_present(2,0)
  the_method%qcycle = sic_present(3,0)
  the_method%pclean = .false.
  the_method%pmrc = .false.
  !
  call sic_get_inte('FIRST',the_method%first,error)
  call sic_get_inte('LAST',the_method%last,error)
  if (the_method%first.eq.0) the_method%first = 1
  if (the_method%last.eq.0) the_method%last = hdirty%gil%dim(3)
  the_method%first = max(1,min(the_method%first,hdirty%gil%dim(3)))
  the_method%last = max(the_method%first,min(the_method%last,hdirty%gil%dim(3)))
  !
  ! Other parameters
  if (the_method%patch(1).ne.0) then
    the_method%patch(1) = min(the_method%patch(1),nx)
  else
    the_method%patch(1) = min(nx,max(32,nx/4))
  endif
  if (the_method%patch(2).ne.0) then
    the_method%patch(2) = min(the_method%patch(2),nx)
  else
    the_method%patch(2) = min(nx,max(32,nx/4))
  endif
  the_method%bzone = (/1,1,nx,ny/)
  !
  call check_area(the_method,hdirty,.false.)
  call check_mask(the_method,hdirty)
  the_method%do_mask = the_method%do_mask
  !
  ! Clean Component Structure (once it is defined, i.e. after check)
  call cct_list%initialize()
  call cct_list%reallocate(the_method%m_iter)
  !
  ! Prepare the CCT data
  nsizes = [nx,ny,nc]
  call cct_prepare(line,nsizes,the_method,task,error)
  if (error) return
  !
  if (the_method%pflux) call init_flux90(the_method,hdirty,ylimn,ylimp,ipen)
  !
  if (the_method%pcycle) call init_plot(the_method,hdirty,dresid)
  !
  ! Perform the cleaning
  miter = the_method%m_iter
  if (the_method%m_iter.eq.0) the_method%m_iter = 2**30
  call mx_clean (themap,huv,res_uv,g_weight,g_v,       &
    &    the_method,hdirty,hbeam,hclean,hresid,hprim,   &
    &    w_grid,w_mapu,w_mapv,cct_list,dcct,d_mask,d_list,      &
    &    sblock, cpu0, uvma, conv)
  the_method%m_iter = miter
  !
  if (the_method%pflux) then
    call close_flux90(ipen,error)
  else
    call gr_execl('CHANGE DIRECTORY <GREG')
  endif
  !
  ! Reset extrema
  hresid%gil%extr_words = 0
  hclean%gil%extr_words = 0
  !
  ! Specify clean beam parameters
  hclean%gil%reso_words = 3
  hclean%gil%majo = the_method%major
  hclean%gil%mino = the_method%minor
  hclean%gil%posa = pi*the_method%angle/180.0
  ! Specify clean beam parameters
  hbeam%gil%reso_words = 3
  hbeam%gil%majo = the_method%major
  hbeam%gil%mino = the_method%minor
  hbeam%gil%posa = pi*the_method%angle/180.0
  save_data(code_save_clean) = .true.
  the_method%nlist = the_method%nlist
  !
  ! Defines the CCT variable
  call sic_mapgildas ('CCT',hcct,error,dcct)
  !
  ! Cleanup
  if (allocated(cct_list%cc)) deallocate(cct_list%cc)
  error = .false.
  !
  if (allocated(w_mapu)) deallocate(w_mapu)
  if (allocated(w_mapv)) deallocate(w_mapv)
  if (allocated(w_grid)) deallocate(w_grid)
  if (allocated(fft)) deallocate(fft)
  call imager_tree('MX_UVMAP_CLEAN',.true.)
  return
  !
98 call map_message(seve%e,task,'Memory allocation failure')
  error = .true.
  return
  !
102 format(a,f9.2)
end subroutine mx_uvmap_clean
!
subroutine mx_beam (rname,map,huv,hbeam,hdirty,   &
     &    nx,ny,nu,nv,uvdata,   &
     &    w_mapu, w_mapv, w_grid, w_weight, w_v, do_weig,    &
     &    wcol,mcol,wfft,sblock,cpu0,error,uvmax,conv)
  use gkernel_interfaces
  use imager_interfaces, except_this=>mx_beam
  use clean_def
  use image_def
  use gbl_message
  !$ use omp_lib
  !------------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER  - Old MX command  
  !   Compute a map from a CLIC UV Sorted Table
  !   by Gridding and Fast Fourier Transform, with
  !   one single beam for all channels.
  !
  ! Input : 
  ! a precessed UV table, sorted in V, ordered in
  ! (U,V,W,D,T,iant,jant,nchan(real,imag,weig))
  !
  ! Output :  
  ! a beam image,
  ! a VLM cube
  !
  ! Work space : 
  ! a  VLM complex Fourier cube (first V value is for beam)
  !!
  !------------------------------------------------------------------------
  character(len=*), intent(in) :: rname     !! Calling Task name
  type (uvmap_par), intent(inout) :: map    !! Mapping parameters
  type (gildas), intent(inout) :: huv       !! UV data set
  type (gildas), intent(inout) :: hbeam     !! Dirty beam data set
  type (gildas), intent(inout) :: hdirty    !! Dirty image data set
  integer, intent(in) :: nx     !! X size
  integer, intent(in) :: ny     !! Y size
  integer, intent(in) :: nu     !! Size of a visibilities
  integer, intent(in) :: nv     !! Number of visibilities
  real, intent(inout) :: uvdata(nu,nv)      !! UV data
  real, intent(inout) :: w_mapu(nx)         !! U grid coordinates
  real, intent(inout) :: w_mapv(ny)         !! V grid coordinates
  real, intent(inout) :: w_grid(nx,ny)      !! Gridding space
  real, intent(inout) :: w_weight(nv)       !! Weight of visibilities
  real, intent(inout) :: w_v(nv)            !! V values
  logical, intent(inout) :: do_weig         !! Should weight be computed ?
  real, intent(inout) :: wfft(*)            !! Work space
  real, intent(inout) :: cpu0               !! CPU counter
  real, intent(inout) :: uvmax              !! Maximum baseline
  integer, intent(inout) :: sblock          !! Blocking factor
  integer, intent(inout) :: wcol            !! Weight channel
  integer, intent(inout) :: mcol(2)         !! First and last channel
  logical, intent(inout) :: error           !! Logical error flag
  type(gridding), intent(inout) :: conv     !! Gridding function
  ! Global variables:
  !
  ! Constants
  real(kind=8), parameter :: clight=299792458d-6 ! Frequency in  MHz
  logical, parameter :: NEW=.true.  ! Test...
  !
  ! Local ---
  integer :: nc   ! Number of channels
  integer :: nd   ! Size of data
  integer ier
  real(kind=8) freq
  integer ctypx,ctypy
  integer icol,lcol,fcol,imi,ima,iv
  real rmi,rma,wall,cpu1
  real xparm(10),yparm(10)
  real vref,voff,vinc
  integer ndim, nn(2), i, lx, ly
  integer istart,iblock,nblock,kz,iz,kkz
  integer blc(4),trc(4)
  character(len=message_length) :: chain
  !
  real rms, null_taper(4)
  complex, allocatable :: ftbeam(:,:)
  complex, allocatable :: tfgrid(:,:,:)
  real, allocatable :: w_xgrid(:),w_ygrid(:), w_w(:)
  integer(kind=8) :: ilong
  !
  integer :: ithread, nthread
  !$ integer(kind = OMP_lock_kind) :: lck
  real(8) :: elapsed_s, elapsed_e, elapsed
  real :: local_wfft(2*max(nx,ny))
  !
  data blc/4*0/, trc/4*0/
  !------------------------------------------------------------------------
  !
  ! Code ----
  call imager_tree('MX_BEAM',.false.)
  !
  nd = nx*ny
  nc = huv%gil%nchan
  !
  ! Reset the parameters
  xparm = 0.0
  yparm = 0.0
  !
  vref = huv%gil%ref(1)
  voff = huv%gil%voff
  vinc = huv%gil%vres
  if (mcol(1).eq.0) then
    mcol(1) = 1
  else
    mcol(1) = max(1,min(mcol(1),nc))
  endif
  if (mcol(2).eq.0) then
    mcol(2) = nc
  else
    mcol(2) = max(1,min(mcol(2),nc))
  endif
  fcol = min(mcol(1),mcol(2))
  lcol = max(mcol(1),mcol(2))
  if (wcol.eq.0) then
    wcol = (fcol+lcol)/3
  endif
  wcol = max(1,wcol)
  wcol = min(wcol,nc)
  nc = lcol-fcol+1
  !
  ! Compute observing sky frequency for U,V cell size
  freq = gdf_uv_frequency(huv, 0.5d0*dble(lcol+fcol) )
  !
  ! Compute gridding function
  ctypx = map%ctype
  ctypy = map%ctype
  call grdflt (ctypx, ctypy, xparm, yparm)
  call convfn (ctypx, xparm, conv%ubuff, conv%ubias)
  call convfn (ctypy, yparm, conv%vbuff, conv%vbias)
  map%uvcell = clight/freq/(map%xycell*map%size)
  map%support(1) = xparm(1)*map%uvcell(1)  ! In meters
  map%support(2) = yparm(1)*map%uvcell(2)
  !
  ! Load V values and original Weights
  icol = 3*wcol + 7
  allocate(w_w(nv),stat=ier)
  call dovisi (nu,nv,uvdata,w_v,w_w,icol)
  !
  ! Compute weights
  if (do_weig) then
    call doweig (nu,nv,   &
       &    uvdata,   &          ! Visibilities
       &    1,2,   &             ! U, V pointers
       &    wcol,   &            ! Weight channel
       &    map%uniform(1),   &  ! Uniform UV cell size
       &    w_weight,   &        ! Weight array
       &    map%uniform(2),   &  ! Fraction of weight
       &    error)
    if (error)  return
    !
    ! Should also plug the TAPER here, rather than in DOFFT later  !
    call dotape (nu,nv,   &
       &    uvdata,   &          ! Visibilities
       &    1,2,   &             ! U, V pointers
       &    map%taper,  &        ! Taper
       &    w_weight)            ! Weight array
    do_weig = .false.
  else
    call map_message(seve%i,rname,'Reusing weights')
  endif
  null_taper = 0
  ! For test
  !  else
  !    null_taper = map%taper
  !  endif
  !
  call gag_cpu(cpu1)
  write(chain,102) 'Finished weighting CPU ',cpu1-cpu0
  call map_message(seve%i,rname,chain)
  !
  wall = 0
  do iv=1,nv
    if (w_w(iv).gt.0) wall = wall + w_w(iv)
  enddo
  if (wall.eq.0.0) then
    write(chain,101) 'Plane ',wcol,' has Zero weight'
    call map_message(seve%e,rname,chain)
    error = .true.
    return
  else
    !
    ! Noise definition
    wall = 1e-3/sqrt(wall)
    call prnoise(rname,'Natural',wall,rms)
    !
    ! Re-normalize the weights and re-count the noise
    call scawei (nv,w_weight,w_w,wall)
    wall = 1e-3/sqrt(wall)
    call prnoise(rname,'Expected',wall,rms)
  endif
  deallocate(w_w)
  !
  lx = (uvmax+map%support(1))/map%uvcell(1) + 2
  ly = (uvmax+map%support(2))/map%uvcell(2) + 2
  lx = 2*lx
  ly = 2*ly
  if (ly.gt.ny) then
    write(chain,'(A,A,F8.3)') 'Map cell is too large ',   &
        &      ' Undersampling ratio ',float(ly)/float(ny)
    call map_message(seve%w,rname,chain,3)
    ly = min(ly,ny)
    lx = min(lx,nx)
  endif
  call docoor (lx,-map%uvcell(1),w_mapu)
  call docoor (ly,map%uvcell(2),w_mapv)
  !
  ! Optimize SBLOCK now, allowing some additional memory if NBLOCK small
  if (sblock.gt.0) then
    nblock = (nc+sblock-1)/sblock
    kz = mod(nc,sblock)
    if (kz.ne.0 .and. kz.lt.(sblock/(nblock+1))) then
      if (nblock.ne.1) nblock = nblock-1
    endif
    sblock = (nc+nblock-1)/nblock
    kz = min(sblock,nc)
  else
    kz = nc
    nblock = 1
  endif
  !
  ! Get FFTs work space
  write(chain,101) 'Using a blocking factor of ',sblock,' planes'
  call map_message(seve%i,rname,chain)
  allocate (tfgrid(kz+1,lx,ly),ftbeam(nx,ny),stat=ier)
  ndim = 2
  nn(1) = nx
  nn(2) = ny
  call fourt_plan(ftbeam,nn,ndim,-1,1)
  !
  ! Prepare grid correction,
  !
  allocate(w_xgrid(nx),w_ygrid(ny),stat=ier)
  call grdtab (ny, conv%vbuff, conv%vbias, w_ygrid)
  call grdtab (nx, conv%ubuff, conv%ubias, w_xgrid)
  !
  ! Make beam, not normalized
  call uvmap_headers(huv,nx,ny,1,nc,map,mcol,hbeam,hdirty,error)
  if (error) return
  !
  ! Loop over blocks
  !$ call omp_init_lock(lck)
  !
  kkz = kz
  !$OMP PARALLEL DEFAULT(none) &
  !$OMP PRIVATE(iblock,istart,kz,blc,trc)  &
  !$OMP PRIVATE(tfgrid,ftbeam) &  ! Big arrays
  !$OMP SHARED(nblock, sblock, kkz, nu,nv,nx,ny,nc,nd,fcol,lx,ly, lck,nthread) &
  !$OMP SHARED(w_mapu,w_mapv,map,null_taper) &
  !$OMP SHARED(conv) &
  !$OMP SHARED(nn,ndim,hbeam,hdirty,rname) &
  !$OMP SHARED(w_grid,w_xgrid,w_ygrid,w_v,w_weight,uvdata, wfft) &
  !$OMP PRIVATE(rmi,rma,imi,ima,ilong,chain) &
  !$OMP SHARED(cpu0,cpu1) PRIVATE(elapsed_s, elapsed_e, elapsed, ithread)
  !
  !$OMP MASTER
  nthread = 1
  !$  nthread = omp_get_num_threads()
  if (nblock.lt.nthread) then
    nblock = min(nthread,nc)
    sblock = (nc+nblock-1)/nblock
    write(chain,'(A,I6,A,I8,A)') 'Reset ',nblock,' blocks of ',&
      & sblock,' channels for Threading'
    call map_message(seve%w,rname,chain)
    kkz = sblock
  endif
  !$OMP END MASTER
  !$OMP BARRIER
  !
  !$OMP DO
  do iblock = 1,nblock
    !$ elapsed_s = omp_get_wtime()
    !$ ithread = omp_get_thread_num()
    !$ if (iblock.eq.1) call omp_set_lock(lck)
    !
    istart = fcol+(iblock-1)*sblock
    blc(3) = (iblock-1)*kkz+1
    kz = min (sblock,nc-sblock*(iblock-1))
    trc(3) = blc(3)-1+kz
    !
    ! This is the power-hungry routine...
    call dofft (nu,nv,             &   ! Size of visibility array
         &        uvdata,          &   ! Visibilities
         &        1,2,             &   ! U, V pointers
         &        istart,          &   ! First channel to map
         &        kz,lx,ly,        &   ! Cube size
         &        tfgrid,          &   ! FFT cube
         &        w_mapu,w_mapv,   &   ! U and V grid coordinates
         &        map%support,map%uvcell,null_taper,   &    ! Gridding parameters
         &        w_weight,        &   ! Weight array
         &        conv%ubias,conv%vbias,conv%ubuff,conv%vbuff,map%ctype)
    !
    ! Should one beam per block be created, this test can be
    ! easily modified
    if (iblock.eq.1) then
      call map_message(seve%i,rname,'Creating beam ')
      !
      call extracs(kz+1,nx,ny,kz+1,tfgrid,ftbeam,lx,ly)
      call fourt  (ftbeam,nn,ndim,-1,1,wfft)
      call cmtore (ftbeam,hbeam%r3d(:,:,1),nx,ny)
      !
      ! Compute Grid correction and Free the Grid lock
      ! Normalization factor is applied to grid correction,
      ! for further use on beam and channel maps.
      call dogrid (w_grid,w_xgrid,w_ygrid,nx,ny,hbeam%r3d(:,:,1))
      !$ call omp_unset_lock(lck)
      !
      ! Normalize and Free beam
      call docorr (hbeam%r3d(:,:,1),w_grid,nd)
      rma = -1e38
      rmi = 1e38
      call domima (hbeam%r3d(:,:,1),rmi,rma,imi,ima,nd)
      hbeam%gil%extr_words = def_extr_words          ! extrema computed
      hbeam%gil%rmax = rma
      hbeam%gil%rmin = rmi
      ilong = imi
      call gdf_index_to_where (ilong,hbeam%gil%ndim,hbeam%gil%dim,hbeam%gil%minloc)
      ilong = ima
      call gdf_index_to_where (ilong,hbeam%gil%ndim,hbeam%gil%dim,hbeam%gil%maxloc)
      !
      !$ elapsed_e = omp_get_wtime()
      elapsed = elapsed_e - elapsed_s
      write(chain,102) 'Finished Beam, Elapsed ',elapsed
      call map_message(seve%i,rname,chain)
      call map_message(seve%i,rname,'Creating map file ')
    endif
    !
    ! Wait for gridding correction to be computed
    !$  call omp_set_lock(lck)
    ! but free lock immediately, as no further waiting is needed.
    !$  call omp_unset_lock(lck)
    ! In general, the time spent here is negligible,
    ! so Parallel Nesting is not needed,
    ! but this is not always the case...
    !$OMP PARALLEL DEFAULT(none) &
    !$OMP & PRIVATE(i,iz,ftbeam,local_wfft) &
    !$OMP & SHARED(lck,nx,ny,nd,nn,ndim,lx,ly,iblock,kz,kkz) &
    !$OMP & SHARED(hdirty,w_grid,tfgrid)
    !$OMP DO
    do i=1,kz
      iz = i+(iblock-1)*kkz
      call extracs(kz+1,nx,ny,i,tfgrid,ftbeam,lx,ly)
      call fourt  (ftbeam,nn,ndim,-1,1,local_wfft)
      call cmtore (ftbeam,hdirty%r3d(:,:,iz),nx,ny)
      call docorr (hdirty%r3d(:,:,iz),w_grid,nd)
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
    !$  elapsed_e = omp_get_wtime()
    elapsed = elapsed_e - elapsed_s
    write(chain,103) 'End planes ',blc(3),trc(3),' Time ',elapsed &
      & ,' Block ',iblock,' Thread ',ithread
    call map_message(seve%i,rname,chain)
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  !$  call omp_destroy_lock(lck)
  !
  call gag_cpu(cpu1)
  write(chain,102) 'Finished maps ',cpu1-cpu0
  call map_message(seve%i,rname,chain)
  !
  hdirty%gil%extr_words = def_extr_words  ! extrema computed
  hdirty%gil%minloc = 1
  hdirty%gil%maxloc = 1
  hdirty%gil%minloc(1:3) = minloc(hdirty%r3d)
  hdirty%gil%maxloc(1:3) = maxloc(hdirty%r3d)
  rma = hdirty%r3d(hdirty%gil%maxloc(1),hdirty%gil%maxloc(2),hdirty%gil%maxloc(3))
  rmi = hdirty%r3d(hdirty%gil%minloc(1),hdirty%gil%minloc(2),hdirty%gil%minloc(3))
  hdirty%gil%rmax = rma
  hdirty%gil%rmin = rmi
  hdirty%gil%nois_words = 2
  hdirty%gil%noise = wall
  !  
  ! Delete scratch space
  error = .false.
  if (allocated(tfgrid)) deallocate(tfgrid)
  if (allocated(ftbeam)) deallocate(ftbeam)
  if (allocated(w_xgrid)) deallocate(w_xgrid)
  if (allocated(w_ygrid)) deallocate(w_ygrid)
  call imager_tree('MX_BEAM',.true.)
  return
  !
101 format(a,i6,a)
102 format(a,f9.2)
103 format(a,i5,' to ',i5,a,f9.2,a,i2,a,i2)
end subroutine mx_beam
!
subroutine mx_clean (map,huv,uvdata,uvp,uvv,   &
     &    method,hdirty,hbeam,hclean,hresid,hprim,   &
     &    w_grid,w_mapu,w_mapv, cct_list, dcct, smask, slist,   &
     &    sblock, cpu0, uvmax, conv)
  use clean_def
  use image_def
  use gbl_message
  use imager_interfaces, except_this => mx_clean
  !----------------------------------------------------------------------
  ! @ private-mandatory
  !
  ! IMAGER -- 
  !   Implementation of MX CLEAN deconvolution algorithm.
  !----------------------------------------------------------------------
  type (clean_par), intent(inout) :: method !! Clean Method parameters
  type (uvmap_par), intent(inout) :: map    !! UV_MAP parameters
  type (gildas), intent(inout) :: huv       !! UV data
  type (gildas), intent(inout) :: hdirty    !! Dirty cube
  type (gildas), intent(inout) :: hbeam     !! Dirty beam
  type (gildas), intent(inout) :: hclean    !! Clean cube
  type (gildas), intent(inout) :: hresid    !! Residual cube
  type (gildas), intent(inout) :: hprim     !! Primary beams
  real, intent(inout) :: dcct(3,hclean%gil%dim(3),*)  !! Clean components
  logical, intent(inout) :: smask(:,:)      !! Source mask ?
  integer, intent(in) :: slist(*)           !! Search list
  integer, intent(in) :: sblock             !! Blocking factor
  real, intent(inout) :: uvdata(huv%gil%dim(1),huv%gil%dim(2))  !! UV data
  real, intent(in) :: uvp(:)          !!
  real, intent(in) :: uvv(:)          !! V values
  real, intent(inout) :: w_grid(:,:)  !! Gridded weights
  real, intent(inout) :: w_mapu(:)    !! U grid
  real, intent(inout) :: w_mapv(:)    !! V grid
  real, intent(in) :: cpu0            !! CPU counter
  real, intent(inout) :: uvmax        !! Maximum baseline
  type (cct_lst), intent(inout) :: cct_list   !! Clean component list
  type(gridding), intent(in) :: conv  !! Gridding convolution kernels.
  !
  character(len=*), parameter :: rname = 'MX'
  !
  ! Local ---
  logical :: error
  integer nx,ny,nz,nf, mc,nclean, i, nu,nv
  real fhat
  real, allocatable :: mapx(:), mapy(:)
  real, pointer :: p_resid(:,:)
  real, pointer :: p_clean(:,:)
  real, pointer :: p_beam(:,:,:)
  real, pointer :: p_prim(:,:,:)   ! Primary beam
  real, pointer :: p_atten(:,:,:) ! Mosaic weight
  type(cct_par), allocatable :: p_comp(:)      ! Clean values
  complex, allocatable :: p_work(:,:)
  real, allocatable :: p_tfbeam(:,:,:)
  integer, allocatable :: p_niter(:)
  real, allocatable :: w_fft(:)
  real, dimension(1,1,1), target ::dummy3d
  integer ier,iplane
  character(len=message_length) :: chain
  !
  ! Code ----
  nx = hdirty%gil%dim(1)
  ny = hdirty%gil%dim(2)
  mc = method%m_iter
  !
  ! Get some memory
  allocate (p_work(nx,ny),p_tfbeam(nx,ny,1),stat=ier)
  nclean = nx*ny
  allocate (p_comp(nclean),stat=ier)
  allocate (mapx(nx),mapy(ny),stat=ier)
  allocate (w_fft(max(nx,ny)),stat=ier)
  !
  call loadxy (method,huv,hdirty,mapx,nx,mapy,ny)
  !
  ! Prepare beam parameters
  method%ibeam = 1             ! Test
  method%iplane = 1            ! Test
  error = .false.
  call get_clean (method,hbeam,hbeam%r3d,error)
  if (error) return
  call get_beam (method%ibeam,method%verbose, &
     &  method,hbeam,hresid,hprim,.false.,  &
     &  p_tfbeam,p_work,w_fft,fhat,error)
  if (error) return
  !
  ! Find components in all planes...
  nz = max(hdirty%gil%dim(3),1)
  allocate (p_niter(nz),stat=ier)
  nf = max(1,hprim%gil%dim(1))
  p_beam  => hbeam%r3d(:,:,1:1)
  if (method%mosaic) then
    p_prim => hprim%r3d
    p_atten=> method%atten
  else
    p_prim => dummy3d
    p_atten=> dummy3d
  endif
  !
  ! Loop here if needed
  nu = huv%gil%dim(1)
  nv = huv%gil%nvisi  ! not %dim(2)
  do iplane = method%first, method%last
    !
    method%iplane = iplane
    call beam_plane(method,hbeam,hdirty)
    write(chain,'(A,I6,I6)') 'Image & Beam planes ',   &
        &      method%iplane,method%ibeam
    !omp!$ chain = trim(chain)//cthread
    call map_message(seve%d,rname,chain)
    !
    method%iplane = iplane
    p_resid => hresid%r3d(:,:,iplane)
    p_clean => hclean%r3d(:,:,iplane)
    p_beam  => hbeam%r3d(:,:,method%ibeam:method%ibeam)
    !
    call get_clean (method, hbeam, p_beam, error)
    !
    call mx_major_cycle90 (map,uvdata,   &
     &      nu,nv,uvp,uvv,   &
     &      method,hdirty,   &
     &      p_clean,p_beam,p_resid,   &
     &      nx,ny,1,         &
     &      p_comp,nclean,   &
     &      cct_list, p_niter(iplane),   &
     &      slist, method%nlist,   &
     &      nf, p_prim, p_atten,   &
     &      w_grid, w_mapu, w_mapv, mapx, mapy,   &
     &      p_tfbeam, cpu0, uvmax, conv)
    !
    ! Add clean components to clean map
    write(chain,1001) 'Restoring plane ',iplane
    call map_message(seve%d,rname,chain)
    ! Could be replaced by CLEAN_MAKE90... to be checked...
    if (p_niter(iplane).ne.0) then
      !! Print *,'adding residual '
      call clean_make(method,hclean,p_clean,cct_list%cc)
      p_clean = p_clean+p_resid
    else
      p_clean = p_resid
    endif
!
    do i=1,method%n_iter
       dcct(1,iplane,i) = (dble(cct_list%cc(i)%ix) -   &
         &          hclean%gil%convert(1,1)) * hclean%gil%convert(3,1) + &
         &          hclean%gil%convert(2,1)
       dcct(2,iplane,i) = (dble(cct_list%cc(i)%iy) -   &
         &          hclean%gil%convert(1,2)) * hclean%gil%convert(3,2) + &
         &          hclean%gil%convert(2,2)
       dcct(3,iplane,i) = cct_list%cc(i)%value
    enddo
  enddo
  !
  ! Clean-up
  if (allocated(p_work)) deallocate(p_work)
  if (allocated(p_tfbeam)) deallocate(p_tfbeam)
  if (allocated(p_comp)) deallocate(p_comp)
  if (allocated(mapx)) deallocate(mapx)
  if (allocated(mapy)) deallocate(mapy)
  if (allocated(w_fft)) deallocate(w_fft)
  if (allocated(p_niter)) deallocate(p_niter)
  return
  !
  1001  format(a,i5,i5)
end subroutine mx_clean
!
subroutine loadxy (method,huv,head,mapx,nx,mapy,ny)
  use clean_def
  use image_def
  !--------------------------------------------------
  ! @ private
  !
  ! IMAGER -- MX utility -- Load x,y coordinates
  !--------------------------------------------------
  type (clean_par), intent(in) :: method  !! Clean parameters
  type (gildas), intent(in) :: huv    !! UV data header
  type (gildas), intent(in) :: head   !! Cube header
  integer, intent(in) :: nx           !! X size
  integer, intent(in) :: ny           !! Y size
  real, intent(out) :: mapx(nx)       !! X coordinates
  real, intent(out) :: mapy(ny)       !! Y coordinates
  !
  ! Constants
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: f_to_k = 2.d0*pi/299792458.d-6
  !
  ! Local ---
  integer :: i
  real :: pidsur                  ! 2*pi*D/Lambda
  real(8) :: freq
  !
  ! Code ----
  freq = huv%gil%convert(2,1)+huv%gil%fres*   &
     &    ((method%first+method%last)*0.5-huv%gil%convert(1,1))
  pidsur = f_to_k * freq
  !
  do i=1,nx
    mapx(i) = pidsur*((i-head%gil%convert(1,1))*head%gil%convert(3,1)   &
     &      +head%gil%convert(2,1))
  enddo
  do i=1,ny
    mapy(i) = pidsur*((i-head%gil%convert(1,2))*head%gil%convert(3,2)   &
     &      +head%gil%convert(2,2))
  enddo
end subroutine loadxy
