!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module clean_mx
  use gbl_message
  !
  public :: old_mx_comm
  public :: domima
  private
  !
contains
  !
  subroutine old_mx_comm(line,error)
    use phys_const, only: pi
    use gkernel_interfaces
    use uv_continuum, only: map_beams,map_parameters
    use uv_shift, only: map_get_radecang
    use uv_rotate_shift_and_sort_tool, only: uv_sort_main
    use uvmap_tool, only: map_prepare,new_dirty_beam
    use uvmosaic_tool, only: many_beams_para
    use clean_tool, only: check_area,cct_prepare,clean_data
    use clean_support_tool, only: check_mask
    use clean_flux_tool, only: init_plot,init_flux,close_flux
    use clean_types, only: beam_unit_conversion
    use map_buffers
    use file_buffers
    use uv_buffers
    use uvmap_buffers
    use clean_buffers
    !------------------------------------------------------------------------
    ! 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)    :: line
    logical,          intent(inout) :: error
    real(8), parameter :: f_to_k = 2.d0*pi/299792458.d-6
    !
    real, allocatable :: w_mapu(:), w_mapv(:), w_grid(:,:)
    real, allocatable :: res_uv(:,:)
    real(8) new(3)
    logical :: found(3)
    real(4) rmega,uvmax,uvmin,uvma
    integer wcol,mcol(2),nfft,sblock
    integer ier
    logical one, sorted, shift
    character(len=message_length) :: chain
    real cpu0, cpu1
    real(8) :: freq
    real, allocatable :: fft(:)
    integer nx,ny,nu,nv,nc,np,nb
    !
    logical limits
    real ylimn,ylimp
    integer ipen
    !
    integer, save :: saved_mcol(2)=[0,0]
    character(len=*), parameter :: rname='MX'
    !
    if (uvmap_prog%nfields.ne.0) then
       call map_message(seve%e,rname,'UV data is a Mosaic, not supported')
       error = .true.
       return
    endif
    !
    call map_prepare(rname,uvmap_prog,error)
    if (error) return
    !
    if (rname.eq.'MX') then
       if (uvmap_prog%beam.ne.0) then
          call map_message(seve%e,rname,'Only works of 1 beam in total (so far)')
          error = .true.
          return
       endif
    endif
    !
    one = .true.
    call sic_get_inte('WCOL',wcol,error)
    call sic_get_inte('MCOL[1]',mcol(1),error)
    call sic_get_inte('MCOL[2]',mcol(2),error)
    !
    call sic_get_logi('UV_SHIFT',shift,error)
    if (shift) then
       ! Read MAP_RA, MAP_DEC, MAP_ANGLE
       call map_get_radecang(rname,found,new,error)
       if (error)  return
       if (.not.all(found)) then
          call map_message(seve%e,rname,'MAP_RA and MAP_DEC must be defined')
          error = .true.
          return
       endif
    else
       new(:) = 0.d0
    endif
    !
    ! First sort the input UV Table, leaving UV Table in UV_*
    call gag_cpu(cpu0)
    call uv_sort_main(error,sorted,shift,new,uvmax,uvmin)
    if (error) return
    if (.not.sorted) then
       ! Redefine SIC variables (mandatory)
       call sic_delvariable ('UV',.false.,error)
       call sic_mapgildas('UV',huv,error,duv)
    endif
    call gag_cpu(cpu1)
    write(chain,102) 'Finished sorting ',cpu1-cpu0
    call map_message(seve%i,rname,chain)
    !
    call map_parameters(rname,uvmap_prog,freq,uvmax,uvmin,error) ! huv%gil%majo)
    if (error) return
    uvma = uvmax/(freq*f_to_k)
    !
    uvmap_prog%xycell = uvmap_prog%xycell*pi/180.0/3600.0
    !
    ! Get work space, ideally before mapping first image, for
    ! memory contiguity reasons.
    !
    nx = uvmap_prog%size(1)
    ny = uvmap_prog%size(2)
    nu = huv%gil%dim(1)
    nv = huv%gil%dim(2)
    !
    ! Define the number of output channels
    nc = huv%gil%nchan
    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
    nc = mcol(2)-mcol(1)+1
    !
    ! Check if Weights have changed by MCOL choice
    if (any(saved_mcol.ne.mcol)) do_weig = .true.
    saved_mcol = mcol
    !
    if (clean_prog%method.eq.'MX') do_weig = .true. ! Test
    if (do_weig) then
       call map_message(seve%i,rname,'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,rname,'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(dirty%data)) then
       call sic_delvariable ('DIRTY',.false.,error)
       deallocate(dirty%data)
    endif
    allocate(dirty%data(nx,ny,nc),stat=ier)
    !
    call gildas_null(dirty%head)
    dirty%head%gil%ndim = 3
    dirty%head%gil%dim(1:3) = (/nx,ny,nc/)
    call sic_mapgildas('DIRTY',dirty%head,error,dirty%data)
    !
    dirty%head%r3d => dirty%data
    !
    ! Find out how many beams are required
    call map_beams(rname,uvmap_prog%beam,huv,nx,ny,nb,nc)
    !
    ! Process sorted UV Table according to the number of beams produced
    if (map_buffer%version.eq.-1 .or. rname.eq.'MX') then
       ! The 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,rname,'Memory allocation error on DBEAM')
          error =.true.
          return
       endif
       call sic_mapgildas('BEAM',hbeam,error,dbeam)
       hbeam%r3d => dbeam(:,:,:,1)
       !
       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
       call one_beam (rname,uvmap_prog,   &
            &    huv, hbeam, dirty%head,   &
            &    nx,ny,nu,nv, duv,   &
            &    w_mapu, w_mapv, w_grid, &
            &    g_weight, g_v, do_weig,  &
            &    wcol,mcol,fft,   &
            &    sblock,cpu0,error,uvma)
    else
       ! The MX part still needs debugging
       !
       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,rname,'Memory allocation error on DBEAM')
          error =.true.
          return
       endif
       !
       call many_beams_para (rname,uvmap_prog,   &
            &    huv, hbeam, dirty%head,   &
            &    nx,ny,nu,nv, duv,   &
            &    g_weight, g_v, do_weig,  &
            &    wcol,mcol,sblock,cpu0,error,uvma,0)
       !
       ! 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
       !
    endif
    if (.not.error) call map_message(seve%i,rname,'Successful completion')
    save_data(code_save_beam) = .true.
    save_data(code_save_dirty) = .true.
    !
    call new_dirty_beam(error)
    if (error) return
    !
    ! Define Min Max
    d_max = dirty%head%gil%rmax
    if (dirty%head%gil%rmin.eq.0) then
       d_min = -0.03*dirty%head%gil%rmax
    else
       d_min = dirty%head%gil%rmin
    endif
    !
    if (rname.ne.'MX') goto 99
    !
    !---------------------------------------------------
    !
    ! 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(clean_prog%m_iter+200) *   &
            &      log(float(clean_prog%m_iter+1)) ) * clean_prog%gain
       if (-dirty%head%gil%rmin.gt.1.3*dirty%head%gil%rmax) then
          ylimn = ylimp*dirty%head%gil%rmin
          ylimp = 0.0
       elseif (-1.3*dirty%head%gil%rmin.gt.dirty%head%gil%rmax) then
          ylimn = 0.0
          ylimp = ylimp*dirty%head%gil%rmax
       else
          ylimn = ylimp*dirty%head%gil%rmin
          ylimp = ylimp*dirty%head%gil%rmax
       endif
    endif
    np = max(1,primbeam%head%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...
    clean%head%r3d => clean%data
    resid%head%r3d => resid%data
    resid%data(:,:,:) = dirty%data
    hbeam%r4d => dbeam ! Also required for MX
    !
    ! Parameter Definitions
    call beam_unit_conversion(clean_user)
    call clean_user%copyto(clean_prog)
    clean_prog%method = 'MX'
    clean_prog%pflux = sic_present(1,0)
    clean_prog%pcycle = sic_present(2,0)
    clean_prog%qcycle = sic_present(3,0)
    clean_prog%pclean = .false.
    clean_prog%pmrc = .false.
    !
    call sic_get_inte('FIRST',clean_prog%first,error)
    call sic_get_inte('LAST',clean_prog%last,error)
    if (clean_prog%first.eq.0) clean_prog%first = 1
    if (clean_prog%last.eq.0) clean_prog%last = dirty%head%gil%dim(3)
    clean_prog%first = max(1,min(clean_prog%first,dirty%head%gil%dim(3)))
    clean_prog%last = max(clean_prog%first,min(clean_prog%last,dirty%head%gil%dim(3)))
    !
    ! Other parameters
    if (clean_user%patch(1).ne.0) then
       clean_prog%patch(1) = min(clean_user%patch(1),nx)
    else
       clean_prog%patch(1) = min(nx,max(32,nx/4))
    endif
    if (clean_user%patch(2).ne.0) then
       clean_prog%patch(2) = min(clean_user%patch(2),nx)
    else
       clean_prog%patch(2) = min(nx,max(32,nx/4))
    endif
    clean_prog%bzone = (/1,1,nx,ny/)
    !
    call check_area(clean_prog,dirty%head,.false.)
    call check_mask(clean_prog,dirty%head)
    clean_user%do_mask = clean_prog%do_mask
    !
    ! Clean Component Structure (once it is defined, i.e. after check)
    allocate(tcc(clean_prog%m_iter),stat=ier)
    if (ier.ne.0) then
       call map_message(seve%e,rname,'Memory allocation error on MX CCT')
       error = .true.
       return
    endif
    !
    ! Prepare the CCT data
    call cct_prepare(line,nv,clean_prog,rname,error)
    if (error) return
    !
    if (clean_prog%pflux) call init_flux(clean_prog,dirty%head,ylimn,ylimp,ipen)
    if (clean_prog%pcycle) call init_plot(clean_prog,dirty%head,resid%data)
    !
    ! Perform the cleaning
    call mx_clean (uvmap_prog,huv,res_uv,g_weight,g_v,       &
         &    clean_prog,dirty%head,hbeam,clean%head,resid%head,primbeam%head,   &
         &    w_grid,w_mapu,w_mapv,tcc,cct%data,d_mask,d_list,      &
         &    sblock, cpu0, uvma)
    !
    if (clean_prog%pflux) then
       call close_flux(ipen,error)
    else
       call gr_execl('CHANGE DIRECTORY <GREG')
    endif
    !
    ! Reset extrema
    resid%head%gil%extr_words = 0
    clean%head%gil%extr_words = 0
    !
    ! Specify clean beam parameters
    clean%head%gil%reso_words = 3
    clean%head%gil%majo = clean_prog%major
    clean%head%gil%mino = clean_prog%minor
    clean%head%gil%posa = pi*clean_prog%angle/180.0
    save_data(code_save_clean) = .true.
    clean_user%nlist = clean_prog%nlist
    ! Cleanup
    deallocate(tcc)
    error = .false.
    !
99  continue
    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)
    return
    !
98  call map_message(seve%e,rname,'Memory allocation failure')
    error = .true.
    return
    !
102 format(a,f9.2)
  end subroutine old_mx_comm
  !
  subroutine one_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)
    use gkernel_interfaces
    use image_def
    use omp_buffers
    use uvmap_types
    !------------------------------------------------------------------------
    ! 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
    ! Workspace:
    !    a  VLM complex Fourier cube (first V value is for beam)
    !------------------------------------------------------------------------
    character(len=*), intent(in)    :: rname
    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)
    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
    !
    real,             intent(inout) :: wfft(*)        ! Work space
    real,             intent(inout) :: cpu0           ! CPU
    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
    !
    if (omp%single_beam.eq.0) then
       print *,'Calling SERIAL one_beam'
       call one_beam_serial(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)
    else
       print *,'Calling PARALLEL one_beam'
       call one_beam_para(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)
    endif
  end subroutine one_beam
  !
  ! Sblock is the Blocking factor
  ! Experience shows that the efficiency does not
  ! increase with large blocking factors. Values of order
  ! 16 are often sufficient and even optimal.
  !   Huge values (e.g. 1024) yield a penalty.
  ! This drives from the fact that gridding is essentially
  ! memory access limited, so page fault dominate.
  ! In the presence of Multi-Threading, a good policy is
  ! be to have the number of blocks being a multiple of
  ! the number of threads.
  !
  subroutine one_beam_para(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)
    use image_def
    use gkernel_interfaces
    use mapping_interfaces
    use uvmap_types
    use uvstat_tool, only: prnoise
    !$ use omp_lib
    !------------------------------------------------------------------------
    ! 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
    ! Workspace:
    !    a VLM complex Fourier cube (first V value is for beam)
    !------------------------------------------------------------------------
    character(len=*), intent(in)    :: rname
    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)
    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
    !
    real,             intent(inout) :: wfft(*)        ! Work space
    real,             intent(inout) :: cpu0           ! CPU
    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
    !
    real(kind=8), parameter :: clight=299792458d-6 ! Frequency in  MHz
    !
    real ubias,vbias,ubuff(4096),vbuff(4096)
    common /conv/ ubias,vbias,ubuff,vbuff ! To be saved
    !
    integer :: nc   ! Number of channels
    integer :: nd   ! Size of data
    integer :: ier
    integer :: ctypx,ctypy
    integer :: icol,lcol,fcol,imi,ima,iv
    integer :: ndim, nn(2), i, lx, ly
    integer :: istart,iblock,nblock,kz,iz,kkz
    integer :: blc(4),trc(4)
    integer(kind=8) :: ilong
    real :: rmi,rma,wall,cpu1
    real :: xparm(10),yparm(10)
    real :: vref,voff,vinc
    real :: rms,null_taper(4)
    real(kind=4) :: loff,boff
    real(kind=8) :: freq
    real :: local_wfft(2*max(nx,ny))
    real, allocatable :: w_xgrid(:),w_ygrid(:),w_w(:)
    complex, allocatable :: ftbeam(:,:)
    complex, allocatable :: tfgrid(:,:,:)
    character(len=message_length) :: chain
    !
    !
    !$ integer(kind = OMP_lock_kind) :: lck
    integer :: ithread,nthread
    real(8) :: elapsed_s,elapsed_e,elapsed
    data blc/4*0/, trc/4*0/
    !
    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, ubuff, ubias)
    call convfn (ctypy, yparm, vbuff, 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
            &    w_v,              &  ! V values
            &    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) then
          wall = wall + w_w(iv)
       endif
    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%e,rname,chain)
       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 FFT's 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, vbuff, vbias, w_ygrid)
    call grdtab (nx, ubuff, ubias, w_xgrid)
    !
    ! Make beam, not normalized
    call gdf_copy_header(huv,hbeam,error)
    hbeam%gil%dopp = 0    ! Nullify the Doppler factor
    !
    hbeam%gil%ndim = 2
    hbeam%gil%dim(1) = nx
    hbeam%gil%dim(2) = ny
    hbeam%gil%dim(3) = 1
    hbeam%gil%dim(4) = 1
    hbeam%gil%convert(1,1) = nx/2+1
    hbeam%gil%convert(1,2) = ny/2+1
    hbeam%gil%convert(2,1) = 0
    hbeam%gil%convert(2,2) = 0
    hbeam%gil%convert(3,1) = -map%xycell(1)  ! Assume EQUATORIAL system
    hbeam%gil%convert(3,2) = map%xycell(2)
    hbeam%gil%proj_words = 0
    hbeam%gil%extr_words = 0
    hbeam%gil%reso_words = 0
    hbeam%gil%uvda_words = 0
    hbeam%gil%type_gdf = code_gdf_image
    !
    hbeam%char%code(1) = 'ANGLE'
    hbeam%char%code(2) = 'ANGLE'
    hbeam%gil%majo = 0.0
    hbeam%loca%size = nx*ny
    hbeam%char%type = 'GILDAS_IMAGE'
    !
    ! Prepare the dirty map header
    call gdf_copy_header(hbeam,hdirty,error)
    hdirty%gil%ndim = 3
    hdirty%gil%dim(1) = nx
    hdirty%gil%dim(2) = ny
    hdirty%gil%dim(3) = nc
    hdirty%gil%dim(4) = 1
    hdirty%gil%convert(1,3) = vref-fcol+1
    hdirty%gil%convert(2,3) = voff
    hdirty%gil%convert(3,3) = vinc
    hdirty%gil%proj_words = def_proj_words
    hdirty%gil%uvda_words = 0
    hdirty%gil%type_gdf = code_gdf_image
    hdirty%char%code(1) = 'RA'
    hdirty%char%code(2) = 'DEC'
    hdirty%char%code(3) = 'VELOCITY'
    call equ_to_gal(hdirty%gil%ra,hdirty%gil%dec,0.0,0.0,&
         hdirty%gil%epoc,hdirty%gil%lii,hdirty%gil%bii,loff,boff,error)
    if (huv%gil%ptyp.eq.p_none) then
       hdirty%gil%ptyp = p_azimuthal  ! Azimuthal (Sin)
       hdirty%gil%pang = 0.d0     ! Defined in table.
       hdirty%gil%a0 = hdirty%gil%ra
       hdirty%gil%d0 = hdirty%gil%dec
    else
       hdirty%gil%ptyp = p_azimuthal
       hdirty%gil%pang = huv%gil%pang ! Defined in table.
       hdirty%gil%a0 = huv%gil%a0
       hdirty%gil%d0 = huv%gil%d0
    endif
    hdirty%char%syst = 'EQUATORIAL'
    hdirty%gil%xaxi = 1
    hdirty%gil%yaxi = 2
    hdirty%gil%faxi = 3
    hdirty%gil%extr_words = 0          ! extrema not computed
    hdirty%gil%reso_words = 0          ! no beam defined
    hdirty%gil%nois_words = 2
    hdirty%gil%majo = 0
    hdirty%gil%noise = wall
    hdirty%char%unit = 'Jy/beam'
    hdirty%char%type = 'GILDAS_IMAGE'
    hdirty%loca%size = nx*ny*nc
    !
    ! 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(ubias,vbias,ubuff,vbuff) &
    !$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,w_v,   &    ! Weight array
            &        ubias,vbias,ubuff,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
    !
    ! 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)
    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 one_beam_para
  !
  subroutine one_beam_serial(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)
    use image_def
    use gkernel_interfaces
    use mapping_interfaces
    use uvmap_types
    use uvstat_tool, only: prnoise
    !------------------------------------------------------------------------
    ! 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
    ! Workspace:
    !    a VLM complex Fourier cube (first V value is for beam)
    !------------------------------------------------------------------------
    character(len=*), intent(in)    :: rname
    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)
    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
    !
    real,             intent(inout) :: wfft(*)        ! Work space
    real,             intent(inout) :: cpu0           ! CPU
    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
    !
    real(kind=8), parameter :: clight=299792458d-6 ! Frequency in  MHz
    !
    real ubias,vbias,ubuff(4096),vbuff(4096)
    common /conv/ ubias,vbias,ubuff,vbuff ! To be saved
    !
    integer :: nc   ! Number of channels
    integer :: nd   ! Size of data
    integer :: ier
    integer :: ctypx,ctypy
    integer :: icol,lcol,fcol,imi,ima,iv
    integer :: ndim, nn(2), i, lx, ly
    integer :: istart,iblock,nblock,kz,iz,kkz
    integer :: blc(4),trc(4)
    integer(kind=8) :: ilong
    real :: rmi,rma,wall,cpu1
    real :: xparm(10),yparm(10)
    real :: vref,voff,vinc
    real :: rms,null_taper(4)
    real(kind=4) :: loff,boff
    real(kind=8) :: freq
    !
    real :: local_wfft(2*max(nx,ny))
    real, allocatable :: w_xgrid(:),w_ygrid(:), w_w(:)
    complex, allocatable :: ftbeam(:,:)
    complex, allocatable :: tfgrid(:,:,:)
    character(len=message_length) :: chain
    data blc/4*0/, trc/4*0/
    !
    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, ubuff, ubias)
    call convfn (ctypy, yparm, vbuff, 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
            &    w_v,              &  ! V values
            &    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) then
          wall = wall + w_w(iv)
       endif
    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%e,rname,chain)
       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 FFT's 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)
    !
    ! Compute FFT's
    call dofft (nu,nv,   &       ! Size of visibility array
         &    uvdata,   &          ! Visibilities
         &    1,2,   &             ! U, V pointers
         &    fcol,   &            ! 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,w_v,   &    ! Weight array + V Visibilities
         &    ubias,vbias,ubuff,vbuff,map%ctype)
    call gag_cpu(cpu1)
    write(chain,102) 'Finished gridding CPU ',cpu1-cpu0
    call map_message(seve%i,rname,chain)
    !
    ! Make beam, not normalized
    call gdf_copy_header(huv,hbeam,error)
    hbeam%gil%dopp = 0    ! Nullify the Doppler factor
    !
    hbeam%gil%ndim = 2
    hbeam%gil%dim(1) = nx
    hbeam%gil%dim(2) = ny
    hbeam%gil%dim(3) = 1
    hbeam%gil%dim(4) = 1
    hbeam%gil%convert(1,1) = nx/2+1
    hbeam%gil%convert(1,2) = ny/2+1
    hbeam%gil%convert(2,1) = 0
    hbeam%gil%convert(2,2) = 0
    hbeam%gil%convert(3,1) = -map%xycell(1)  ! Assume EQUATORIAL system
    hbeam%gil%convert(3,2) = map%xycell(2)
    hbeam%gil%proj_words = 0
    hbeam%gil%extr_words = 0
    hbeam%gil%reso_words = 0
    hbeam%gil%uvda_words = 0
    hbeam%gil%type_gdf = code_gdf_image
    !
    hbeam%char%code(1) = 'ANGLE'
    hbeam%char%code(2) = 'ANGLE'
    hbeam%gil%majo = 0.0
    hbeam%loca%size = nx*ny
    hbeam%char%type = 'GILDAS_IMAGE'
    call map_message(seve%i,rname,'Creating beam ')
    !
    call extracs(kz+1,nx,ny,kz+1,tfgrid,ftbeam,lx,ly)
    !
    ! For debugging
    !      call sic_descriptor('ffta',desc,found)
    !      if (found) then
    !         jpd = pointer(desc%addr,memory)
    !         call r4tor4 (memory(ipf),memory(jpd),2*nx*ny)
    !      endif
    !
    call fourt  (ftbeam,nn,ndim,-1,1,wfft)
    call cmtore (ftbeam,hbeam%r3d(:,:,1),nx,ny)
    !
    ! Compute grid correction,
    ! Normalization factor is applied to grid correction, for further
    ! use on channel maps.
    !
    allocate(w_xgrid(nx),w_ygrid(ny),stat=ier)
    call grdtab (ny, vbuff, vbias, w_ygrid)
    call grdtab (nx, ubuff, ubias, w_xgrid)
    call dogrid (w_grid,w_xgrid,w_ygrid,nx,ny,   &
         &    hbeam%r3d(:,:,1))
    !
    ! 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)
    !
    ! For debugging
    !      call sic_descriptor('fftb',desc,found)
    !      if (found) then
    !         jpd = pointer(desc%addr,memory)
    !         call r4toc4 (memory(ipy),memory(jpd),nx*ny)
    !         call fourt (memory(jpd),nn,ndim,1,0,wfft)
    !      endif
    !
    call gag_cpu(cpu1)
    write(chain,102) 'Finished beam CPU ',cpu1-cpu0
    call map_message(seve%i,rname,chain)
    !
    ! Create image (in order l m v )
    call map_message(seve%i,rname,'Creating map file ')
    call gdf_copy_header(hbeam,hdirty,error)
    hdirty%gil%ndim = 3
    hdirty%gil%dim(1) = nx
    hdirty%gil%dim(2) = ny
    hdirty%gil%dim(3) = nc
    hdirty%gil%dim(4) = 1
    hdirty%gil%convert(1,3) = vref-fcol+1
    hdirty%gil%convert(2,3) = voff
    hdirty%gil%convert(3,3) = vinc
    hdirty%gil%proj_words = def_proj_words
    hdirty%gil%uvda_words = 0
    hdirty%gil%type_gdf = code_gdf_image
    hdirty%char%code(1) = 'RA'
    hdirty%char%code(2) = 'DEC'
    hdirty%char%code(3) = 'VELOCITY'
    call equ_to_gal(hdirty%gil%ra,hdirty%gil%dec,0.0,0.0,   &
         hdirty%gil%epoc,hdirty%gil%lii,hdirty%gil%bii,loff,boff,error)
    if (huv%gil%ptyp.eq.p_none) then
       hdirty%gil%ptyp = p_azimuthal  ! Azimuthal (Sin)
       hdirty%gil%pang = 0.d0     ! Defined in table.
       hdirty%gil%a0 = hdirty%gil%ra
       hdirty%gil%d0 = hdirty%gil%dec
    else
       hdirty%gil%ptyp = p_azimuthal
       hdirty%gil%pang = huv%gil%pang ! Defined in table.
       hdirty%gil%a0 = huv%gil%a0
       hdirty%gil%d0 = huv%gil%d0
    endif
    hdirty%char%syst = 'EQUATORIAL'
    hdirty%gil%xaxi = 1
    hdirty%gil%yaxi = 2
    hdirty%gil%faxi = 3
    hdirty%gil%extr_words = 0          ! extrema not computed
    hdirty%gil%reso_words = 0          ! no beam defined
    hdirty%gil%nois_words = 2
    hdirty%gil%majo = 0
    hdirty%gil%noise = wall
    hdirty%char%unit = 'Jy/beam'
    hdirty%char%type = 'GILDAS_IMAGE'
    hdirty%loca%size = nx*ny*nc
    !
    ! Make maps with grid correction
    rmi = 1e38
    rma = -1e38
    blc(3) = 1
    trc(3) = kz
    iz = 0
    !
    do i=1,kz
       iz = i
       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
    call gag_cpu(cpu1)
    write(chain,103) 'Finished planes ',blc(3),trc(3),' CPU ',cpu1-cpu0
    call map_message(seve%i,rname,chain)
    !
    ! Proceed with further planes
    if (kz.lt.nc) then
       kkz = kz
       do iblock = 2,nblock
          istart = fcol+(iblock-1)*sblock
          blc(3) = blc(3)+kz
          kz = min (sblock,nc-sblock*(iblock-1))
          trc(3) = blc(3)-1+kz
          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,w_v,   &    ! Weight array
               &        ubias,vbias,ubuff,vbuff,map%ctype)
          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
          call gag_cpu(cpu1)
          write(chain,103) 'Finished planes ',blc(3),trc(3),   &
               &        ' CPU ',cpu1-cpu0
          call map_message(seve%i,rname,chain)
       enddo
    endif
    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
    !
    ! 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)
    return
    !
101 format(a,i6,a)
102 format(a,f9.2)
103 format(a,i5,' to ',i5,a,f9.2)
  end subroutine one_beam_serial
  !
  subroutine domima(a,rmi,rma,imi,ima,n)
    !----------------------------------------------------------
    ! Compute minmax and location
    !----------------------------------------------------------
    integer, intent(in)    :: n
    integer, intent(out)   :: ima,imi
    real,    intent(in)    ::  a(n)
    real,    intent(inout) :: rmi,rma
    !
    integer :: i
    !
    ima = 0
    imi = 0
    if (a(1).gt.rma) then
       rma = a(1)
       ima = 1
    endif
    if (a(1).lt.rmi) then
       rmi = a(1)
       imi = 1
    endif
    do i=2,n
       if (a(i).gt.rma) then
          rma = a(i)
          ima = i
       elseif (a(i).lt.rmi) then
          rmi = a(i)
          imi = i
       endif
    enddo
  end subroutine domima
  !
  subroutine mx_clean (map,huv,uvdata,uvp,uvv,&
       method,hdirty,hbeam,hclean,hresid,hprim,&
       w_grid,w_mapu,w_mapv,p_cct,dcct,smask,slist,&
       sblock,cpu0,uvmax)
    use image_def
    use uvmap_types
    use cct_types
    use clean_types
    use clean_beam_tool, only: get_beam,beam_plane
    !----------------------------------------------------------------------
    ! Implementation of MX CLEAN deconvolution algorithm.
    !----------------------------------------------------------------------
    type(clean_par), intent(inout) :: method
    type(uvmap_par), intent(inout) :: map
    type(gildas),    intent(inout) :: huv
    type(gildas),    intent(inout) :: hdirty
    type(gildas),    intent(inout) :: hbeam
    type(gildas),    intent(inout) :: hclean
    type(gildas),    intent(inout) :: hresid
    type(gildas),    intent(inout) :: hprim
    real,            intent(inout) :: dcct(3,hclean%gil%dim(3),*)
    logical,         intent(inout) :: smask(:,:)
    integer,         intent(in)    :: slist(*)
    integer,         intent(in)    :: sblock
    real,            intent(inout) :: uvdata(huv%gil%dim(1),huv%gil%dim(2))
    real,            intent(in)    :: uvp(*)
    real,            intent(in)    :: uvv(*)
    real,            intent(inout) :: w_grid(*)
    real,            intent(inout) :: w_mapu(*)
    real,            intent(inout) :: w_mapv(*)
    real,            intent(in)    :: cpu0
    real,            intent(inout) :: uvmax
    type(cct_par),   intent(out)   :: p_cct(method%m_iter)
    !
    logical :: error
    integer :: ier,iplane
    integer :: nx,ny,nz,nf,mc,nclean,i,nu,nv
    real :: fhat
    !
    real, pointer :: p_resid(:,:)
    real, pointer :: p_clean(:,:)
    real, pointer :: p_beam(:,:,:)
    real, pointer :: p_prim(:,:,:)          ! Primary beam
    real, pointer :: p_weight(:,:,:)        ! Mosaic weight
    real, target :: dummy3d(1,1,1)
    !
    integer, allocatable :: p_niter(:)
    real, allocatable :: mapx(:),mapy(:)
    real, allocatable :: p_tfbeam(:,:,:)
    real, allocatable :: w_fft(:)
    complex, allocatable :: p_work(:,:)
    type(cct_par), allocatable :: p_comp(:) ! Clean values
    !
    character(len=message_length) :: chain
    character(len=*), parameter :: rname='MX>CLEAN'
    !
    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 method%fit_beam(hbeam,hbeam%r3d,error)
    if (error) return
    call get_beam(method,hbeam,hresid,hprim,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_weight=> method%weight
    else
       p_prim => dummy3d
       p_weight=> dummy3d
    endif
    !
    ! Loop here if needed
    nu = huv%gil%dim(1)
    nv = huv%gil%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%i,rname,chain)
       !
       method%iplane = iplane
       p_resid => hresid%r3d(:,:,iplane)
       p_clean => hclean%r3d(:,:,iplane)
       p_beam  => hbeam%r3d(:,:,method%ibeam:method%ibeam)
       !
       call method%fit_beam(hbeam,p_beam,error)
       if (error) return
       !
       call mx_major_cycle(map,uvdata,   &
            nu,nv,uvp,uvv,   &
            method,hdirty,   &
            p_clean,p_beam,p_resid,   &
            nx,ny,1,         &
            p_comp,nclean,   &
            p_cct, p_niter(iplane),   &
            slist, method%nlist,   &
            nf, p_prim, p_weight,   &
            w_grid, w_mapu, w_mapv, mapx, mapy,   &
            p_tfbeam, cpu0, uvmax)
       !
       ! Add clean components to clean map
       write(chain,1001) 'Restoring plane ',iplane
       call map_message(seve%i,'CLARK',chain)
       ! Could be replaced by CLEAN_MAKE... to be checked...
       if (p_niter(iplane).ne.0) then
          print *,'adding residual '
          call clean_make(method,hclean,p_clean,p_cct)
          p_clean = p_clean+p_resid
       else
          p_clean = p_resid
       endif
       !
       do i=1,method%n_iter
          dcct(1,iplane,i) = (dble(p_cct(i)%ix) -   &
               hclean%gil%convert(1,1)) * hclean%gil%convert(3,1) + &
               hclean%gil%convert(2,1)
          dcct(2,iplane,i) = (dble(p_cct(i)%iy) -   &
               hclean%gil%convert(1,2)) * hclean%gil%convert(3,2) + &
               hclean%gil%convert(2,2)
          dcct(3,iplane,i) = p_cct(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 phys_const, only: pi
    use image_def
    use clean_types
    !--------------------------------------------------
    ! Load x,y coordinates
    !--------------------------------------------------
    type(clean_par), intent(in)  :: method
    type(gildas),    intent(in)  :: huv,head
    integer,         intent(in)  :: nx
    integer,         intent(in)  :: ny
    real,            intent(out) :: mapx(nx)
    real,            intent(out) :: mapy(ny)
    !
    real(8), parameter :: f_to_k = 2.d0*pi/299792458.d-6
    !
    integer :: i
    real :: pidsur ! 2*pi*D/Lambda
    real(8) :: freq
    !
    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
  !
  !------------------------------------------------------------------------
  !
  subroutine mx_major_cycle(map,uvdata,nu,nv,&
       w_weight,w_v,&
       method,head,&
       clean,beam,resid,nx,ny,nb,&
       wcl,mcl,tcc,ncct,&
       list,nl,nf,primary,weight,&
       grid,mapu,mapv,mapx,mapy,&
       wfft,cpu0,uvmax)
    use image_def
    use gkernel_interfaces
    use mapping_interfaces
    use uvmap_types
    use clean_types
    use cct_types
    use minmax_tool, only: maxlst
    use clean_flux_tool, only: next_flux,major_plot
    use clean_cycle_tool, only: minor_cycle
    !----------------------------------------------------------------------
    ! Major cycle loop according to B.Clark idea
    ! Treat only one "plane/channel" at a time
    ! Plane is specified by method%iplane
    !----------------------------------------------------------------------
    type(clean_par), intent(inout) :: method
    type(uvmap_par), intent(in)    :: map
    type(gildas),    intent(inout) :: head
    integer,         intent(in)    :: nu                 ! Visibility size
    integer,         intent(in)    :: nv                 ! Number of visibilities
    integer,         intent(in)    :: nb                 ! Number of beams
    real,            intent(inout) :: uvdata(nu,nv)      ! Visibilities (iterated residuals)
    real,            intent(in)    :: w_weight(nv)       ! Weight array
    real,            intent(in)    :: w_v(nv)            ! V values
    real,            intent(in)    :: uvmax              ! Max baseline
    integer,         intent(in)    :: nx,ny              ! X,Y size
    real,            intent(in)    :: mapx(nx),mapy(ny)  ! X,Y coordinates
    real,            intent(out)   :: mapu(*),mapv(*)    ! U,V coordinates
    real,            intent(in)    :: grid(nx,ny)        ! Grid correction
    real,            intent(inout) :: clean(nx,ny)       ! Clean image
    real,            intent(inout) :: resid(nx,ny)       ! Residuals
    real,            intent(in)    :: beam(nx,ny,nb)     ! Synthesized beams
    integer,         intent(in)    :: nl                 ! Search list size
    integer,         intent(in)    :: mcl                ! Maximum number of clean components
    integer,         intent(out)   :: ncct               ! Number of clean components / plane
    real,            intent(inout) :: wfft(*)            ! Work space for FFT
    type (cct_par),  intent(out)   :: tcc(method%m_iter) ! Clean components array
    integer,         intent(in)    :: list(nx*ny)        ! List of valid pixels
    integer,         intent(in)    :: nf                 ! Number of fields
    real,            intent(inout) :: primary(nf,nx,ny)  ! Primary beams
    real,            intent(inout) :: weight (nx,ny)     ! Flat field
    type(cct_par),   intent(inout) :: wcl(mcl)           ! Work array for Clean Components
    !
    logical :: fini                ! critere d'arret
    logical :: converge            ! Indique la conv par acc de flux
    integer :: lx,ly
    integer :: nn(2),ndim,kz,ier
    integer :: k,kcl
    integer :: ncl                 ! nb de pts reellement retenus
    integer :: imax,jmax,imin,jmin ! leurs coordonnees
    real :: maxc,minc,maxabs       ! max et min de la carte, absolute
    real :: borne                  ! fraction de la carte initiale
    real :: limite                 ! intensite minimum des pts retenus
    real :: clarkl                 ! Clark worry limit
    real :: flux                   ! Total clean flux density
    real :: cpu1,cpu0
    real,    allocatable :: my_resid(:,:)
    complex, allocatable :: tfgrid(:,:,:)
    complex, allocatable :: ftbeam(:,:)
    character(len=message_length) :: chain
    !
    character(len=*), parameter :: rname='MX>MAJOR>CYCLE'
    !
    real ubias,vbias,ubuff(4096),vbuff(4096)
    common /conv/ ubias,vbias,ubuff,vbuff
    !
    print *,'Number of fields ',nf
    print *,'Number of Beams ',nb
    !
    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,'UVMAP',chain)
       write(chain,*) 'UVMAX ',uvmax,map%support, map%uvcell
       call map_message(seve%w,'UVMAP',chain)
    endif
    ly = min(ly,ny)
    lx = min(lx,nx)
    call docoor (lx,-map%uvcell(1),mapu)
    call docoor (ly,map%uvcell(2),mapv)
    !
    kz = 1
    allocate (tfgrid(kz+1,lx,ly),ftbeam(nx,ny),my_resid(nx,ny),stat=ier)
    !
    nn(1) = nx
    nn(2) = ny
    ndim = 2
    call fourt_plan(ftbeam,nn,ndim,-1,1)
    call gag_cpu(cpu0)
    !
    ! 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
    !
    print *,'Weight ',w_weight(1:100)
    !  print *,'V ',w_v
    !
    ! Major cycle
    k = 0
    flux = 0.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*method%bgain,0.8*borne)
       clarkl = maxabs*method%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,       &      ! Selected candidate components
            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,'CLARK',chain)
          !
          ! Make minor cycles
          call minor_cycle (method,   &
               wcl,    &     ! Selected candidate components
               ncl,   &         ! Number of candidates
               beam,nx,ny,   &  ! Dirty beams and Size
               method%beam0(1),method%beam0(2),   & ! Beam center
               method%patch(1),method%patch(2),   & ! Beam patch
               clarkl,limite,   &
               converge,   &    !
               tcc,   &         ! Cumulated components
               nf, primary, weight, method%trunca,   &
               flux,   &        ! Total Flux
               method%pflux, next_flux)
          !
          ! Remove all components by FT : RESID = RESID - BEAM # WCL(*,4)
          !
          call mx_uvsub (nx,ny,mapx,mapy,   &
               wcl, ncl,   &
               nu,nv,uvdata,method%iplane)
          write (chain,101)  'Cleaned ',flux,' Jy with ',   &
               method%n_iter,' clean components'
          call map_message(seve%i,rname,chain)
          !
          ! Compute FFT's and loop again
          call gag_cpu(cpu1)
          write(chain,101) 'Start FFT back at ',cpu1-cpu0
          call map_message(seve%i,rname,chain)
          call dofft (nu,nv,   &   ! Size of visibility array
               uvdata,   &      ! Visibilities
               1,2,   &         ! U, V pointers
               method%iplane,   &   ! First channel to map
               1,lx,ly,   &     ! Cube size
               tfgrid,   &      ! FFT cube
               mapu,mapv,   &   ! U and V grid coordinates
               map%support,   &
               map%uvcell,map%taper,   &    ! Gridding parameters
               w_weight,w_v,   &    ! Weight & Visi arrays
               ubias,vbias,ubuff,vbuff,map%ctype)
          !
          ! Make maps with grid correction
          call extracs (1+1,nx,ny,1,tfgrid,ftbeam,lx,ly)
          call fourt  (ftbeam,nn,ndim,-1,1,wfft)
          call cmtore (ftbeam,my_resid,nx,ny)
          !! print *,'RESID 1',my_resid(:,ny/2)
          call docorr (my_resid,grid,nx*ny)
          !! print *,'RESID 2',my_resid(:,ny/2)
          call gag_cpu(cpu1)
          write(chain,101) 'Finished gridding again ',cpu1-cpu0
          call map_message(seve%i,rname,chain)
          resid = my_resid
          !
          ! 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
          !
          ! 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
       !
       converge = fini
       !
       ! Unclear here ...
       call major_plot (method,head,   &
            converge,method%n_iter,nx,ny,nf,   &
            tcc,clean,resid,weight)
       fini = converge
       !
       ! Get new list
!!!    if (.not.fini) then
!!!      call re_mask (method,head,nl,error)
!!!      nl = method%nlist
!!!      list = method%list
!!!    endif
    enddo
    ncct = method%n_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 (method%n_major.le.k) then
       call map_message(seve%i,rname,'Reached maximum number of cycles')
    elseif (converge) then
       call map_message(seve%i,rname,'Reached minor cycle convergence')
    else
       call map_message(seve%i,rname,'End of transcendental causes')
    endif
    write(chain,'(a,1pg10.3,a,i5,a)')  'CLEAN found ',flux,' Jy in ',   &
         method%n_iter,' clean components'
    call map_message(seve%i,'CLEAN',chain)
    !
    if (allocated(tfgrid)) deallocate(tfgrid)
    if (allocated(ftbeam)) deallocate(ftbeam)
    !
100 format (a,i6,a,1pg10.3,a)
101 format (a,1pg10.3,a,i5,a)
  end subroutine mx_major_cycle
  !
  subroutine mx_uvsub(nx,ny,mapx,mapy,wcl,ncl,nu,nv,visi,ip)
    use cct_types
    !----------------------------------------------------------------------
    ! Subtract last major cycle components from UV table.
    ! Treats only one channel.
    !----------------------------------------------------------------------
    integer,       intent(in)    :: nx,ny             ! X,Y size
    real,          intent(in)    :: mapx(nx),mapy(ny) ! X,Y coordinates
    integer,       intent(in)    :: ncl               ! Number of clean components
    type(cct_par), intent(inout) :: wcl(ncl)          ! Clean comp. value
    integer,       intent(in)    :: nu                ! Visibility size
    integer,       intent(in)    :: nv                ! Number of visibilities
    real,          intent(inout) :: visi(nu,nv)       ! Visibilities
    integer,       intent(in)    :: ip                ! Current "plane/channel"
    !
    integer :: ncomp
    integer :: ic,iv,ir,ii
    real :: x,y,phase,rvis,ivis
    !
    ir = 5+3*ip  ! Real part
    ii = ir+1    ! Imaginary part
    !
    ! Compress clean component list
    ncomp = 0
    do ic=1,ncl
       if (wcl(ic)%value.ne.0.0) then
          ncomp = ncomp+1
          wcl(ncomp) = wcl(ic)
       endif
    enddo
    !
    ! Remove clean component from UV data set
    do iv = 1,nv
       do ic = 1,ncomp
          x = mapx(wcl(ic)%ix)
          y = mapy(wcl(ic)%iy)
          phase = visi(1,iv)*x+visi(2,iv)*y
          rvis = wcl(ic)%value*cos(phase)
          ivis = wcl(ic)%value*sin(phase)
          visi(ir,iv) = visi(ir,iv) - rvis
          visi(ii,iv) = visi(ii,iv) - ivis
       enddo
    enddo
  end subroutine mx_uvsub
end module clean_mx
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
