subroutine sub_mrc(rname,method,hdirty,hresid,hclean,   &
     &    hbeam,hprim,mask,error, plot_routine)
  use gkernel_interfaces
  use imager_interfaces, except_this=>sub_mrc
  use clean_def
  use image_def
  use gbl_message
  !----------------------------------------------------------------------
  ! @ private
  !
  ! GILDAS  CLEAN Internal routine
  !   Implementation of Multi-Resolution CLEAN deconvolution algorithm.
  !   A smooth and a difference map are deconvolved using Clark CLEAN
  !   with smooth and difference dirty beams.
  !----------------------------------------------------------------------
  character(len=*), intent(in) :: rname
  type (clean_par), intent(inout) :: method
  type (gildas), intent(in) :: hdirty, hbeam, hclean, hresid, hprim
  logical, target, intent(in) :: mask(:,:)
  logical, intent(out) :: error
  external :: plot_routine
  ! Global
  real(8), parameter :: pi=3.141592653589793d0
  !
  ! Local
  type (clean_par) :: s_method, d_method
  type(gildas) :: s_hclean
  integer n_comp, n_fft, ier
  real, pointer :: dprim(:,:,:)    ! Primary beam
  real, pointer :: atten(:,:)      ! Mosaic weight
  real, pointer :: f_beam(:,:), p_beam(:,:)
  real, pointer :: f_dirty(:,:), f_resid(:,:), f_clean(:,:)
  real, allocatable :: s_clean(:,:), e_clean(:,:)
  logical, allocatable :: s_mask(:,:)
  real, allocatable :: w_fft(:)
  type(cct_par), allocatable :: w_comp(:)
  complex, allocatable :: s_work(:,:)
  real, allocatable :: s_resid(:,:), s_beam(:,:)
  complex, allocatable :: d_work(:,:)
  real, allocatable :: d_beam(:,:)
  real, allocatable, target:: d_resid(:,:)
  real, allocatable :: s_beam_fft(:,:), s_clean_fft(:,:)
  real, allocatable :: d_beam_fft(:,:), d_clean_fft(:,:)
  real, dimension(1,1,1), target ::dummy3d
  real, dimension(1,1), target   ::dummy2d
  integer, allocatable :: s_list(:), i_list(:)
  !
  type (cct_par), allocatable :: tcc(:)
  !
  integer box(4), ix_min, iy_min, nx, ny, mx, my, irat, nclean,   &
     &    s_ix_beam, s_iy_beam, s_ix_patch, s_iy_patch,   &
     &    d_ix_beam, d_iy_beam, d_ix_patch, d_iy_patch,   &
     &    s_ix_clean, s_iy_clean, d_ix_clean, d_iy_clean, nk, nl
  real d_beam_max, s_beam_max, d_clean_max, s_clean_max,   &
     &    scale, scale_dirty, scale_clean, beam_min, beam_max
  integer ix_beam, iy_beam
  real(4) old_r1,old_r2,xinc,yinc
  character(len=message_length) :: chain
  character voc1(2)*8
  integer iplane
  !
  save old_r1,old_r2
  data old_r1/-1./,old_r2/+1./
  data voc1/'CLEAN','RESIDUAL'/
  !
  ! --------------------------------------------------------------------
  !
  irat = nint(method%ratio)
  write(chain,102) 'Smoothing ratio = ',irat
  call map_message(seve%i,rname,chain)
  !
  ! Local variables
  nx = hclean%gil%dim(1)
  ny = hclean%gil%dim(2)
  nl = method%nlist
  mx = nx/irat
  my = ny/irat
  call gildas_null(s_hclean)  ! Was not done ...
  call gdf_copy_header(hclean, s_hclean, error)
  !
  s_hclean%gil%dim(1) = mx
  s_hclean%gil%dim(2) = my
  s_hclean%gil%ref(1) = hclean%gil%ref(1)/irat
  s_hclean%gil%ref(1) = hclean%gil%ref(1)/irat
  ! Transform coordinates (1,1) ---> (1,1)
  s_hclean%gil%inc(1:2) = hclean%gil%inc(1:2)*irat
  s_hclean%gil%ref(1:2) = 1.0d0
  s_hclean%gil%val(1:2) = (s_hclean%gil%ref(1:2)-hclean%gil%ref(1:2)) &
                          * hclean%gil%inc(1:2)+hclean%gil%val(1:2)
  !
  ! Transform back
  s_hclean%gil%ref(1:2) = (hclean%gil%val(1:2) - s_hclean%gil%val(1:2)) &
                          / s_hclean%gil%inc(1:2) + s_hclean%gil%ref(1:2)
  !
  !
  ! Get the numerous work spaces
  nclean = nx*ny
  n_comp = 4*nclean
  allocate(w_comp(nclean),stat=ier)
  !
  allocate(d_work(nx,ny),stat=ier)     !   Work space for large FFTs
  allocate(d_beam_fft(nx,ny),stat=ier) !   Difference beam FFT
  allocate(d_resid(nx,ny),stat=ier)    !   Difference residual
  allocate(d_beam(nx,ny),stat=ier) !   Difference dirty beam
  allocate(d_clean_fft(nx,ny),stat=ier)
  !
  allocate(s_beam(mx,my),stat=ier) !   Smooth dirty beam
  allocate(s_resid(mx,my),stat=ier)    !   Smooth residual
  allocate(s_clean(mx,my),stat=ier)    !    Smooth Clean
  allocate(s_beam_fft(mx,my),stat=ier) !   Smooth beam FFT
  allocate(s_clean_fft(mx,my),stat=ier)
  !
  allocate(e_clean(nx,ny),stat=ier)    !    Expanded Smooth Clean
  allocate(s_work(mx,my),stat=ier)
  !
  n_fft = 2*max(nx,ny)
  allocate(w_fft(n_fft),stat=ier)
  !
  ! Clean component work array
  allocate(tcc(method%m_iter),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error for TCC')
    error = .true.
    return
  endif
  !
  ! Mask for the smooth case
  allocate (s_mask(mx,my),s_list(mx*my),i_list(nx*ny),stat=ier)
  call cmpmsk (s_mask,mx,my,mask,nx,ny,irat)
  !
  ! Find components of SMOOTH map
  call lmask_to_list(s_mask,mx*my,s_list,nk)
  ! Find components of DIFFERENCE map
  call lmask_to_list(mask,nx*ny,i_list,nl)
  !
  ! Loop here if needed
  do iplane = method%first, method%last
    !
    method%iplane = iplane
    method%iplane = iplane
    call beam_plane(method,hbeam,hdirty)
    !
    ! Find residual and clean areas
    f_dirty => hdirty%r3d(:,:,iplane)
    f_resid => hresid%r3d(:,:,iplane)
    f_clean => hclean%r3d(:,:,iplane)
    p_beam  => hbeam%r4d(:,:,1,method%ibeam) ! Only this one is defined
    if (method%mosaic) then
      dprim => hprim%r3d
      atten=> method%atten(:,:,1)
    else
      dprim => dummy3d
      atten=> dummy2d
    endif
    !
    ! Initialize to Dirty map
    f_resid = f_dirty
    !
    ! Initialize plot
    call plot_routine(method,hdirty,f_resid,0)
    !
    call get_clean (method, hclean, p_beam, error)
    if (error) return
    !
    ! ------------------------- Now doing MRC ----------------------------------
    f_clean = 0.0
    !
    !
    ! Compute the clean beams theoretical ratio
    scale_clean = method%ratio*   &
     &    sqrt((method%ratio**2-1.0)*(method%minor/method%major)**2+1.0)
    write(chain,100) 'Theoretical Clean beam ratio ',scale_clean
    call map_message(seve%i,rname,chain)
    !
    ! Conpute the final clean beam
    xinc = hdirty%gil%convert(3,1)
    yinc = hdirty%gil%convert(3,2)
    call mrc_make_clean (nx,ny,d_resid,   &
     &    method%major,method%minor,method%angle,xinc,yinc)
    !
    ! Compute smooth and difference clean beams and their FT
    ! D_BEAM and S_BEAM hold temporarily difference and smooth CLEAN beams
    call mrc_setup (   &
     &    method%ratio,d_resid,method%minor,xinc,yinc,   &
     &    nx,ny,d_beam,d_clean_fft,d_work,   &
     &    d_clean_max,d_ix_clean,d_iy_clean,   &
     &    mx,my,s_beam,s_clean_fft,s_work,   &
     &    s_clean_max,s_ix_clean,s_iy_clean,   &
     &    'CLEAN',w_fft)
    !
    d_method = method
    s_method = method
    !
    scale_clean = 1.0/s_clean_max
    write(chain,100) 'Clean beam ratio R = ',scale_clean
    call map_message(seve%i,rname,chain)
    !
    ! Find DIRTY beam maximum once, and scale to 1.0 values
    box(1) = 1
    box(2) = 1
    box(3) = nx
    box(4) = ny
    call maxmap(p_beam,nx,ny,box,   &
     &    beam_max,ix_beam,iy_beam,beam_min,ix_min,iy_min)
    write(chain,101) 'Dirty beam maximum ',beam_max,' at ',ix_beam,iy_beam
    call map_message(seve%i,rname,chain)
    f_beam => d_resid
    f_beam(:,:) = p_beam/beam_max
    !
    ! Compute smooth and difference DIRTY beams once and their FT
    call mrc_setup (   &
     &    method%ratio,f_beam,method%minor,xinc,yinc,   &
     &    nx,ny,d_beam,d_beam_fft,d_work,   &
     &    d_beam_max,d_ix_beam,d_iy_beam,   &
     &    mx,my,s_beam,s_beam_fft,s_work,   &
     &    s_beam_max,s_ix_beam,s_iy_beam,   &
     &    'DIRTY',w_fft)
    !
    scale_dirty = 1.0/s_beam_max
    write(chain,100) 'Dirty beam ratio S = ',scale_dirty
    call map_message(seve%i,rname,chain)
    !
    ! Initialise : find beams maximum sidelobe
    d_method = method
    s_method = method
    s_ix_patch = method%patch(1)
    s_iy_patch = method%patch(2)
    d_ix_patch = method%patch(1)
    d_iy_patch = method%patch(2)
    call find_sidelobe (d_beam,nx,ny,   &
     &    d_ix_beam,d_iy_beam,d_ix_patch,d_iy_patch,   &
     &    d_method%bgain)
    write(chain,100) 'Difference beam sidelobe ',   &
     &    d_method%bgain
    call map_message(seve%i,rname,chain)
    call find_sidelobe (s_beam,mx,my,   &
     &    s_ix_beam,s_iy_beam,s_ix_patch,s_iy_patch,   &
     &    s_method%bgain)
    write(chain,100) 'Smooth beam sidelobe ',s_method%bgain
    call map_message(seve%i,rname,chain)
    !
    ! Define cleaning boxes
    d_method%box = (/d_method%blc(1),d_method%blc(2),   &
     &    d_method%trc(1),d_method%trc(2)/)
    s_method%blc = max(s_method%blc/irat,1)
    s_method%trc = s_method%trc/irat
    s_method%box = (/s_method%blc(1),s_method%blc(2),   &
     &    s_method%trc(1),s_method%trc(2)/)
    !
    !
    ! Compute smooth and difference maps
    call mrc_maps (   &
     &    nx,ny,f_resid,d_resid,d_work,   &
     &    mx,my,s_resid,s_work,method%ratio,   &
     &    method%minor,xinc,yinc,w_fft)
    call map_message(seve%i,rname,'Smooth and Difference maps done')
    !
    d_method%p_iter = -1
    !
    ! Frac. and abs. residual limits
    d_method%ares = d_method%ares*(scale_dirty-1.0)/scale_dirty
    s_method%ares = s_method%ares/scale_dirty
    !
    ! --------------------------- DIFFERENCE MAP ----------------------------
    !
    call map_message(seve%i,rname,'Cleaning now the difference map')
    write (chain,104) 'Abs.Res = ',d_method%ares,   &
     &    ' Frac.Res = ',d_method%fres
    call map_message(seve%i,rname,chain)
    !!      read(5,*) i
    !
    call major_cycle90 (rname,d_method,hclean,   &
     &    f_clean,   &         ! Final CLEAN image
     &    d_beam,   &          ! Dirty beams
     &    d_resid,nx,ny,   &   ! Residual and size
     &    d_beam_fft, d_work,   &  ! FT of dirty beam + Work area
     &    w_comp, nclean,       &  ! Component storage + Size
     &    d_ix_beam, d_iy_beam, d_ix_patch, d_iy_patch,   &
     &    d_method%bgain, d_method%box,   &
     &    w_fft,   &           ! Work space for FFTs
     &    tcc,   &             ! Component table
     &    i_list, nl,        & ! Search list (truncated...)
     &    1,                 & ! Number of fields
     &    dprim,             & ! Primary beams
     &    atten,             & ! Dummry weight
     &    no_major_plot,     & ! Plotting routine
     &    no_next_flux)
    !
    ! Add clean components to Final clean map
    scale = ( scale_dirty*(scale_clean-1.0) ) /   &
     &    ( scale_clean*(scale_dirty-1.0) )
    write(chain,100)   &
     &    'Difference scaling ratio S/R*(R-1)/(S-1) = ',scale
    call map_message(seve%i,rname,chain)
    !
    if (d_method%n_iter.ne.0) then
      call restore_clean90 (d_method,   &
     &      f_clean,nx,ny,   &
     &      d_work,d_clean_fft,scale,   &
     &      w_fft,tcc,d_method%n_iter)
      !
      ! Add Difference residual to Final clean map
      f_clean = f_clean+d_resid
    else
      f_clean = d_resid
    endif
    !
    ! Put Difference residual in Final residual
    f_resid = d_resid
    !
    ! Plot the clean difference image
    call plot_routine(method,hclean,f_clean,1)
    !     !
    ! -------------------------- SMOOTH MAP ----------------------------
    !
    call map_message(seve%i,rname,'Cleaning now the smooth map')
    write (chain,104) 'Abs.Res = ',s_method%ares,   &
     &    ' Frac.Res = ',s_method%fres
    call map_message(seve%i,rname,chain)
    !!      read(5,*) i
    !
    call major_cycle90 (rname,s_method,s_hclean,   &
     &    s_clean,   &         ! Smooth CLEAN image
     &    s_beam,   &          ! Smooth Dirty beams
     &    s_resid,mx,my,   &   ! Residual and size
     &    s_beam_fft, d_work,   &  ! FT of dirty beam + Work area
     &    w_comp, nclean,       &  ! Component storage + Size
     &    s_ix_beam, s_iy_beam, s_ix_patch, s_iy_patch,   &
     &    s_method%bgain, s_method%box,   &
     &    w_fft,   &           ! Work space for FFTs
     &    tcc,   &             ! Component table
     &    s_list, nk,        & ! Search list (truncated...)
     &    1,                 & ! Number of fields
     &    dprim,             & ! Primary beams
     &    atten,             & ! Dummry weight
     &    no_major_plot,     & ! Plotting routine
     &    no_next_flux)
    !
    ! Compute smooth clean map
    scale = scale_dirty / scale_clean
    write(chain,100) 'Smooth scaling ratio S/R = ',scale
    call map_message(seve%i,rname,chain)
    if (s_method%n_iter.ne.0) then
      call restore_clean90 (method,   &
     &      s_clean,mx,my,   &
     &      s_work,s_clean_fft,scale,   &
     &      w_fft,tcc,s_method%n_iter)
      !
      ! Expand smooth clean and residual maps
      call expand (nx,ny,e_clean,d_work,   &
       &      mx,my,s_clean,s_work,w_fft)
      f_clean = f_clean + e_clean
    else
      e_clean = 0
    endif
    call expand (nx,ny,d_resid,d_work,   &
     &    mx,my,s_resid,s_work,w_fft)
    f_clean = f_clean + d_resid
    f_resid = f_resid + d_resid
    e_clean(:,:) = e_clean + d_resid
    !
    ! Plot smooth clean image and final clean image
    call plot_routine(method,hclean,e_clean,2)
    call plot_routine(method,hclean,f_clean,3)
    !
    ! --------------------------------- END --------------------------------
  enddo
  !
  deallocate (s_mask,s_list,i_list,stat=ier)
  !
  ! Free all work spaces
  deallocate(w_comp)           !   Clean components search list
  deallocate(d_work)           !   Work space for large FFTs
  deallocate(d_beam_fft)       !   Difference beam FFT
  deallocate(d_resid)          !   Difference residual
  deallocate(d_beam)           !   Difference dirty beam
  deallocate(d_clean_fft)      !   Difference Clean Beam FFT
  deallocate(s_beam)           !   Smooth dirty beam
  deallocate(s_resid)          !   Smooth residual
  deallocate(s_clean)          !    Smooth Clean
  deallocate(s_beam_fft)       !   Smooth beam FFT
  deallocate(s_clean_fft)      !   Smooth Clean Beam FFT
  deallocate(e_clean)          !    Expanded Smooth Clean
  deallocate(s_work)           !   Work space for Compress/Expand
  deallocate(w_fft)            ! Work space for FFT
  return
  !
  ! Formats
  100   format(a,f9.4)
  101   format(a,1pg11.4,a,i5,i5)
  102   format(a,i4)
  104   format(a,1pg11.4,a,1pg11.4)
end subroutine sub_mrc
!
subroutine mrc_maps (nx,ny,full,diff,wl,mx,my,smooth,ws,ratio,   &
     &    bmin,xinc,yinc,wfft)
  use imager_interfaces, except_this=>mrc_maps
  use gkernel_interfaces, only : fourt
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING CLEAN
  !   Multi-Resolution Clean
  !   Compute smooth and difference maps.
  !   Smoothing is done in UV plane, by Gauss convolution and
  !   Fourier truncation. Smooth map is smaller than original map
  !----------------------------------------------------------------------
  integer, intent(in) :: nx,ny,mx,my
  real, intent(in) :: full(nx,ny)
  real, intent(inout) :: diff(nx,ny),smooth(mx,my)
  real, intent(inout) :: wfft(*)
  real, intent(in) :: ratio,bmin,xinc,yinc
  complex, intent(inout) :: ws(mx,my),wl(nx,ny)
  !
  integer i,j,ndim,dim(2)
  real fact,cx,cy,seuil
  real(8), parameter :: pi=3.141592653589793d0
  !
  seuil = -80
  wl = cmplx(full,0.0)
  !
  ndim = 2
  dim(1) = nx
  dim(2) = ny
  call fourt(wl,dim,ndim,-1,0,wfft)
  !
  ! Extract inner part, convolve it by a Gaussian to avoid sharp edges
  ! and subtract it from the FT of original map to get the difference
  !
  fact = sqrt(ratio**2-1.0)*pi/(2.*sqrt(log(2.)))
  cx = fact/nx * bmin/xinc
  cy = fact/ny * bmin/yinc
  do j=1,my/2
    do i=1,mx/2
      fact =  -(float(j-1)*cy)**2 -(float(i-1)*cx)**2
      if (fact.gt.seuil) then
        fact = exp (fact)
        ws(i,j) = wl(i,j)*fact
        wl(i,j) = wl(i,j)-ws(i,j)
      else
        ws(i,j) = 0.
      endif
    enddo
    do i=nx-mx/2+1,nx
      fact =  -(float(j-1)*cy)**2 -(float(i-nx-1)*cx )**2
      if (fact.gt.seuil) then
        fact = exp (fact)
        ws(i-nx+mx,j) = wl(i,j)*fact
        wl(i,j) = wl(i,j)-ws(i-nx+mx,j)
      else
        ws(i-nx+mx,j) = 0.0
      endif
    enddo
  enddo
  do j=ny-my/2+1,ny
    do i=1,mx/2
      fact =  -( float(j-ny-1)*cy)**2 -( float(i-1)*cx)**2
      if (fact.gt.seuil) then
        fact = exp (fact)
        ws(i,j+my-ny) = wl(i,j)*fact
        wl(i,j) = wl(i,j)-ws(i,j+my-ny)
      else
        ws(i,j+my-ny) = 0.0
      endif
    enddo
    do i=nx-mx/2+1,nx
      fact =  -(float(j-ny-1)*cy)**2 -(float(i-nx-1)*cx)**2
      if (fact.gt.seuil) then
        fact = exp (fact)
        ws(i-nx+mx,j-ny+my) = wl(i,j)*fact
        wl(i,j) = wl(i,j)-ws(i-nx+mx,j-ny+my)
      else
        ws(i-nx+mx,j-ny+my) = 0.0
      endif
    enddo
  enddo
  !
  ! Compute difference map
  call fourt(wl,dim,ndim,1,1,wfft)
  fact = 1.0/(nx*ny)
  diff = real(wl)*fact
  !
  ! Compute smooth map
  dim(1) = mx
  dim(2) = my
  call fourt(ws,dim,ndim,1,1,wfft)
  fact = 1.0/(nx*ny)
  smooth = real(ws)*fact
end subroutine mrc_maps
!
subroutine maxcmp(nx,ny,wl,a)
  integer, intent(in) :: nx,ny
  real, intent(in) :: wl(2,nx,ny)
  real, intent(out) :: a
  !
  integer i,j
  !
  a = wl(1,1,1)
  do j=1,ny
    do i=1,nx
      if (wl(1,i,j).gt.a) then
        a = wl(1,i,j)
      endif
    enddo
  enddo
end subroutine maxcmp
!
subroutine mrc_make_clean (nx,ny,beam,bmaj,bmin,pa,xinc,yinc)
  !--------------------------------------------------------------------
  ! @ private
  !
  ! MRC
  !     Make Clean Beam
  !--------------------------------------------------------------------
  integer, intent(in) :: nx,ny
  real, intent(out) :: beam(nx,ny)
  real, intent(in) :: bmaj,bmin,pa,xinc,yinc
  !
  integer i,j
  real amaj,amin,cx,cy,sx,sy
  real seuil,fact
  ! PI is defined with more digits than necessary to avoid losing
  ! the last few bits in the decimal to binary conversion
  real(8), parameter :: pi=3.14159265358979323846d0
  !
  ! Compute the clean beam
  seuil = -100.
  amaj = bmaj/2.0/sqrt(log(2.))
  amin = bmin/2.0/sqrt(log(2.))
  cx = xinc*cos(pa*pi/180.0d0)/amin
  cy = yinc*cos(pa*pi/180.0d0)/amaj
  sx = xinc*sin(pa*pi/180.0d0)/amaj
  sy = yinc*sin(pa*pi/180.0d0)/amin
  ! gain = amaj*amin/abs(pi*xinc*yinc)
  !
  do j=1,ny
    do i=1,nx
      fact =   &
     &        ( -( (float(i-nx/2-1)*sx + float(j-ny/2-1)*cy)**2 +   &
     &        ( -float(i-nx/2-1)*cx + float(j-ny/2-1)*sy)**2 ) )
      if (fact.gt.seuil) then
        beam(i,j) = exp(fact)
      else
        beam(i,j) = 0.0
      endif
    enddo
  enddo
end subroutine mrc_make_clean
!
subroutine mrc_setup (ratio,beam,bmin,xinc,yinc,   &
     &    nx,ny,dbeam,dbeam_fft,dwork,dmax,dxmax,dymax,   &
     &    mx,my,sbeam,sbeam_fft,swork,smax,sxmax,symax,   &
     &    type,work)
  use imager_interfaces, except_this=>mrc_setup
  use gbl_message
  !------------------------------------------------------------------
  ! @ private
  !
  ! MRC
  !     Compute Smooth and Difference BEAMS (dirty or clean) ie
  !        CALL MRC_MAPS + normalisations + TF
  !------------------------------------------------------------------
  character(len=*), intent(in) :: type
  integer, intent(in) :: nx,ny,mx,my
  real, intent(in) :: ratio,beam(nx,ny)
  real, intent(in) :: bmin,xinc,yinc
  real, intent(inout) :: dbeam(nx,ny),dmax
  integer, intent(inout) :: dxmax,dymax
  real, intent(inout) :: dbeam_fft(nx,ny)
  complex, intent(inout) :: dwork(nx,ny)
  real, intent(inout) :: sbeam(mx,my),smax
  integer, intent(inout) :: sxmax,symax
  real, intent(inout) :: sbeam_fft(mx,my)
  complex, intent(inout) :: swork(mx,my)
  real, intent(inout) :: work(*)
  !
  integer box(4),ixmin,iymin
  real rmin,area,tmp
  character(len=message_length) :: chain
  character(len=3) :: rname = 'MRC'
  !
  call mrc_maps (nx,ny,beam,dbeam,dwork,   &
     &    mx,my,sbeam,swork,ratio,   &
     &    bmin,xinc,yinc,work)
  !
  box = (/1,1,nx,ny/)
  call maxmap (dbeam,nx,ny,box,dmax,dxmax,dymax,rmin,ixmin,iymin)
  write(chain,100) 'Difference '//type//' maximum ',dmax,   &
     &    ' at ',dxmax,dymax
  call map_message(seve%i,rname,chain)
  tmp = 1.0/dmax
  dbeam = dbeam*tmp
  call init_convolve (dxmax,dymax,nx,ny,dbeam,dwork,area,work)
  dbeam_fft = real(dwork)
  !
  box = (/1,1,mx,my/)
  call maxmap (sbeam,mx,my,box,smax,sxmax,symax,rmin,ixmin,iymin)
  write(chain,100) 'Smooth '//type//' maximum ',smax,   &
     &    ' at ',sxmax,symax
  call map_message(seve%i,rname,chain)
  !
  tmp = 1.0/smax
  sbeam = sbeam*tmp
  call init_convolve (sxmax,symax,mx,my,sbeam,swork,area,work)
  sbeam_fft = real(swork)
  !
  100   format (a,1pg11.4,a,i5,i5)
end subroutine mrc_setup
!
subroutine cmpmsk (s,mx,my,d,nx,ny,irat)
  !-----------------------------------------------------------------
  ! @ private
  !
  ! MRC
  !     Convert difference (ie initial) mask in smooth mask
  !-----------------------------------------------------------------
  integer, intent(in) ::  nx,ny,mx,my,irat
  logical, intent(out) :: s(mx,my)
  logical, intent(in) :: d(nx,ny)
  !
  integer i,j,k,l
  do j=1,my
    do i=1,mx
      s(i,j) = .false.
      do l=irat*(j-1)+1,irat*j
        do k=irat*(i-1)+1,irat*i
          if (d(k,l)) then
            s(i,j) = .true.
            goto 100
          endif
        enddo
      enddo
      100         continue
    enddo
  enddo
end subroutine cmpmsk
!
subroutine restore_clean90 (method,clean,nx,ny,ft,   &
     &    tfbeam,scale,wfft,tcc,nc)
  use gkernel_interfaces, only : fourt
  !-----------------------------------------------------------------
  ! @ private
  !
  ! GILDAS: CLEAN   Internal routine
  ! Convolve source list into residual map using the Fourier method.
  ! The normalisation should be correct for flux or brightness maps,
  ! depending on value of SCALE.
  !-----------------------------------------------------------------
  use clean_def
  type (clean_par), intent(in) :: method
  integer, intent(in) :: nx, ny, nc
  real, intent(inout) :: clean(nx,ny),wfft(*)
  complex, intent(inout) :: ft(nx,ny)
  real, intent(in) :: tfbeam(nx,ny)
  real, intent(in) :: scale
  type (cct_par), intent(in) :: tcc(nc)
  !
  real(8), parameter :: pi=3.141592653589793d0
  real flux
  integer ix, iy, ic, ndim, dim(2)
  !
  ft = 0.0
  !
  ! Convolve source list into residual map ---
  if (method%bshift(3).eq.0) then
    do ic=1,nc
      ix = tcc(ic)%ix
      iy = tcc(ic)%iy
      ft(ix,iy) = ft(ix,iy) + tcc(ic)%value
    enddo
  else
    do ic=1,nc
      flux = 0.5*tcc(ic)%value
      ix = tcc(ic)%ix
      iy = tcc(ic)%iy
      ft(ix,iy) = ft(ix,iy) + flux
      ix = ix+method%bshift(1)
      iy = iy+method%bshift(2)
      ft(ix,iy) = ft(ix,iy) + flux
    enddo
  endif
  !
  ndim = 2
  dim(1) = nx
  dim(2) = ny
  call fourt(ft,dim,ndim,-1,0,wfft)
  ft = ft*tfbeam
  call fourt(ft,dim,ndim,1,1,wfft)
  clean = real(ft)*scale
end subroutine restore_clean90
