subroutine sub_major(method,hdirty,hresid,hclean,   &
     &    hbeam,hprim,hmask,dcct,mask,list,error,        &
     &    major_plot, next_flux)
  use gkernel_interfaces
  use mapping_interfaces, except_this=>sub_major
  use clean_def
  use image_def
  use gbl_message
  !--------------------------------------------------------------
  ! @ 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
  !
  character(len=*), parameter :: rname='SUB_MAJOR'
  character(len=64) :: mess
  integer :: ith
  logical :: parallel
  !
  ith = 1024
  parallel = .false.
  !$ parallel = .true.
#ifndef GAG_USE_STATICLINK
  !$ call sic_get_inte('OMP_SIZE',ith,error)
#endif
  error = .false.
  if (hdirty%gil%dim(1)*hdirty%gil%dim(2).gt.ith**2) then
    if (parallel) then
      mess = 'Using sequential code with Open-MP in-plane parallel mode'
    else
      mess = 'Using non-parallel mode'
    endif
    call map_message(seve%i,method%method,mess)
    call sub_major_lin(method,hdirty,hresid,hclean,   &
     &    hbeam,hprim,hmask,dcct,mask,list,error,        &
     &    major_plot, next_flux)
  else
    if (parallel) then
      mess = 'Using Open-MP parallel code'
    else
      mess = 'Using Open-MP capable code in Non-Parallel mode'
    endif
    call map_message(seve%i,method%method,mess)
    call sub_major_omp(method,hdirty,hresid,hclean,   &
     &    hbeam,hprim,hmask,dcct,mask,list,error,        &
     &    major_plot, next_flux)
  endif
end subroutine sub_major
!
subroutine sub_major_omp(inout_method,hdirty,hresid,hclean,   &
     &    hbeam,hprim,hmask,dcct,mask,list,error,        &
     &    major_plot, next_flux)
  use gkernel_interfaces
  use mapping_interfaces, except_this=>sub_major_omp
  use clean_def
  use clean_default
  use clean_support
  use image_def
  use gbl_message
  !$ use omp_lib
  !--------------------------------------------------------------
  ! @ 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) :: 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 :: beam(:,:)   ! Beam
  real, pointer :: d3prim(:,:,:)    ! Primary beam
  real, pointer :: d3beam(:,:,:)    ! Dirty beam (per field)
  real, pointer :: weight(:,:) ! Mosaic weight
  !
  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(:,:)
  real, allocatable :: tfbeam(:,:,:)
  integer, allocatable :: mymask(:,:)
  integer :: f_iter, m_iter
  !
  type (clean_par), save :: method
  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, lc, i, jcode
  real fhat, limit, flux
  logical do_fft
  character(len=message_length) :: chain
  character(len=16) :: cmethod
  character(len=48) :: cthread
  character(len=24) :: cname
  character(len=*), parameter :: rname = 'CLEAN'
  integer :: ibeam, ithread, mthread, nplane
  logical :: omp_nested
  ! Mask & List per thread
  integer :: nmask, j
  logical, allocatable, target :: masks(:,:,:)
  integer, allocatable, target :: lists(:,:)
  logical dotruc
  logical, pointer :: lmask(:,:)
  integer, pointer :: llist(:)
  integer :: iii
  !
  type (cct_par), allocatable :: tcc(:)
  real, save :: major,minor,angle
  !
  error = .false.
  !
  method = inout_method
  !
  cmethod = method%method
  do_fft = cmethod.ne.'HOGBOM'
  !
  ! 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))
  !
  ! TFBEAM cannot be on the Call sequence here because 
  ! it must be PRIVATE in parallel sections
  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,rname,'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,rname,'FFT Memory allocation failure')
    error = .true.
    return
  endif
  !
  ier = 0
  select case (cmethod)
  case ('CLARK')
    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)
  case ('SDI')
    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)
  case ('MULTI')
    allocate (w_comp(1),w_cct(nx,ny),mymask(nx,ny), &
      & s_mask(nx,ny),s_resi(nx,ny),t_beam(nx,ny), &
      & s_beam(nx,ny,3),stat=ier)
  case default
    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)
  end select
  if (ier.ne.0) then
    call map_message(seve%e,rname,'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,rname,'Memory allocation error for TCC')
    error = .true.
    return
  endif
  !
  !
  mthread = 1
  ithread = 1
  !$  mthread = omp_get_max_threads()
  nplane = method%last-method%first+1
  !$  omp_nested = omp_get_nested()
  if (nplane.eq.1) then
    !$  call omp_set_nested(.true.)
  else
    !$  call omp_set_nested(.false.)
  endif
  !
  ! Global aliases: SHARED here
  if (support_type.eq.support_mask) then    
    !
    ! Allocate the Masks and List per-thread
    nmask = min(hmask%gil%dim(3),nplane,mthread)
    if (nmask.gt.1) then
      allocate(masks(nx,ny,nmask),lists(nx*ny,nmask),stat=ier)
      if (ier.ne.0) then
        call map_message(seve%e,rname,'Mask & List memory allocation error')
        return
      endif
    endif
  else
    !
    ! Keep the global association
    nmask = 0
  endif
  !
  cname = method%method
  ! 
  ! I had parallel block crashing if there were more threads
  ! than DO loop index (it should not but I could not find why).
  ! Seems to have disappeared with newer version of gfortran and/or
  ! extended stack
  !
  ! However, the common code is executed MTHREAD times
  ! Only loops are executed NPLANE times in this case,
  ! so limiting the MTHREAD would be good - but then
  ! number of threads must be reset at end.
  ! 
  !$ !  if (nplane.lt.mthread) call omp_set_num_threads(nplane)
  !$ !  Print *,'Number of threads ',omp_get_num_threads()
  !
  !
  ! I need some CLEAN beam parameters
  if (omp_debug) Print *,'Getting SOME beam parameters '
  iplane = method%first
  ibeam = beam_for_channel(iplane,hdirty,hbeam)
  d3beam  => hbeam%r4d(:,:,:,ibeam)
  call get_clean (inout_method, hbeam, d3beam, error) !! TEST
  if (omp_debug) Print *,'Got SOME beam parameters '
  !
  ! Loop here if needed
  !$OMP PARALLEL IF (nplane.gt.1) DEFAULT(none) & !! IF (nplane.ge.mthread) &
  !$OMP & SHARED(hdirty,hclean,hbeam,hprim,hresid,hmask) & ! Headers
  !$OMP & SHARED(dummy_prim,dummy_weight,dcct) & ! Big arrays
  !$OMP & SHARED(fhat, nx,ny,mx,my,np,nc, omp_debug) &
  !$OMP & SHARED(inout_method)  & ! A modified structure
  !$OMP & SHARED(major,minor,angle,cmethod) &
  !$OMP & SHARED(nmask,masks,lists,mask,list) &
  !$OMP & PRIVATE(method, dotruc)  &  ! A modified structure
  !$OMP & PRIVATE(iplane, ibeam, error, nl, chain, cthread, cname) &
  !$OMP & PRIVATE(tfbeam,w_work,w_fft,w_comp,w_cct,tcc) &   ! Arrays
  !$OMP & PRIVATE(flux,f_iter,m_iter,limit,ithread,jcode) &
  !$OMP & PRIVATE(ix,iy,i,j) &  ! These were NOT diagnosed by the DEFAULT(none)
  !$OMP & PRIVATE(d3beam,d3prim) &
  !$OMP & PRIVATE(mymask,s_mask,s_beam,s_resi,t_beam)  & ! Arrays
  !$OMP & PRIVATE(dirty,resid,clean) PRIVATE(weight,llist,lmask)  ! Pointers
  !
  ! Global aliases: PRIVATE inside
  if (.not.method%mosaic) then
    weight => dummy_weight
  endif
  !
  ! Re-Define the method (in parallel mode, private entities are uninitialized)
  method = inout_method
  if (nmask.gt.1) then
    method%imask = 0 ! Mask is undefined at beginning if more than 1 plane
  endif
  !
  ithread = 1
  !$  ithread = omp_get_thread_num()+1
  !
  !$OMP DO SCHEDULE(STATIC,1) !! SCHEDULE(DYNAMIC,1)
  do iplane = inout_method%first, inout_method%last
    !
    method%iplane = iplane
    !
    call get_stopping(method%m_iter,method%ares,iplane)
    !$ write(cthread,'(A,I2)') ', Thread ',ithread
    !$ write(cname,'(A,A,I0,A)') trim(cmethod),'(',iplane,')' 
    !
    if (omp_debug) then
      !$OMP CRITICAL
      Print *,'Calling beam_plane '//cthread
      call mapping_print_debug(method)
      Print *,'Done beam_plane '//cthread
      !$OMP END CRITICAL
    endif
    !
    !THAT IS CRASHING ! call beam_plane(method,hbeam,hdirty)
    ibeam = beam_for_channel(iplane,hdirty,hbeam)
    method%ibeam = ibeam
    !
    ! Get the new mask
    if (nmask.gt.1) then
      lmask => masks(:,:,ithread)
      llist => lists(:,ithread)
    else
      lmask => mask
      llist => list
    endif
    !$ if (omp_debug) Print *,'Calling get_maskplane - OMP'
    call get_maskplane(method,hmask,hdirty,lmask,llist)    
    nl = method%nlist
    !$ if (omp_debug) Print *,'Thread ',ithread,' NL ',nl
    !
    ! Local aliases
    if (method%imask.ge.1) then
      write(chain,'(A,A,I0,A,I0,A,I0,1x,I0)') 'Planes: ', & 
          & '  Image ',method%iplane, & 
          & ', - Beam ', method%ibeam, & 
          & ', - Mask ', method%imask, nl
    else
      write(chain,'(A,A,I0,A,I0,A,I0)') 'Planes: ', & 
          & '  Image ',method%iplane, & 
          & ', - Beam ', method%ibeam
    endif
    !$ chain = trim(chain)//cthread
    call map_message(seve%i,cname,chain)
    !
    ! Local aliases
    dirty => hdirty%r3d(:,:,iplane)
    resid => hresid%r3d(:,:,iplane)
    clean => hclean%r3d(:,:,iplane)
    !
    ! Initialize to Dirty map
    resid = dirty
    !
    d3beam  => hbeam%r4d(:,:,:,ibeam)
    if (method%mosaic) then
      d3prim => hprim%r4d(:,:,:,ibeam)
    else
      d3prim => dummy_prim
    endif
    !
    if (method%pcycle) call init_plot (method,hdirty,resid)
    !
    ! Prepare beam parameters - subroutine is not Thread safe though...
    !$OMP CRITICAL
    !$ if (omp_debug) Print *,'Critical get_clean '//cthread
    error = .false.
    call get_clean (method, hbeam, d3beam, error)
    !$ if (omp_debug) Print *,'end Critical get_clean '//cthread
    !$OMP END CRITICAL
    if (error) then
      !return !Oops, cannot do that in a DO parallel...
      cycle
    endif
    !$ if (omp_debug) Print *,'start get_beam '//cthread
    call get_beam (method,hbeam,hresid,hprim,   &
        &        tfbeam,w_work,w_fft,fhat,error, lmask)
    !$ if (omp_debug) Print *,'end get_beam '//cthread
    ! 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
      !$ if (omp_debug) Print *,'Setting weight for ',method%ibeam
      ! Reset search list as the mask may have been altered
      call lmask_to_list (lmask,nx*ny,llist,method%nlist)
      nl = method%nlist
      weight => method%weight(:,:,method%ibeam)
      !$ if (omp_debug) Print *,'Done weight for ',method%ibeam
      resid = resid * weight
    endif
    !
    ! Performs decomposition into components only
    ! if NL # 0 
    if (nl.ne.0) then
      !$ if (omp_debug) Print *,'Select case '//cmethod//cthread
      select case (cmethod)
      case('HOGBOM')
        call hogbom_cycle90 (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_cycle90 (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_sdi90 (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
             &        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,cname,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_multi90 (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
      !$ if (omp_debug) Print *,'End Select case '//cmethod//cthread
    else
      ! Empty search area: No Clean components...
      method%n_iter = 0
      flux = 0.0
    endif
    !
    ! Add clean components and residuals to produce clean map
    if (method%n_iter.ne.0) then
      !$ if (omp_debug) Print *,'Critical clean_make '//cthread
      call clean_make90 (method, hclean, clean, tcc)
      !$ if (omp_debug) Print *,'End clean_make '//cthread
      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
        where (weight.eq.0) clean = hclean%gil%bval ! Undefined pixel there
      endif
    endif
    !$ if (omp_debug) Print *,'Finishing '//cthread
    !
    ! Put the TCC structure into its final place
    if (cmethod.eq.'MULTI' .or. cmethod.eq.'SDI') then
      if (method%n_iter.eq.0) then
        dcct(3,iplane,1) = 0
        write (chain,'(A,1PG10.3,A,I6,A,A,I6)')  'Cleaned ',0.0,   &
            &        ' Jy with ',method%n_iter,' components ' &
            &       ,' Plane ',iplane
      else
        if (cmethod.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'
        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)')  'Cleaned ',flux,   &
              &        ' Jy with ',method%n_iter,' components ' &
              &       ,' Plane ',iplane
        endif
      endif
      !$ chain = trim(chain)//cthread
      call map_message(seve%i,cname,chain)
    else if (cmethod.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 (cmethod.eq.'HOGBOM') then
        write (chain,'(A,1PG10.3,A,I6,A,A,I6)')  'Cleaned ',flux,   &
          &        ' Jy with ',method%n_iter,' components ' &
          &       ,' Plane ',iplane
        !$ chain = trim(chain)//cthread
        call map_message(seve%i,cname,chain)
      endif
      !
    endif
    !$ if (omp_debug) Print *,'End loop '//cthread
  enddo
  !$OMP END DO
  ! There is no OMP FIRST_AND_LASTPRIVATE
  !$OMP MASTER
  major = method%major
  minor = method%minor
  angle = method%angle
  !$OMP END MASTER
  !!Print *,'Major ',major,minor,angle
  !$OMP END PARALLEL
  inout_method%major = major
  inout_method%minor = minor
  inout_method%angle = angle
  !$  call omp_set_nested(omp_nested)
  !$  if (nplane.lt.mthread) call omp_set_num_threads(mthread)
  !
  if (allocated(masks)) then
    deallocate(masks,lists)
  endif
  !
  ! PHAT
  !!Print *,'sub_major PHAT ',method%phat
  ! This logic is only valid for One beam for all...
  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
  deallocate(w_comp,w_cct,mymask, &
    &  s_mask,s_resi,t_beam,s_beam, &
    &  w_work,w_fft, stat=ier)
  !
end subroutine sub_major_omp
!
!
subroutine sub_major_lin(method,hdirty,hresid,hclean,   &
     &    hbeam,hprim,hmask,dcct,mask,list,error,        &
     &    major_plot, next_flux)
  use gkernel_interfaces
  use mapping_interfaces, except_this=>sub_major_lin
  use clean_def
  use image_def
  use gbl_message
  !--------------------------------------------------------------
  ! @ 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, lc, 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(:)
  real, save :: major,minor,angle
  !
  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 get_clean (method, 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_cycle90 (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_cycle90 (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_sdi90 (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_multi90 (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_make90 (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
!
!
subroutine get_beam(method,hbeam,hresid,hprim,  &
     &    tfbeam,w_work,w_fft,fhat,error, mask)
  use gkernel_interfaces
  use mapping_interfaces, except_this => get_beam
  use clean_def
  use image_def
  use gbl_message
  !-----------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !    Get beam related information
  !-----------------------------------------------------------------
  type (clean_par), intent(inout) :: method
  type (gildas), intent(in)  :: hbeam
  type (gildas), intent(in)  :: hresid
  type (gildas), intent(in)  :: hprim
  real, intent(inout) :: tfbeam(hbeam%gil%dim(1),hbeam%gil%dim(2),hbeam%gil%dim(3))
  complex, intent(inout) :: w_work(hbeam%gil%dim(1),hbeam%gil%dim(2))
  real, intent(inout) :: fhat,w_fft(:)
  logical, intent(inout) :: error
  logical, optional, intent(inout) :: mask(:,:)
  !
  ! Note that HRESID is unused here...
  integer ip,ib,nx,ny,np,nb
  real beam_min,beam_max,beam_area,f
  integer ix_min,ix_max,iy_min,iy_max
  logical do_fft
  character(len=message_length) :: chain
  character(len=*), parameter :: rname = 'CLEAN'
  real, pointer :: d2beam(:,:)      ! Beam (single field & frequency)
  real, pointer :: d3prim(:,:,:)    ! Primary beams (per frequency)
  real, pointer :: d3beam(:,:,:)    ! Dirty beam (per frequency)
  real, pointer :: weight(:,:,:)
  !
  nx = hbeam%gil%dim(1)
  ny = hbeam%gil%dim(2)
  np = hbeam%gil%dim(3)
  nb = hbeam%gil%dim(4)
  !
  weight=> method%weight
  do_fft = method%method.ne.'HOGBOM'   &
       &    .and. method%method.ne.'MX'
  !
  if (method%mosaic) then
    if (.not.present(mask)) then
      call map_message(seve%f,rname,'Programming error: Missing MASK argument with MOSAIC mode')
      error = .true.
      return
    endif
    !
    d3beam => hbeam%r4d(:,:,:,method%ibeam)
    !
    np = hprim%gil%dim(1)
    !
    ! Analyze beam
    do ip = 1,np
      if (method%verbose) then
        write(chain,101) 'Field ',ip,'/',np
        call map_message(seve%i,rname,chain)
      endif
      call maxmap(d3beam(:,:,ip),nx,ny,method%bzone,   &
           &        beam_max,ix_max,iy_max,beam_min,ix_min,iy_min)
      if (method%verbose) then
        write(chain,'(A,1PG10.3,A,I6,I6,A,1PG10.3,A,I6,I6)') &
          &   'Beam max. ',beam_max,' at ',ix_max,iy_max,  &
          &   ', Min. ',beam_min,' at ',ix_min,iy_min
        call map_message(seve%i,rname,chain)
      endif
      if (do_fft) then
        call init_convolve (ix_max,iy_max,nx,ny,   &
            &          d3beam(:,:,ip),w_work,beam_area,w_fft)
        tfbeam(:,:,ip) = real(w_work)
        if (method%verbose) then
          write(chain,102) 'Beam area is ',beam_area
          call map_message(seve%i,rname,chain)
        endif
      endif
      !
      ! Prussian Hat - NOT SUPPORTED HERE
    enddo
    !
    if (method%method.ne.'HOGBOM') then
      call mos_sidelobe (d3beam(:,:,1),nx,ny,ix_max,iy_max,   &
           &        method%patch(1),method%patch(2),method%bgain,np)
      write(chain,102) 'Sidelobe is ',method%bgain
      call map_message(seve%i,rname,chain)
    endif
    !
    ! Define the weight function and truncate the mask
    do ib=1,nb
      d3prim => hprim%r4d(:,:,:,ib)
      call set_weight(nx,ny,np,weight(:,:,ib),d3prim,mask,   &
          &      method%search,method%restor,method%trunca)
    enddo
    !
    !
  else
    d2beam  => hbeam%r4d(:,:,1,method%ibeam)
    if (method%verbose) then
      Print *,'Beam center ',hbeam%r4d(nx/2+1,ny/2+1,1,method%ibeam)
    endif
    !
    ! Simple case
    call maxmap(d2beam,nx,ny,method%bzone,   &
        &      beam_max,ix_max,iy_max,   &
        &      beam_min,ix_min,iy_min)
    if (method%verbose) then
      write(chain,'(A,1PG10.3,A,I6,I6,A,1PG10.3,A,I6,I6)') &
        &   'Beam max. ',beam_max,' at ',ix_max,iy_max,  &
        &   ', Min. ',beam_min,' at ',ix_min,iy_min
      call map_message(seve%i,rname,chain)
    endif
    if (beam_max.eq.0.0) then
      call map_message(seve%w,rname,'Beam is empty')
      error = .true.
      return
    endif
    call comshi (d2beam,nx,ny,ix_max,iy_max,method%bshift)
    if (do_fft) then
      call init_convolve (ix_max,iy_max,nx,ny,   &
           &        d2beam,w_work,beam_area,w_fft)
      tfbeam(:,:,1)  = real(w_work)
      if (method%verbose) then
         write(chain,102) 'Beam area is ',beam_area
         call map_message(seve%i,rname,chain)
      endif
    endif
    !
    ! Prussian Hat
    if (method%phat.ne.0) then
      d2beam(ix_max,iy_max) = d2beam(ix_max,iy_max)   &
           &         + method%phat
      f = 1.0/d2beam(ix_max,iy_max)
      d2beam(:,:) = d2beam*f
    else
      f = 1.0
    endif
    !
    if (method%method.ne.'HOGBOM') then
      call find_sidelobe (d2beam,nx,ny,ix_max,iy_max,   &
           &        method%patch(1),method%patch(2),method%bgain)
      write(chain,102) 'Sidelobe is ',method%bgain
      call map_message(seve%i,rname,chain)
    endif
  endif
  method%beam0 = (/ix_max,iy_max/)
  if (method%phat.ne.0) fhat = f
  error = .false.
  return
  !
101 format(a,i3,a,i3)
102 format(a,1pg10.3,a,i6,i6)
end subroutine get_beam
!
subroutine get_stopping(miter,ares,iplane)
  use clean_arrays
  !
  integer, intent(inout) :: miter
  real, intent(inout) :: ares
  integer, intent(in) :: iplane
  !
  if (iplane.ge.1 .and. iplane.le.niter_listsize) then
    miter = niter_list(iplane)
  endif
  if (iplane.ge.1 .and. iplane.le.ares_listsize) then
    ares = ares_list(iplane)
  endif
end subroutine get_stopping
