subroutine sub_major_lin(method,hdirty,hresid,hclean,   &
     &    hbeam,hprim,hmask,dcct,mask,list,error,        &
     &    major_plot, next_flux)
  use gbl_message
  use image_def
  use gkernel_interfaces
  use mapping_interfaces, except_this=>sub_major_lin
  use cct_types
  use clean_types
  use clean_support_tool
  use clean_flux_tool, only: init_plot
  !--------------------------------------------------------------
  ! @ private
  !
  ! MAPPING Clean/Mosaic
  !     Perfom a CLEAN based on all CLEAN algorithms,
  !     except the MRC (Multi Resolution CLEAN)
  !     which requires a different tool
  !     Works for mosaic also, except for the Multi Scale clean
  !     (not yet implemented for this one, but feasible...)
  !--------------------------------------------------------------
  external :: major_plot
  external :: next_flux
  !
  type (clean_par), intent(inout) :: method
  type (gildas), intent(in) :: hdirty
  type (gildas), intent(inout) :: hbeam
  type (gildas), intent(inout) :: hclean
  type (gildas), intent(inout) :: hresid
  type (gildas), intent(in) :: hprim
  type (gildas), intent(in) :: hmask
  real, intent(inout) :: dcct(:,:,:) ! (3,hclean%gil%dim(3),*)
  logical, intent(in), target :: mask(:,:)
  integer, intent(in), target :: list(:)
  logical, intent(inout) ::  error
  !
  real, pointer :: dirty(:,:)  ! Dirty map
  real, pointer :: resid(:,:)  ! Iterated residual
  real, pointer :: clean(:,:)  ! Clean Map
  real, pointer :: d3prim(:,:,:)   ! Primary beam (for one frequency)
  real, pointer :: d3beam(:,:,:)   ! Dirty beam (for one frequency)
  real, pointer :: weight(:,:)     ! Mosaic weight
  !
  real, allocatable :: tfbeam(:,:,:)
  real, allocatable :: w_fft(:)    ! TF work area
  complex, allocatable :: w_work(:,:)  ! Work area
  type(cct_par), allocatable :: w_comp(:)
  real, allocatable :: w_cct(:,:)
  logical, allocatable :: s_mask(:,:)
  real, allocatable :: s_beam(:,:,:), t_beam(:,:), s_resi(:,:)
  integer, allocatable :: mymask(:,:)
  integer :: f_iter, m_iter
  !
  real, target :: dummy_prim(1,1,1), dummy_weight(1,1)
  integer iplane
  integer nx,ny,np,nl,mx,my,nc
  integer ip,ier,ix,iy,i,jcode
  real fhat, limit, flux
  logical do_fft
  character(len=message_length) :: chain
  character(len=12) :: cname 
  integer :: nplane
  !
  type (cct_par), allocatable :: tcc(:)
  !
  integer, pointer :: llist(:)
  logical, pointer :: lmask(:,:)
  !
  error = .false.
  do_fft = method%method.ne.'HOGBOM'
  cname = method%method
  !
  llist => list
  lmask => mask
  !
  ! Local variables
  nx = hclean%gil%dim(1)
  ny = hclean%gil%dim(2)
  mx = hbeam%gil%dim(1)
  my = hbeam%gil%dim(2)
  nl = method%nlist
  nc = nx*ny
  np = max(1,hprim%gil%dim(1)) ! or ! np = hbeam%gil%dim(3)
  !
  if (do_fft) then
    allocate(w_work(nx,ny),w_fft(2*max(nx,ny)),tfbeam(nx,ny,np),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,cname,'Memory allocation error for TFBEAM')
      error = .true.
      return
    endif
  else
    allocate(w_work(1,1),w_fft(1),tfbeam(1,1,1),stat=ier)  
  endif
  if (ier.ne.0) then
    call map_message(seve%e,cname,'FFT Memory allocation failure')
    error = .true.
    return
  endif
  !
  if (method%method.eq.'CLARK') then
    allocate(w_comp(nc), &
    & w_cct(1,1),mymask(1,1),s_mask(1,1),s_resi(1,1),t_beam(1,1), &
    & s_beam(1,1,3),stat=ier)
  elseif  (method%method.eq.'SDI') then
    allocate(w_comp(nc),w_cct(nx,ny),mymask(nx,ny), &
    & s_mask(1,1),s_resi(1,1),t_beam(1,1), &
    & s_beam(1,1,3),stat=ier)
  elseif  (method%method.eq.'MULTI') then
    allocate (s_mask(nx,ny),s_resi(nx,ny),t_beam(nx,ny), &
      & s_beam(nx,ny,3),w_cct(nx,ny),mymask(nx,ny), &
      & w_comp(1), stat=ier)
  else
    allocate(w_comp(1), &
    & w_cct(1,1),mymask(1,1),s_mask(1,1),s_resi(1,1),t_beam(1,1), &
    & s_beam(1,1,3),stat=ier)
  endif
  if (ier.ne.0) then
    call map_message(seve%e,cname,'Work Arrays Memory allocation failure')
    error = .true.
    return
  endif
  !
  ! Clean component work array
  allocate(tcc(method%m_iter),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,cname,'Memory allocation error for TCC')
    error = .true.
    return
  endif
  !
  nplane = method%last-method%first+1
  !
  ! Global aliases
  if (method%mosaic) then
    d3prim => dummy_prim
  else
    d3prim => dummy_prim
    weight => dummy_weight
  endif
  !
  cname = method%method
  !
  do iplane = method%first, method%last
    !
    method%iplane = iplane
    call beam_plane(method,hbeam,hdirty)
    ! Get the new mask (if any...)
    call get_maskplane(method,hmask,hdirty,lmask,llist)    
    nl = method%nlist
    !
    ! Local aliases
    if (method%imask.ge.1) then
      write(chain,'(A,I6,I6,I6,A,I2)') 'Image, Beam & Mask planes ',   &
          &      method%iplane,method%ibeam,method%imask
    else
      write(chain,'(A,I6,I6,A,I2)') 'Image & Beam planes ',   &
          &      method%iplane,method%ibeam
    endif
    call map_message(seve%i,cname,chain)
    dirty => hdirty%r3d(:,:,iplane)
    resid => hresid%r3d(:,:,iplane)
    clean => hclean%r3d(:,:,iplane)
    d3beam => hbeam%r4d(:,:,:,method%ibeam)
    if (method%mosaic) d3prim => hprim%r4d(:,:,:,method%ibeam)
    !
    ! Initialize to Dirty map
    resid = dirty
    if (method%pcycle) call init_plot (method,hdirty,resid)
    !
    ! Prepare beam parameters - subroutine is not Thread safe though...
    call method%fit_beam(hbeam,d3beam,error)
    if (error) then
      !return !Oops, cannot do that in a DO parallel...
      cycle
    endif
    call get_beam (method,hbeam,hresid,hprim,   &
        &        tfbeam,w_work,w_fft,fhat,error, lmask)
    ! Empty beam case
    if (error) then
      error = .false.
      clean = resid
      !return !Oops, cannot do that in a DO parallel...
      cycle
    endif
    !
    ! Mosaic case
    if (method%mosaic) then
      ! Reset search list as the mask may have been altered
      call lmask_to_list (lmask,nx*ny,llist,method%nlist)
      weight=> method%weight(:,:,method%ibeam)
      resid = resid * weight
    endif
    !
    !
    ! Performs decomposition into components
    select case (method%method)
    case('HOGBOM')
      call hogbom_cycle (cname,method%pflux,   &   ! Plot flux
           &        d3beam,mx,my,   & ! Beam and size
           &        resid,nx,ny,   & ! Residual and size
           &        method%beam0(1),method%beam0(2),   & ! Beam center
           &        method%box, method%fres, method%ares,   &
           &        method%m_iter,  method%p_iter, method%n_iter,   &
           &        method%gain, method%keep,   &    !
           &        tcc,   &         ! Component Structure
           &        lmask,   & ! Search mask
           &        llist,   & ! Search list
           &        nl,   &          ! and its size
           &        np,   &          ! Number of fields
           &        d3prim,   &       ! Primary beams
           &        weight,   &      ! Weight
           &        method%trunca, flux, jcode, next_flux)
    case('CLARK')
      !
      ! Find components
      call major_cycle (cname,method,hclean,   &   !
           &        clean,   &       ! Final CLEAN image
           &        d3beam,   &       ! Dirty beams
           &        resid,nx,ny,   & ! Residual and size
           &        tfbeam, w_work,   &  ! FT of dirty beam + Work area
           &        w_comp, nc,       &  ! Component storage + Size
           &        method%beam0(1),method%beam0(2),   & ! Beam center
           &        method%patch(1), method%patch(2), method%bgain,   &
           &        method%box,   &
           &        w_fft,   &       ! Work space for FFTs
           &        tcc,   &         ! Component table
           &        llist, nl,   &   ! Search list (truncated...)
           &        np,                & ! Number of fields
           &        d3prim,            & ! Primary beams
           &        weight,            & ! Weight
           &        major_plot,        & ! Plotting routine
           &        next_flux)
    case('SDI')
      !
      ! Find components
      call major_sdi (cname,method,hclean,   &
           &        clean,   &       ! Final CLEAN image
           &        d3beam(:,:,method%ibeam),   & ! Dirty beams
           &        resid,nx,ny,   & ! Residual and size
           &        tfbeam, w_work,   &  ! FT of dirty beam + Work area
           &        w_comp, nc,       &  ! Component storage + Size
           &        method%beam0(1),method%beam0(2),   & ! Beam center
           &        method%patch(1), method%patch(2), method%bgain,   &
           &        method%box,   &
           &        w_fft,   &       ! Work space for FFTs
           &        w_cct,   &       ! Clean Component Image
           &        llist, nl,   &   ! Search list (truncated...)
           &        np,                & ! Number of fields
           &        d3prim,            & ! Primary beams
           &        weight,            & ! Weight
           &        major_plot)          ! Plotting routine
    case('MULTI')
      !
      ! Performs decomposition into components
      call amaxmask (resid,lmask,nx,ny,ix,iy)
      limit = max(method%ares,method%fres*abs(resid(ix,iy)))
      call map_message(seve%i,method%method,chain)
      if (limit.eq.method%ares) then
        write (chain,'(A,1PG10.3,A)')  'Cleaning down to ',limit,' from ARES'
      else
        write (chain,'(A,1PG10.3,A,I7,I7)')  'Cleaning down to ',limit,' from FRES at ',ix,iy
      endif
      call map_message(seve%i,cname,chain)
      !
      call major_multi (cname,method,hclean,   &
           &        hdirty%r3d(:,:,iplane),   &
           &        hresid%r3d(:,:,iplane),   &
           &        hbeam%r4d(:,:,:,method%ibeam),                  &
           &        lmask,              & ! Check definition of this mask...
           &        hclean%r3d(:,:,iplane),   &
           &        nx,ny,                    &
           &        tcc,   &         ! Clean component
           &        method%m_iter,   &   ! Maximum number of components
           &        limit,   &       ! Residual
           &        method%n_iter,   &   ! Number of components
           &        s_mask,   &      ! Smoothed mask
           &        s_resi,   &      ! Smoothed residual,
           &        t_beam,   &      ! Translated beam
           &        w_work,   &      ! Complex work space
           &        s_beam,   &      ! Smoothed beams
           &        tfbeam,   &      ! Beam Fourier Transform (real)
           &        w_fft)
    ! Need to add
    !             &        np,   &          ! Number of fields
    !             &        d3prim,   &      ! Primary beams
    !             &        weight)          ! Weight
      w_cct(:,:) = clean
    end select
    !
    ! Add clean components and residuals to produce clean map
    if (method%n_iter.ne.0) then
      call clean_make (method, hclean, clean, tcc)
      if (np.le.1) then
        clean = clean + resid
      else
        clean = clean + resid*weight
        where (weight.eq.0) clean = hclean%gil%bval ! Undefined pixel there
      endif
    else
      if (np.le.1) then
        clean = resid
      else
        clean = resid*weight
      endif
    endif
    !
    ! Put the TCC structure into its final place
    if (method%method.eq.'MULTI' .or. method%method.eq.'SDI') then
      if (method%method.eq.'MULTI') then
        m_iter = method%ninflate*method%m_iter
      else
        m_iter = method%m_iter
      endif
      where (w_cct.ne.0)
        mymask = 1
      elsewhere
        mymask = 0
      end where
      f_iter = sum(mymask)
      if (f_iter.gt.m_iter) then
        write(chain,'(A,I8,A,I8)') 'Iterations overflow ',f_iter, &
            &  ' > ',m_iter
        call map_message(seve%w,cname,chain)
        dcct(3,iplane,1) = 0
        chain = 'UV_RESTORE will not work, consider increasing INFLATE'
        call map_message(seve%i,cname,chain)
      else
        i = 0
        flux = 0
        do iy=1,ny
          do ix=1,nx
            if (w_cct(ix,iy).ne.0) then
              i = i+1
              dcct(1,iplane,i) = (dble(ix) -   &
               & hclean%gil%convert(1,1)) * hclean%gil%convert(3,1) + &
               & hclean%gil%convert(2,1)
              dcct(2,iplane,i) = (dble(iy) -   &
               & hclean%gil%convert(1,2)) * hclean%gil%convert(3,2) + &
               & hclean%gil%convert(2,2)
              dcct(3,iplane,i) = w_cct(ix,iy)
              flux = flux+w_cct(ix,iy)
            endif
          enddo
        enddo
        method%n_iter = i
        write (chain,'(A,1PG10.3,A,I6,A,A,I6,A,I2)')  'Cleaned ',flux,   &
            &        ' Jy with ',method%n_iter,' components ' &
            &       ,' Plane ',iplane
        call map_message(seve%i,cname,chain)
      endif
    else if (method%method.ne.'MRC') then
      do i=1,method%n_iter
        dcct(1,iplane,i) = (dble(tcc(i)%ix) -   &
            & hclean%gil%convert(1,1)) * hclean%gil%convert(3,1) + &
            & hclean%gil%convert(2,1)
        dcct(2,iplane,i) = (dble(tcc(i)%iy) -   &
            & hclean%gil%convert(1,2)) * hclean%gil%convert(3,2) + &
            & hclean%gil%convert(2,2)
        dcct(3,iplane,i) = tcc(i)%value
      enddo
      if (method%n_iter.lt.method%m_iter) then
        dcct(3,iplane,method%n_iter+1) = 0
      endif
      if (method%method.eq.'HOGBOM') then
        write (chain,'(A,1PG10.3,A,I6,A,A,I6,A,I2)')  'Cleaned ',flux,   &
          &        ' Jy with ',method%n_iter,' components ' &
          &       ,' Plane ',iplane
        call map_message(seve%i,cname,chain)
      endif
      !
    endif
  enddo
  !
  ! PHAT
  if (method%phat.ne.0) then
    fhat = 1.0/fhat
    if (method%mosaic) then
      d3beam = d3beam*fhat
      do ip=1,np
        d3beam(method%beam0(1),method%beam0(2),ip) =   &
            &          d3beam(method%beam0(1),method%beam0(2),ip) -   &
            &          method%phat
      enddo
    else
      d3beam = d3beam*fhat
    endif
  endif
  !
  ! Set the blanking value for Mosaics
  if (method%mosaic) then
    hclean%gil%eval = 0
  endif
  !
  ! Clean work space: in principle, Fortran 95 does it for you
  if (method%method.eq.'CLARK') then
    deallocate(w_comp,stat=ier)
  elseif  (method%method.eq.'SDI') then
    deallocate(w_comp,w_cct,mymask)
  elseif  (method%method.eq.'MULTI') then
    deallocate (s_mask,s_resi,t_beam,s_beam,w_cct,mymask)
  endif
  if (do_fft) then
    deallocate(w_work,w_fft)
  endif
  !
end subroutine sub_major_lin
