subroutine alma_clean (line,error)
  use gkernel_interfaces
  use imager_interfaces, except_this=>alma_clean
  use clean_def
  use clean_arrays
  use clean_types
  use gbl_message
  !----------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER:  Internal routine
  !     Implementation of a Clean Method for Multi-Array
  !     Mosaic observations
  !----------------------------------------------------------------------
  character(len=*), intent(inout) :: line
  logical, intent(out) :: error
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  !
  real, allocatable :: tfbeam(:,:,:)
  real, allocatable :: c_tfbeam(:,:,:)
  !
  integer ier, ipen, nx, ny, np, mx, my, mp
  logical limits
  real ylimn,ylimp,fact
  integer iv,na,imethod,nlong
  character(len=8) :: name,argum,voc1(2),voc2(3)
  character(len=4) :: rname = 'ALMA'
  ! Data
  data voc1/'CLEAN','RESIDUAL'/
  data voc2/'CLARK','HOGBOM','SDI'/
  !
  ! Data checkup
  call clean_data (error)
  if (error) return
  call compact_data (error)
  if (error) return
  !
  argum = 'SDI'
  call sic_ke (line,5,1,argum,na,.false.,error)
  if (error) return
  call sic_ambigs (rname,argum,name,imethod,voc2,3,error)
  if (error) return
  !
  ! Get the noise and/or relative weights of the two images
  !
  if (hdirty%gil%rms.ne.0) hdirty%gil%noise = hdirty%gil%rms
  if (c_hdirty%gil%rms.ne.0) c_hdirty%gil%noise =   &
       &    c_hdirty%gil%rms
  if (hdirty%gil%noise.eq.0 .or. c_hdirty%gil%noise.eq.0) then
     if (sic_present(4,0)) then
        call sic_r4(line,4,1,hdirty%gil%noise,.true.,error)
        if (error) return
        call sic_r4(line,4,2,c_hdirty%gil%noise,.true.,error)
        if (error) return
     else
        call map_message(seve%w,rname,'No relative noise information')
        call map_message(seve%w,rname,'Use option /NOISE to indicate it')
        error = .true.
        return
     endif
  else
     if (sic_present(4,0)) then
        call sic_r4(line,4,1,fact,.true.,error)
        if (error) return
        hdirty%gil%noise = fact * hdirty%gil%noise
        call sic_r4(line,4,2,fact,.true.,error)
        if (error) return
        c_hdirty%gil%noise = fact * c_hdirty%gil%noise
     endif
  endif
  !
  ! Parameter Definitions
  user_method%method = 'CLARK'
  c_method%search = cuse_method%search
  c_method%trunca = cuse_method%trunca
  call copy_param(user_method,cuse_method)
  cuse_method%search = c_method%search
  cuse_method%restor = user_method%restor
  cuse_method%trunca = c_method%trunca
  call beam_unit_conversion(cuse_method)
  call copy_method(cuse_method,c_method)
  call beam_unit_conversion(user_method)
  call copy_method(user_method,method)
  ! A voir
  method%pflux = sic_present(1,0)
  method%pcycle = sic_present(2,0)
  method%qcycle = sic_present(3,0)
  if (method%pcycle) then
     argum = 'RESIDUAL'
     call sic_ke (line,2,1,argum,na,.false.,error)
     if (error) return
     call sic_ambigs ('PLOT',argum,name,iv,voc1,2,error)
     if (error) return
     method%pclean = iv.eq.1
  else
     method%pclean = .false.
  endif
  !
  call sic_get_inte('FIRST',method%first,error)
  call sic_get_inte('LAST',method%last,error)
  call sic_i4(line,0,1,method%first,.false.,error)
  call sic_i4(line,0,2,method%last,.false.,error)
  if (method%first.eq.0) method%first = 1
  if (method%last.eq.0) method%last = hdirty%gil%dim(3)
  method%first = max(1,min(method%first,hdirty%gil%dim(3)))
  method%last = max(method%first,min(method%last,hdirty%gil%dim(3)))
  !
  nlong = 0
  call sic_get_inte('NLONG',nlong,error)
  c_method%n_major = nlong
  !
  call check_area(method,hdirty,.false.)
  call check_mask(method,hdirty)
  user_method%do_mask = method%do_mask
  ! Compact array
  c_method%do_mask = .true.
  call check_area(c_method,c_hdirty,.false.)
  call check_mask(c_method,c_hdirty)
  cuse_method%do_mask = c_method%do_mask
  c_method%pflux = sic_present(1,0)
  c_method%pcycle = sic_present(2,0)
  c_method%qcycle = sic_present(3,0)
  !
  ! Set the pointers for use in subroutines
  hdirty%r3d => ddirty
  hclean%r3d => dclean
  hbeam%r4d  => dbeam
  hresid%r3d => dresid
  hprim%r4d  => dprim
  !
  ! Compact Array version
  c_hdirty%r3d => c_ddirty
  c_hclean%r3d => c_dclean
  c_hresid%r3d => c_dresid
  c_hbeam%r3d => c_dbeam
  c_hprim%r3d => c_dprim
  !
  limits = sic_present(1,0)
  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(method%m_iter+200) *   &
          &      log(float(method%m_iter+1)) ) * method%gain
     if (-hdirty%gil%rmin.gt.1.3*hdirty%gil%rmax) then
        ! Probably negative
        ylimn = ylimp*hdirty%gil%rmin
        ylimp = 0.0
     elseif (-1.3*hdirty%gil%rmin.gt.hdirty%gil%rmax) then
        ! Probably positive
        ylimn = 0.0
        ylimp = ylimp*hdirty%gil%rmax
     else
        ! Do not know...,
        ylimn = ylimp*hdirty%gil%rmin
        ylimp = ylimp*hdirty%gil%rmax
     endif
  endif
  ! Usefull variables
  nx = hdirty%gil%dim(1)
  ny = hdirty%gil%dim(2)
  np = hprim%gil%dim(1)
  mx = c_hdirty%gil%dim(1)
  my = c_hdirty%gil%dim(2)
  mp = c_hprim%gil%dim(1)
  !
  ! Clean Component Structure
  if (allocated(tcc)) then
     deallocate(tcc)
  endif
  allocate(tcc(method%m_iter),stat=ier)
  !
  ! Beam patch according to Method
  if (user_method%patch(1).ne.0) then
     method%patch(1) = min(user_method%patch(1),nx)
  else
     method%patch(1) = min(nx,max(32,nx/4))
  endif
  if (user_method%patch(2).ne.0) then
     method%patch(2) = min(user_method%patch(2),ny)
  else
     method%patch(2) = min(ny,max(32,ny/4))
  endif
  !
  if (cuse_method%patch(1).ne.0) then
     c_method%patch(1) = min(cuse_method%patch(1),mx)
  else
     c_method%patch(1) = min(mx,max(32,mx/4))
  endif
  if (cuse_method%patch(2).ne.0) then
     c_method%patch(2) = min(cuse_method%patch(2),my)
  else
     c_method%patch(2) = min(my,max(32,my/4))
  endif
  !
  ! Beam Fourier Transform
  allocate(tfbeam(nx,ny,np),c_tfbeam(mx,my,mp),stat=ier)
  !
  ! Number of compact components per cycle
  call sic_get_inte ('C_GOAL',c_method%ngoal,error)
  !
  if (method%pflux)  &
     call init_flux90(method,hdirty,ylimn,ylimp,ipen)
  !
  method%bzone(1:2) = 1
  method%bzone(3:4) = hdirty%gil%dim(1:2)
  c_method%bzone(1:2) = 1
  c_method%bzone(3:4) = c_hdirty%gil%dim(1:2)
  !
  if (imethod.eq.1) then
     call sub_alma (   &
          &      method,hdirty,hresid,hclean,hbeam,   &
          &      hprim,tfbeam,d_list,   &
          &      c_method,c_hdirty,c_hresid,c_hclean,c_hbeam,   &
          &      c_hprim,c_tfbeam,c_list,   &
          &      error,tcc)
  elseif  (imethod.eq.2) then
     call sub_alma_quad (   &
          &      method,hdirty,hresid,hclean,hbeam,   &
          &      hprim,tfbeam,d_list,   &
          &      c_method,c_hdirty,c_hresid,c_hclean,c_hbeam,   &
          &      c_hprim,c_tfbeam,c_list,   &
          &      error,tcc)
  elseif  (imethod.eq.3) then
     call sub_alma_ter (   &
          &      method,hdirty,hresid,hclean,hbeam,   &
          &      hprim,tfbeam,d_list,   &
          &      c_method,c_hdirty,c_hresid,c_hclean,c_hbeam,   &
          &      c_hprim,c_tfbeam,c_list,   &
          &      error,tcc)
  endif
  !
  ! Restore the Compact Beam Pointer
  c_hbeam%r3d => c_dbeam
  !
  if (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 = method%major
  hclean%gil%mino = method%minor
  hclean%gil%posa = pi*method%angle/180.0
  save_data(code_save_clean) = .true.
  !
  ! Save general parameters...
  user_method%ibeam = method%ibeam
  user_method%nlist = method%nlist
  return
  !
end subroutine alma_clean
!
subroutine compact_data(error)
  use gkernel_interfaces
  use clean_def
  use clean_arrays
  use gbl_message
  logical error
  !
  integer nx,ny,nv,ier
  logical equal
  character(len=5) :: rname = 'CLEAN'
  !
  error = .false.
  if (c_hdirty%loca%size.eq.0) then
    call map_message(seve%e,rname,'No dirty image')
    error = .true.
  endif
  if (c_hbeam%loca%size.eq.0) then
    call map_message(seve%e,rname,'No dirty beam')
    error = .true.
  endif
  if (error) return
  !
  ! Create clean image if needed
  nx = c_hdirty%gil%dim(1)
  ny = c_hdirty%gil%dim(2)
  nv = c_hdirty%gil%dim(3)
  !
  call gdf_compare_shape(c_hdirty,c_hclean,equal)
  if (.not.equal) then
    if (allocated(c_dclean)) deallocate(c_dclean,stat=ier)
    call sic_delvariable ('C_CLEAN',.false.,error)
    if (allocated(c_dresid)) deallocate(c_dresid,stat=ier)
    call sic_delvariable ('C_RESID',.false.,error)
    if (allocated(c_atten)) deallocate(c_atten,stat=ier)
    if (allocated(c_mask)) deallocate(c_mask,stat=ier)
    if (allocated(c_list)) deallocate(c_list,stat=ier)
    call sic_delvariable ('C_MASK',.false.,error)
  endif
  !
  if (.not.allocated(c_dclean)) then
    c_hclean = c_hdirty        ! Define header
    allocate(c_dclean(nx,ny,nv),stat=ier)
    call sic_def_real ('C_CLEAN',c_dclean,c_hclean%gil%ndim,   &
        &      c_hclean%gil%dim,.true.,error)
    c_hresid = c_hdirty
    allocate(c_dresid(nx,ny,nv),stat=ier)
    call sic_def_real ('C_RESID',c_dresid,c_hresid%gil%ndim,   &
        &      c_hresid%gil%dim,.true.,error)
  endif
  !
  if (.not.allocated(c_mask)) then
    allocate(c_mask(nx,ny),c_list(nx*ny),stat=ier)
    call sic_def_inte_addr ('C_MASK',c_mask,2,c_hdirty%gil%dim,   &
        &      .true.,error)
    cuse_method%do_mask = .true.
!    cuse_method%mask => c_mask
!    cuse_method%list => c_list
    cuse_method%nlist = 0
  endif
  !
  ! Allocate weight and check beam/image compatibility
  if (cuse_method%mosaic) then
    if (.not.allocated(c_atten)) then
      allocate(c_atten(nx,ny,1),stat=ier)
      if (ier.ne.0) then
        error = .true.
        return
      endif
      cuse_method%atten => c_atten
    endif
  elseif (c_hbeam%gil%dim(3).le.1) then
    continue
  elseif (c_hbeam%gil%dim(3).ne.c_hdirty%gil%dim(3)) then
    call map_message(seve%e,rname,'Inconsistent beam and image data set '//  &
        & 'or mosaic mode not set')
    error = .true.
  endif
end subroutine compact_data
