subroutine gclean_major (rname,method,head,   &
     &    beam,nx,ny,mx,my,            &
     &    dirty,resid,mask,clean,      &
     &    cct_list,siter,miter,limit,niter, &
     &    ms, gauss, cc_scales, tfbeam, wfft,  &
     &    np, primary, weight, othread, iplane)    ! For mosaics
  use gbl_ansicodes
  use imager_interfaces, except_this=>gclean_major
  use gkernel_interfaces
  use image_def
  use gbl_message
  use clean_def
  use clean_default
  use gclean_mod
  use omp_control
  !$  use omp_lib
  !-----------------------------------------------------------------------
  ! @ public-mandatory
  !*
  ! IMAGER -- CLEAN Method GAUSS  -- GCLEAN command  
  !     Multi-Resolution CLEAN - with NS (parameter) scales
  !
  !     Algorithm  
  !     For each iteration, search at which scale the signal to noise
  !     is largest. Use the strongest S/N to determine the "component"
  !     intensity and shape at this iteration.
  !
  !     Restore the ("infinite" resolution) image from the list of location
  !     types, and intensities of the "components"
  !
  !     The noise level at each scale is computed from the Fourier transform
  !     of the smoothed dirty beams, since the FT is the weight distribution
  !     and the noise level is the inverse square root of the sum of the
  !     weights.
  !!
  !-----------------------------------------------------------------------
  character(len=*), intent(in) :: rname     !! Caller name
  type(clean_par), intent(inout) :: method  !! Clean Method parameters
  type(gildas), intent(inout) :: head       !! Unused, but here for consistency...
  real, intent(in)  :: beam(:,:,:)          !! Dirty beams
  integer, intent(in)  :: nx,ny             !! Beam sizes
  integer, intent(in)  :: mx,my             !! Image size
  integer, intent(in) :: np                 !! Number of Pointings
  integer, intent(in)  :: siter             !! Starting Iteration
  integer, intent(in)  :: miter             !! Maximum number of clean components
  integer, intent(out) :: niter             !! Number of found components
  real, intent(in)  :: dirty(:,:)           !! Dirty image
  real, intent(inout) :: resid(:,:)         !! Residual image (initialized to Dirty image)
  real, intent(inout) :: clean(:,:)         !! "CLEAN" image (not convolved yet)
  real, intent(in) :: weight(:,:)           !! Combined weights
  integer, intent(in) :: ms                 !! Number of size scales
  real, intent(in) :: gauss(ms)             !! Size scales
  real, intent(out) :: cc_scales(ms)        !! Flux scaling factor ?
  logical, intent(in)  :: mask(:,:)         !! Search area
  real, intent(in)  :: limit                !! Maximum residual
  real, intent(in)  :: tfbeam(:,:,:)        !! Real Beam FT for final Clean restoration
  real, intent(inout) :: wfft(*)            !! Work space for FFT
  type(cct_lst), intent(inout) :: cct_list  !! Clean Component List
  real, intent(in) :: primary(np, mx, my)   !! Primary beams
  integer, intent(in) :: othread            !! Thread number (for messages and debugging)
  integer, intent(in) :: iplane             !! Current plane number (for messages and debugging)
  !
  ! Local ---
  integer :: dimcum, ncum, nchain
  integer :: kx,ky
  integer :: is,i,j, oldis, goodis, nl
  real, allocatable :: oldcum(:)
  real :: value, converge, sign, lastcum
  real :: maxa, maxp, flux,smooth,gain,maxsn,worry
  logical :: ok, plot, printout, interrupt
  character(len=message_length) :: chain
  character(len=28) :: string
  character(len=32) :: cname
  !
  ! Scales related ones, automatic arrays of small sizes
  real, allocatable :: sn(:)                  ! Signal / Noise 
  real, allocatable :: gains(:)               ! Gain per kernel 
  real, allocatable :: fluxes(:)              ! Cumulative flux per kernel
  integer, allocatable :: ncase(:)            ! Number of components per kernel case
  real, allocatable :: bruit(:)               ! Residual level for each kernel
  integer, allocatable :: ix(:),iy(:)         ! Coordinates of each iteration maximum
  !
  ! Smoothed Dirty images
  real, allocatable ::  gresid(:,:,:)
  !
  integer :: ip                ! Current pointing
  integer :: lx,ly             ! Current pixel and Offset from center
  integer :: counter
  integer :: clean_slow=0      ! Precision and Speed control code (for tests)
  integer :: step_iter         ! Printout every Step_Iter component
  logical :: error, detail
  !
  ! real, allocatable :: lbeam(:,:)  ! Local beam (average of all dirty beams)
  real :: flux_asymptote=0.    ! Asymptotic flux convergence test
  real :: flux_convergence
  integer :: same_scale =0     ! Do we keep same_scale iterations at the Same Scale before changing ?
  logical :: debug=.false.
  logical :: lcl_debug
  logical :: err
  integer :: nnt(3)
  !
  integer :: fs,ls, ncount, mthread
  integer :: ns,js,ks,ier
  !
  type(gildas) :: hdebug        ! Debug header
  real :: fact
  integer :: ng ! Number of sizes
  !
  ! Code ----
  call sic_get_logi('DEBUG',debug,error)
  error = .false.
  !
  if (debug) then
    nnt = [mx,my,1]
    err = .false.
    call v_size_r4_2('DIRTY',dirty,nnt,err)
    call v_size_r4_2('RESID',resid,nnt,err)
    call v_size_r4_2('CLEAN',clean,nnt,err)
    nnt(3) = max(np,1) ! For Mosaics PLEASE CHECK
    call v_size_r4_3('TFBEAM',tfbeam,nnt,err)
    if (np.gt.1) call v_size_r4_2('WEIGHT',weight,nnt,err)
    nnt = [nx,ny,np]
    call v_size_r4_3('BEAM',beam,nnt,err)
    nnt = [nx,ny,3]
    if (err) then
      call map_message(seve%e,rname,'Size error')
      error = .true.
      return
    endif
  endif
  cname = rname
  !
  step_iter = multi_print
  if (multi_print.eq.0) step_iter = 1000
  !
  ! Test Flux stability to 1 Sigma or a user specified fraction of the Maximum (default 1E-4)
  flux_convergence = max(1E-4,method%gain*head%gil%noise/head%gil%rmax)
  call sic_get_real('CLEAN_CONVERGE',flux_convergence,error)
  flux_convergence = head%gil%rmax * flux_convergence  
  error = .false.
  !
  call sic_get_inte('CLEAN_SLOW',clean_slow,error)
  clean_slow = min(clean_slow,3)
  if (clean_slow.lt.0) then
    call map_message(seve%w,cname,'Using approximate MultiScale method - Try CLEAN_SLOW = 0 for better result')
  else if (clean_slow.ne.0) then
    call map_message(seve%w,cname,"Speed set to CLEAN_SLOW "//char(clean_slow+ichar('0')))
  endif
  !
  call sic_get_real('CLEAN_END',flux_asymptote,error)
  call sic_get_inte('GCLEAN_PACK',same_scale,error)
  same_scale = max(0,same_scale)
  !
  dimcum = method%converge
  allocate(oldcum(max(1,dimcum)))
  !
  ! Initialize the Beams
  error = .false.
  call gclean_beams(cname,head,nx,ny,np,ms, gauss,beam, error) ! , gbeam,beamindex,scale)
  if (error) return
  !
  ! Local (per thread) arrays
  allocate(gresid(nx,ny,ms),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,cname,'Smoothed arrays allocation error')
    error = .true.
    return
  endif  
  !
  allocate(sn(ms),gains(ms),fluxes(ms),ncase(ms),bruit(ms),ix(ms),iy(ms),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,cname,'Scale arrays allocation error')
    error = .true.
    return
  endif    
  gains(1:ms) = method%gains(1:ms)   ! Now that it is allocated to size MS
  !
  ! Mosaic case still unclear
  do ip=1,np                         ! NP = 1 so far
    gresid(:,:,1) = resid(:,:)       ! Only one beam per field so far 
    call gclean_smooth(head,nx,ny,ms,gauss,gresid) 
  enddo
  !TEST!write(chain,'(A,I0)') 'Done       Smoothed beams for GCLEAN Thread ',othread
  !TEST!call map_message(seve%i,cname,chain)
  !
  smooth = method%smooth
  gain = method%gain
  plot = method%pflux
  printout = method%verbose  .or. debug ! Default behaviour
  worry = method%worry
  !
  ! Debug messages
  if (debug) then
    ng = (ms*(ms+1))/2
    call gildas_null(hdebug)
    call gdf_copy_header(head,hdebug,error)
    hdebug%gil%ndim = 4
    hdebug%gil%dim(3:4) = [ng,np]
    hdebug%gil%convert(:,3) = [1.,1.,1.]
    hdebug%file = 'beams.gdf'
    call gdf_write_image(hdebug,gbeam,error)
    ! For progress files
    hdebug%file = 'progress.gdf'
    hdebug%gil%ndim = 4
    hdebug%gil%dim(3) = ms
  endif
  !
  ! loss = sqrt(scale(1:ms))   ! Sensitivity loss
  !
  interrupt = .false.
  ncase(1:ms) = 0
  fluxes(:) = 0.0
  !
  kx = nx/2+1
  ky = ny/2+1
  ! 
  ! Main clean loop
  niter = siter-1      ! Start at siter
  ok = niter.lt.miter
  flux = 0.0
  lastcum = 0.
  !
  ! Initialize convergence test
  call amaxmask (resid,mask,mx,my,ix(1),iy(1))
  if (resid(ix(1),iy(1)).gt.0.0) then
    sign = 1.0
  else
    sign =-1.0
  endif
  ncum = 1
  converge = 0.0
  oldcum = 0.0
  oldis = 0
  goodis = 1    ! To prevent compiler warning only..
  maxsn = 0     ! Also
  sn =    0     ! Make sure they are all initialized
  counter = 0
  ncount = 0
  if (clean_slow.lt.0) then
    ncount = -clean_slow ! Test
    clean_slow = -2
  endif
  !
  detail = .false.    ! Debug test message
  ns = ms ! Number of scales
  !
  ! scale = 1.0  ! at this stage
  !
  if (debug) then
    if (miter.ne.0) write(hdebug%file,'(A,I0,A)') 'progress-',niter,'.gdf'
    call gdf_write_image(hdebug,gresid,error)
  endif
  fact = 1.0
  !
  ! Main code
  mthread = 1
  !$  lcl_debug = omp_debug
  !$  mthread = omp_get_max_threads()
  !$  if (omp_in_parallel()) then
  !$    if (omp_get_nested()) then
  !$      ! Further optimisation requires to know the number of Outer Threads
  !$      mthread = omp_inner_thread
  !$      if (lcl_debug) Print *,'Already in parallel mode, Outer THREAD ',omp_outer_thread,' Inner ',omp_inner_thread
  !$    else
  !$      mthread = 1
  !$      if (lcl_debug) Print *,'Already in parallel mode, Outer THREAD ',omp_outer_thread,' No Inner threads'
  !$    endif
  !$  else
  !$    mthread = omp_inner_thread
  !$    if (omp_get_nested()) then
  !$      if (lcl_debug) Print *,'Activating nesting ',omp_get_max_threads(),' possible, used ',mthread
  !$    else
  !$      if (lcl_debug) Print *,'No parallel, and No nesting either, ',mthread
  !$    endif
  !$  endif
  fs = 1
  ls = ns
  !
  !TEST!write(chain,'(A,I0)') 'Starting   Loop for GCLEAN Thread ',othread
  !TEST!call map_message(seve%i,cname,chain)
  !
  do           ! For ever...
    ! Conceptually, one may stay onto the same scale of a while
    ! based on the Mod(counter, step)
    !
    counter = counter+1
    !
    ! Locate the Clean Component - The Smoothed Beams do not intervene here,
    ! only the Normalized Kernel and Smoothed Mask
    maxa = -1.0
    bruit = 0.
    sn = 0.
    ! 
    ! Search only in the selected scales [fs,ls]
    do is = fs,ls
      call amaxmask (gresid(:,:,is),mask,mx,my,ix(is),iy(is))
      bruit(is) = gresid(ix(is),iy(is),is)
      !
      if (debug) print *,is, 'Bruit ',bruit(is),' Loss ',loss(is)
      sn(is) = abs(bruit(is)*loss(is))
      if (sn(is).gt.maxa) then
        maxa = sn(is)
        goodis = is
      endif
    enddo
    !
    if (debug) then
      write(*,*) 'Good ',goodis,'Bruit ',bruit,' Loss ',loss,' S/N ',sn  !Debug
      if (counter.lt.10) then
        is = goodis
        write(*,*) Counter,is,' IX IY ',ix(is),iy(is),' Resid ',gresid(ix(is),iy(is),is),bruit(is) !Debug
      endif
    endif
    !
    if (niter.lt.siter) maxsn = sn(goodis)
    !
    ! Check criterium
    ok = niter.lt.miter
    ok = ok .and. abs(bruit(1)).ge.limit
    if (.not.ok) exit
    if (sn(goodis).gt.maxsn) then
      if (niter.gt.2) then
        if (debug) write(*,*) 'Stopping by S/N ',sn(:),' Max is ',maxsn,' NITER ',niter
        ok = .false.  ! Stop if S/N has degraded
        exit
      else
        maxsn = sn(goodis)
      endif
    endif
    maxsn = worry*sn(goodis)+(1.0-worry)*maxsn  ! Propagate S/N estimate
    if (debug) write(*,*) 'Counter ',counter,' Maxsn ',maxsn,goodis,sn(goodis)
    !
    niter = niter+1
    if (niter.ge.cct_list%max_size) call cct_list%reallocate()
    !
    value = gains(goodis)*bruit(goodis)
    if (np.gt.1) then
      value = value * weight(ix(goodis),iy(goodis))    ! Convert to Clean component
    endif
    cct_list%cc(niter)%value = value*scale(goodis)     ! Scale the flux  
    cct_list%cc(niter)%ix = ix(goodis)
    cct_list%cc(niter)%iy = iy(goodis)
    cct_list%cc(niter)%size = goodis                   ! Scale size pointer
    cct_list%cur_size = niter
    !
    ! Do not Scale component flux : See Note Later (#1)
    flux = flux + value*scale(goodis)
    !
    ! Check flux stability - Switch to the accurate method when
    ! approaching convergence 
    if (dimcum.ne.0) then
      ! Keep last DIMCUM cumulative fluxes to test convergence
      oldcum(mod(niter,dimcum)+1) = flux
      lastcum = oldcum(mod(niter+1,dimcum)+1)
      converge = sign * (flux - lastcum) 
    endif
    !
    ! Print the new point
    if ((printout.and.(goodis.ne.oldis)).or.(mod(niter,step_iter).eq.0)) then
      select case(ms)
      case(1)
        write(chain,201) niter,ix(goodis),iy(goodis),   &
          &   c_red,sn(1),c_clear,sn(2),bruit(goodis)*loss(goodis)
      case(2)
        if (goodis.eq.1) then
          write(chain,201) niter,ix(goodis),iy(goodis),   &
            &   c_red,sn(1),c_clear,sn(2),bruit(goodis)*loss(goodis)
        elseif (goodis.eq.2) then
          write(chain,202) niter,ix(goodis),iy(goodis),   &
            &   sn(1),c_green,sn(2),c_clear,bruit(goodis)*loss(goodis)
        endif
      case(3)
        if (goodis.eq.1) then
          write(chain,301) niter,ix(goodis),iy(goodis),   &
            &   c_red,sn(1),c_clear,sn(2),sn(3),bruit(goodis)*loss(goodis)
        elseif (goodis.eq.2) then
          write(chain,302) niter,ix(goodis),iy(goodis),   &
            &   sn(1),c_green,sn(2),c_clear,sn(3),bruit(goodis)*loss(goodis)
        elseif (goodis.eq.3) then
          write(chain,303) niter,ix(goodis),iy(goodis),   &
            &   sn(1),sn(2),c_blue,sn(3),c_clear,bruit(goodis)*loss(goodis)
        endif
      case(4)
        if (goodis.eq.1) then
          write(chain,401) niter,ix(goodis),iy(goodis),   &
            &   c_red,sn(1),c_clear,sn(2),sn(3),sn(4),bruit(goodis)*loss(goodis)
        elseif (goodis.eq.2) then
          write(chain,402) niter,ix(goodis),iy(goodis),   &
            &   sn(1),c_green,sn(2),c_clear,sn(3),sn(4),bruit(goodis)*loss(goodis)
        elseif (goodis.eq.3) then
          write(chain,403) niter,ix(goodis),iy(goodis),   &
            &   sn(1),sn(2),c_blue,sn(3),c_clear,sn(4),bruit(goodis)*loss(goodis)
        elseif (goodis.eq.4) then
          write(chain,404) niter,ix(goodis),iy(goodis),   &
            &   sn(1),sn(2),sn(3),c_magenta,sn(4),c_clear,bruit(goodis)*loss(goodis)
        endif
      case(5)
        if (goodis.eq.1) then
          write(chain,501) niter,ix(goodis),iy(goodis),   &
            &   c_red,sn(1),c_clear,sn(2),sn(3),sn(4),sn(5),bruit(goodis)*loss(goodis)
        elseif (goodis.eq.2) then
          write(chain,502) niter,ix(goodis),iy(goodis),   &
            &   sn(1),c_green,sn(2),c_clear,sn(3),sn(4),sn(5),bruit(goodis)*loss(goodis)
        elseif (goodis.eq.3) then
          write(chain,503) niter,ix(goodis),iy(goodis),   &
            &   sn(1),sn(2),c_blue,sn(3),c_clear,sn(4),sn(5),bruit(goodis)*loss(goodis)
        elseif (goodis.eq.4) then
          write(chain,504) niter,ix(goodis),iy(goodis),   &
            &   sn(1),sn(2),sn(3),c_magenta,sn(4),c_clear,sn(5),bruit(goodis)*loss(goodis)
        elseif (goodis.eq.5) then
          write(chain,505) niter,ix(goodis),iy(goodis),   &
            &   sn(1),sn(2),sn(3),sn(4),c_cyan,sn(5),c_clear,bruit(goodis)*loss(goodis)
        endif
      case default
        write(*,*) "Unknown case ",ms
      end select
      nl = len_trim(chain)
      if (np.gt.1) then
        write(chain(nl+1:),'(1pg11.4)') weight(ix(goodis),iy(goodis))
        nl = nl+11
      endif
      if (nl.ne.0) call map_message(seve%i,cname,chain)
    endif
    ! In all cases
    oldis = goodis
    ncase(goodis) = ncase(goodis)+1
    ! Scale cumulative flux : See Note Later
    fluxes(goodis) = fluxes(goodis) + value*scale(goodis)
    if (plot) then
      is = goodis
      call next_flux90(niter,flux,is)
    endif
    !
    ! Subtract from residual
    !
    maxa = -value*scale(goodis)  ! This is the Clean Component to be subtracted 
    !
    ! Pixel offset in small beam (not in large map)
    kx = ix(goodis)-nx/2-1 
    ky = iy(goodis)-ny/2-1
    lx = ix(goodis)
    ly = iy(goodis)
    !
    ! Finish by Precise mode at end, or stay on the same size for a while...
    if (ns.ne.1) then
      if (flux_asymptote.gt.0.) then
        if (abs((flux-lastcum)/flux).le.flux_asymptote) then
          call map_message(seve%i,cname,'Switching to Point Source mode') 
          ns = 1
          fs = 1
          ls = 1
          oldis = 0
        endif
      else if (same_scale.ne.0) then
        ! Every "same_scale" iteration, go back to all scales.
        ! Otherwise, keep current scale
        if (mod(counter,same_scale).ne.0) then
          fs = oldis
          ls = oldis
        else
          fs = 1
          ls = ns
        endif
      endif
    endif
    !
    ! Remove in all scales
    if (np.eq.1) then
      !
      ! Translate appropriate beam
      do ks=1,ns    ! A priori, only these ones are needed at this stage
        js = beamindex(goodis,ks)
        !$OMP PARALLEL DEFAULT(none) NUM_THREADS(mthread) &
        !$OMP   &   SHARED(gresid,gbeam)  &
        !$OMP   &   SHARED(mx,my,nx,ny,kx,ky,maxa,js,ks) &
        !$OMP   &   PRIVATE(i,j)
        !$OMP DO COLLAPSE(2)
        do j=max(1,ky+1),min(my,ny+ky)
          do i=max(1,kx+1),min(mx,nx+kx)
            gresid(i,j,ks) = gresid(i,j,ks) + maxa * gbeam(i-kx,j-ky,js,1)
          enddo
        enddo
        !$OMP ENDDO
        !$OMP END PARALLEL
      enddo
      !
      if (debug) then
        if (miter.ne.0) write(hdebug%file,'(A,I0,A)') 'progress-',niter,'.gdf'
        call gdf_write_image(hdebug,gresid,error)
      endif
    else
      ! Approximate code - does not take the non-commuting
      !   Convolution/Attenuation issue correctly, but correct for
      !   Point sources, and self correcting...
      !
      do ks=1,ns    ! NS is the largest scale considered at this stage
        js = beamindex(goodis,ks)
        ! Most efficient
        do ip=1,np
          !
          ! Globally attenuate by primary beam -- There is an issue here
          ! since normally each individual Clean Component should
          ! have a different attenuation
          !
          maxp = maxa * primary(ip,lx,ly)
          !
          !$OMP PARALLEL DEFAULT(none) NUM_THREADS(mthread) &
          !$OMP   &   SHARED(gresid,gbeam,primary,weight) &
          !$OMP   &   SHARED(mx,my,nx,ny,kx,ky,ip,maxp,js,ks) &
          !$OMP   &   PRIVATE(i,j)
          !$OMP DO COLLAPSE(2)
          do j=max(1,ky+1),min(my,ny+ky)
            do i=max(1,kx+1),min(mx,nx+kx)
              gresid(i,j,ks) = gresid(i,j,ks) + &
              & maxp*gbeam(i-kx,j-ky,js,ip)*primary(ip,i,j)*weight(i,j)
            enddo
          enddo
          !$OMP ENDDO
          !$OMP END PARALLEL
        enddo     ! Pointings
      enddo      ! Scales
    endif
    !
    if (dimcum.gt.0) then
      ok = ok.and.(converge.ge.0.0)
      ok = ok.and.(abs(converge).gt.flux_convergence)
    endif
    if (.not.ok) exit
    if (sic_ctrlc()) then
      interrupt = .true.
      exit
    endif
  enddo
  !
  if (niter.eq.miter) then
    string = 'iteration limit'
  else if (sn(goodis).gt.maxsn) then
    write(*,*) 'MaxSN ',maxsn,' current SN ',sn(goodis),' All sn ',sn
    string = 'signal to noise stability'
  else if (dimcum.gt.0.and.(abs(converge).le.flux_convergence) ) then
    write(string,'(A,1PG10.2)') 'Convergence ',flux_convergence ! ' > ',converge
  else if (interrupt) then
    string = 'User ^C interrupt'
  else
    string = 'residual limit'
  endif
  write(chain,100) 'Stopped by ',trim(string),niter,bruit(1),limit
  call map_message(seve%i,cname,chain)
  nchain = 1
  do is=1,ns
    write(chain(nchain:),101) is,ncase(is),fluxes(is)
    nchain = len_trim(chain)+2
  enddo
  call map_message(seve%i,cname,chain)
  !
  ! Done: RESTORATION Process now
  clean = 0.0
  !
  ! If CCT component flux are not scaled, use the Kernel as they are
  ! If they are scaled,  normalize them to 1 back again...
  !
  ! Here they are not scaled (see comment #1 Above)
  !
  do i=1,niter
    is = nint(cct_list%cc(i)%size)          ! Get the size Pointer
    cct_list%cc(i)%size = gauss(is)         ! Set the true Size
  enddo
  !
  method%n_iter = niter
  call clean_make(method,head,clean,cct_list%cc,gauss)
  !TEST!write(chain,'(A,I0)') 'Done       Clean_make for GCLEAN Thread ',othread
  !TEST!call map_message(seve%i,cname,chain)
  !
  ! Final residual
  if (np.eq.1) then
    resid = gresid(:,:,1) 
    clean = clean+resid   
  else  
    ! For mosaic, use the Weight - We already have the Residual here...
    ! resid = dirty-real(cdata)*weight
    ! Convolution with clean beam is done outside (Mosaic ???)
    resid = gresid(:,:,1) 
    clean = clean+resid   
  endif
  !
  deallocate (sn,gains,fluxes,ncase,bruit,ix,iy,stat=ier)
  deallocate (gresid, stat=ier)
  return
  !
  100   format(a,a,i6,1x,1pg11.4,1x,1pg11.4)
  101   format(('#',i0,' Ncct ',i0,' Flux ',1pg11.4))
  !
  201   format(i6,i5,i5,a,' [',1pg11.4,'] ',a,1pg11.4,'  = ',   &
     &    1pg11.4,1pg11.4)
  202   format(i6,i5,i5,2x,1pg11.4,a,' [',1pg11.4,'] ',a,' = ',   &
     &    1pg11.4,1pg11.4)
  301   format(i6,i5,i5,a,' [',1pg11.4,'] ',a,1pg11.4,2x,1pg11.4,'  = ',   &
     &    1pg11.4,1pg11.4)
  302   format(i6,i5,i5,2x,1pg11.4,a,' [',1pg11.4,'] ',a,1pg11.4,'  = ',   &
     &    1pg11.4,1pg11.4)
  303   format(i6,i5,i5,2x,1pg11.4,2x,1pg11.4,a,' [',1pg11.4,']',a,' = ',   &
     &    1pg11.4,1pg11.4)
  401   format(i6,i5,i5,a,' [',1pg11.4,'] ',a,1pg11.4,2x,1pg11.4,2x,1pg11.4,'  = ',   &
     &    1pg11.4,1pg11.4)
  402   format(i6,i5,i5,2x,1pg11.4,a,' [',1pg11.4,'] ',a,1pg11.4,2x,1pg11.4,'  = ',   &
     &    1pg11.4,1pg11.4)
  403   format(i6,i5,i5,2x,1pg11.4,2x,1pg11.4,a,' [',1pg11.4,'] ',a,1pg11.4,'  = ',   &
     &    1pg11.4,1pg11.4)
  404   format(i6,i5,i5,2x,1pg11.4,2x,1pg11.4,2x,1pg11.4,a,' [',1pg11.4,']',a,' = ',   &
     &    1pg11.4,1pg11.4)
  501   format(i6,i5,i5,a,' [',1pg11.4,'] ',a,1pg11.4,2x,1pg11.4,2x,1pg11.4,2x,1pg11.4,'  = ',   &
     &    1pg11.4,1pg11.4)
  502   format(i6,i5,i5,2x,1pg11.4,a,' [',1pg11.4,'] ',a,1pg11.4,2x,1pg11.4,2x,1pg11.4,'  = ',   &
     &    1pg11.4,1pg11.4)
  503   format(i6,i5,i5,2x,1pg11.4,2x,1pg11.4,a,' [',1pg11.4,'] ',a,1pg11.4,2x,1pg11.4,'  = ',   &
     &    1pg11.4,1pg11.4)
  504   format(i6,i5,i5,2x,1pg11.4,2x,1pg11.4,2x,1pg11.4,a,' [',1pg11.4,'] ',a,1pg11.4,'  = ',   &
     &    1pg11.4,1pg11.4)
  505   format(i6,i5,i5,2x,1pg11.4,2x,1pg11.4,2x,1pg11.4,a,2x,1pg11.4,2x,a,' [',1pg11.4,']',a,' = ',   &
     &    1pg11.4,1pg11.4)
end subroutine gclean_major
!  
subroutine gclean_smooth(head,nx,ny,ms,gauss,gbeam,bmax)
  use image_def
  use imager_interfaces, only : mulgau
  use gkernel_interfaces, only : fourt
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !*
  ! IMAGER -- CLEAN Method GAUSS -- GCLEAN command  
  !   Compute smoothed beams or smoothed dirty
  !   Return max value if asked for.
  !!
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: head          !! Image header
  integer, intent(in) :: nx,ny,ms           !! Array sizes)
  real, intent(in)    :: gauss(ms)          !! Smoothing Gaussian in Radians
  real, intent(inout) :: gbeam(:,:,:)       !! Smoothed dirty beams
  real, intent(out), optional :: bmax(ms)   !! Renormalization factor
  !
  ! Local ---
  complex, allocatable :: ft(:,:)
  real, allocatable :: wfft(:)
  integer :: ndim, dim(2)
  integer :: is
  real(4) :: fact
  real(4) :: xinc,yinc
  !
  ! Code ----
  ndim = 2
  dim(1) = nx
  dim(2) = ny
  xinc = head%gil%convert(3,1)
  yinc = head%gil%convert(3,2)
  allocate(ft(nx,ny), wfft(2*max(nx,ny)))
  !
  fact = 1.0/(nx*ny)
  !$OMP PARALLEL DEFAULT(NONE) &
  !$OMP & SHARED(ms,dim,ndim,fact,xinc,yinc,nx,ny) &
  !$OMP & SHARED(gbeam,gauss) PRIVATE(ft,wfft,is)
  !
  !$OMP DO
  do is=1,ms
    if (gauss(is).ne.0) then
      !
      ft = cmplx(gbeam(:,:,1),0.0)
      call fourt(ft,dim,ndim,-1,0,wfft)
      !
      ! Beam Area = PI * BMAJ * BMIN / (4 * LOG(2) ) for flux density
      ! normalisation
      ! fact = cmajor*cminor*pi/(4.0*log(2.0))   &
      !     &    /abs(xinc*yinc)/(nx*ny)
      ! For simple FFT normalization
      !D Print *,'Calling MULGAU ',method%major, method%minor, method%angle
      call mulgau(ft,nx,ny,   &
           &    gauss(is),gauss(is),0.0,  &
           &    fact,xinc,yinc,-1)
      !D Print *,'Calling FOURT'
      call fourt(ft,dim,ndim,1,1,wfft)
      !
      gbeam(:,:,is) = real(ft)
    endif
    !Print *,'SCALE ',is,scale(is)
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  if (present(bmax)) then
    bmax(:) = gbeam(nx/2+1,ny/2+1,:)
  endif
end subroutine gclean_smooth
!
subroutine gclean_init
  use gclean_mod
  !! IMAGER - CLEAN Method GAUSS -- GCLEAN command  
  !!  Initialize scale arrays
  if (allocated(beamindex)) then
    deallocate(beamindex, scales, scale, loss, gbeam)
  endif
  !
  n_scales = 0
end subroutine gclean_init
!
subroutine gclean_beams(cname,head,nx,ny,np,ms,gauss,beam,error) !, gbeam,beamindex,scale)
  use image_def
  use imager_interfaces, only : gclean_smooth, map_message
  use gbl_message
  use gclean_mod
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER - CLEAN Method GAUSS -- GCLEAN command  
  !   Compute smoothed beams for all Pointings, and set
  !   the corresponding Scale and Loss factors.
  !*
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: cname !! Callers name
  type(gildas), intent(in) :: head      !! Image header for pixel size
  integer, intent(in) :: nx             !! X size
  integer, intent(in) :: ny             !! Y size
  integer, intent(in) :: np             !! Number of pointings
  integer, intent(in) :: ms             !! Number of scales
  real, intent(in) :: gauss(ms)         !! Scale sizes
  real, intent(in) :: beam(:,:,:)       !! Original dirty beams
  logical, intent(inout) :: error       !! Logical error flag
  !
  ! Local ---
  integer :: ng, is,js, ig,ip, ier
  real, allocatable :: bgauss(:)
  real, allocatable :: bmax(:)
  integer, allocatable :: bi(:)
  integer, allocatable :: bj(:)
  character(len=128) :: chain
  !
  ! Code ----
  if (n_scales.eq.0) then
    continue
  else if (n_scales.ne.ms) then
    Print *,'Scales mismatch ',n_scales, ms
    if (allocated(beamindex)) then
      deallocate(beamindex, scales, scale, loss, gbeam)
      Print *,'Deallocating arrays ...'
    endif
  else if (allocated(beamindex)) then
    return  ! Already computed
  endif
  ng = (ms*(ms+1))/2
  allocate (beamindex(ms,ms),scales(ng,np),scale(ng),loss(ng),gbeam(nx,ny,ng,np), stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,cname,'Smoothed arrays allocation error')
    error = .true.
    return
  endif 
  !
  allocate(bgauss(ng),bmax(ng),bi(ng),bj(ng))
  !
  ! Double Gaussian Index pointers
  do is=1,ms
    beamindex(1,is) = is
    beamindex(is,1) = is
    bi(is) = is
    bj(is) = is
  enddo
  ig = ms
  do is=2,ms
    do js=is,ms
      ig = ig+1
      beamindex(is,js) = ig
      beamindex(js,is) = ig
      bi(ig) = is
      bj(ig) = js
    enddo
  enddo
  ! Simple & Double Gaussians beam sizes
  do is=1,ms
    do js=is,ms
      ig = beamindex(is,js)
      bgauss(ig) = sqrt(gauss(is)**2+gauss(js)**2)
    enddo
  enddo
  !TEST!write(chain,'(A,I0)') 'Done       Index for GCLEAN Thread ',othread
  !TEST!call map_message(seve%i,cname,chain)
  !
  ! Compute all  Gaussian Smoothed beams
  do ip=1,np
    gbeam(:,:,1,ip) = beam(:,:,ip)    ! Per pointing
    call gclean_smooth(head,nx,ny,ng,bgauss,gbeam(:,:,:,ip),bmax) !
    ! Scales contains the scaling factor of Smoothed beams
    scales(:,ip) = 1./bmax ! That should be IP dependent
  enddo
  !
  ! We need the mean scale and loss over the Mosaic
  scale = 0.
  do ip=1,np
    scale = scale+scales(:,ip)
  enddo
  scale = scale/np
  loss(1:ms) = sqrt(scale(1:ms))
  !
  if (np.eq.1) then
    write(chain,'(A,6(F9.3))') 'Scales     : ',scale(1:ms)
    call map_message(seve%i,cname,chain)
  else
    write(chain,'(A,6(F9.3))') 'Scales     : ',scale(1:ms)
    call map_message(seve%i,cname,chain)
    do ip=1,np
      write(chain,'(A,I0,A,6(F9.3))') 'Scales for field ',ip,'  : ',scales(1:ms,ip)
      call map_message(seve%i,cname,chain)
    enddo
  endif
  write(chain,'(A,6(F9.3))') 'Noise loss : ',loss(1:ms)
  call map_message(seve%i,cname,chain)
  n_scales = ms     ! Needed at end only
  ! 
end subroutine gclean_beams
