!
! Things to do outside the deconvolution loop, i.e.
!   once for all channels requiring the same beam.
!
! 1) define the smoothing kernels
!     1 .. ns
!     1 is a delta function
!   The others are (truncated) parabolas. 
!   Cornwell uses in addition Spheroidals, by I do not see the point.
!
! 2) compute the convolved dirty beams
!     D**K(i),  i=2,ns    as K(1) = Delta   NS-1
!  and D**K(j)**K(i), (i=2,ns, j=i,ns)      NS*(NS-1)/2  such kernels
!     the order being 22, 33, 32, 44, 43, 42, etc... 
! 3)  compute the TF of these beams
!
! Things do do in the deconvolution loop
!
! - Only retain CC that falls within the mask for smoothed versions.
!   i.e. do not compute any smooth mask
! - For mosaic, what is removed is not totally obvious. There
!   is a commutation problem between smoothed components and 
!   primary beams. So the idea to deconvolve using the convolve
!   dirty beams may not work completely/exactly.
!
!
subroutine major_msc90 (rname,method,head,   &
     &    dirty,resid,beam,mask,clean,nx,ny,   &
     &    tcc,miter,limit,niter, &
     &    smask, sresid, trans, cdata, sbeam, &
     &    tfbeam, wfft)
! Need to add
!    &    nf, primary, weight)
  use imager_interfaces, except_this=>major_msc90
  use gkernel_interfaces
  use image_def
  use gbl_message
  use clean_def
  !$  use omp_lib
  !-----------------------------------------------------------------------
  ! @ public
  !
  ! MAPPING
  !     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
  type (clean_par), intent(inout) :: method
  type (gildas), intent(inout) :: head         ! Unused, but here for consistency...
  integer, intent(in)  :: nx,ny                ! Image size
  integer, intent(in)  :: miter                ! Maximum number of clean components
  integer, intent(out) :: niter                ! Number of found components
  real, intent(in)  :: dirty(nx,ny)            ! Dirty image
  real, intent(inout) :: resid(nx,ny)          ! Residual image (initialized to Dirty image)
  real, intent(in)  :: beam(nx,ny)             ! Dirty beam
  real, intent(inout) :: clean(nx,ny)          ! "CLEAN" image (not convolved yet)
  logical, intent(in)  :: mask(nx,ny)          ! Search area
  real, intent(in)  :: limit                   ! Maximum residual
  real, intent(in)  :: tfbeam(nx,ny)           ! Real Beam TF
  real, intent(inout) :: wfft(*)
  type (cct_par), intent(out) :: tcc(miter)
  !
  ! In call sequence
  real, intent(inout) ::  sbeam(nx,ny,*)          ! Smoothed beams
  real, intent(inout) ::  sresid(nx,ny)           ! Smoothed residuals
  real, intent(inout) ::  trans(nx,ny)            ! Translated beam
  complex, intent(inout) ::  cdata(nx,ny)         ! Work array
  logical, intent(inout) ::  smask(nx,ny)         ! Smoothed mask
  !
  ! Internal fixed size arrays
  integer, parameter :: ms=3
  integer, parameter :: mk=11
  integer nker(ms)             ! Kernel size
  integer  ns                  ! Number of Kernels
  real scale(ms)               ! Noise level for each beam
  real bruit(ms)               ! Residual level for each beam
  real sn(ms)                  ! Signal / Noise
  integer ix(ms),iy(ms)        ! Coordinates of each iteration maximum
  real again(ms)               ! Gain per kernel
  real gains(ms)               ! same after noise correction
  real fluxes(ms)              ! Cumulative flux per kernel
  real loss(ms)                ! Noise degradation factor...
  integer ncase(ms)
  real :: kernel(mk,mk,ms)           ! Smoothing kernels
  !
  ! Local work variables
  integer, parameter :: mcum=10
  integer ncum, ithread
  integer nn(2), ndim, kx,ky
  integer is,i,j, oldis, goodis
  real value, oldcum(mcum), converge, sign
  real maxa,flux,smooth,gain,maxsn,worry
  logical ok, plot, keep, printout, error
  character(len=message_length) :: chain
  character(len=24) :: string
  !
  ! Automatic, may need a bigger stack.
  !
  smooth = method%smooth
  gain = method%gain
  plot = method%pflux
  keep = method%keep
  nker = method%nker
  printout = method%verbose  ! Default behaviour
  again = method%gains
  worry = method%worry
  !
  ! Initialize the kernel
  kernel = 0.0
  ns = 1
  nker(1) = 1
  kernel = 0.0
  kernel(1,1,1) = 1.0
  !
  if (nker(2).gt.0) then
    call init_kernel(kernel(:,:,2),mk,nker(2),smooth)
    ns = 2
    if (nker(3).gt.0) then
      smooth = smooth**2
      call init_kernel(kernel(:,:,3),mk,nker(3),smooth)
      ns = 3
    endif
  endif
  ncase(1:ms) = 0
  fluxes(:) = 0.0
  trans(:,:) = 0.0
  !
  ! Initialize smoothed beams & mask
  call smooth_mask (mask,smask,nx,ny,nker(ns))
  !
  sbeam(:,:,1) = beam
  loss(1) = 1.0
  scale(1) = 1.0
  gains(1) = again(1)
  !
  kx = nx/2+1
  ky = ny/2+1
  do is = 2,ns
    call smooth_kernel (beam,sbeam(:,:,is),nx,ny,mk,nker(is),kernel(:,:,is))
    value = 1.0/sbeam(kx,ky,is)
    loss(is) = sqrt(value)
    scale(is) = value
    sbeam(:,:,is) = sbeam(:,:,is)*value  ! Now normalized
    kernel(:,:,is) = kernel(:,:,is)*value    ! Corresponding Kernel
    gains(is) = again(is)
  enddo
  !
  write(chain,'(A,3(1X,1PG11.4))') 'Scales ',scale
  call map_message(seve%i,rname,chain)
  write(chain,'(A,3(1X,1PG11.4))') 'Noise ',loss
  call map_message(seve%i,rname,chain)
  !
  ! Main clean loop
  niter = 0
  ok = niter.lt.miter
  flux = 0.0
  !
  ! Initialize convergence test
  call amaxmask (resid,mask,nx,ny,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
  !
  do           ! For ever...
    do is = 1,ns
      if (is.eq.1) then
        call amaxmask (resid,mask,nx,ny,ix(1),iy(1))
        bruit(1) = resid(ix(1),iy(1))
      else
        !
        ! Smooth within (smoothed) mask
        call smooth_masked(nx,ny,sresid,resid, &
      &        smask,mk,nker(is),kernel(:,:,is))
!
! or (slower) anywhere
!!        call smooth_kernel(resid,sresid,nx,ny,mk,nker(is),kernel(:,:,is))
        !
        ! Use MASK or SMASK, more or less at will...
        call amaxmask (sresid,mask,nx,ny,ix(is),iy(is))
        bruit(is) = sresid(ix(is),iy(is))
      endif
    enddo
    !
    maxa = -1.0
    do is = 1,ns
      sn(is) = abs(bruit(is)*loss(is))
      if (sn(is).gt.maxa) then
        maxa = sn(is)
        goodis = is
      endif
    enddo
    !
    if (niter.eq.0) 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
      ok = .false.  ! Stop if S/N has degraded
      exit
    endif
    maxsn = worry*sn(goodis)+(1.0-worry)*maxsn  ! Propagate S/N estimate
    !
    niter = niter+1
    !
    tcc(niter)%value = gains(goodis)*bruit(goodis)
    tcc(niter)%ix = ix(goodis)
    tcc(niter)%iy = iy(goodis)
    tcc(niter)%type = goodis
    !
    ! Do not Scale component flux : See Note Later
    flux = flux + tcc(niter)%value*scale(goodis)
    !
    oldcum(ncum) = flux
    ncum = ncum+1
    if (ncum.gt.mcum) ncum = 1
    converge = sign * (flux - oldcum(ncum))
    !
    ! Plot the new point
    if (printout.and.goodis.ne.oldis) then
      if (goodis.eq.1) then
        write(chain,101) niter,ix(goodis),iy(goodis),   &
     &            sn(1),sn(2),sn(3),bruit(goodis)*loss(goodis)
      elseif (goodis.eq.2) then
        write(chain,102) niter,ix(goodis),iy(goodis),   &
     &            sn(1),sn(2),sn(3),bruit(goodis)*loss(goodis)
      elseif (goodis.eq.3) then
        write(chain,103) niter,ix(goodis),iy(goodis),   &
     &            sn(1),sn(2),sn(3),bruit(goodis)*loss(goodis)
      endif
      call map_message(seve%r,rname,chain)
      oldis = goodis
    endif
    ncase(goodis) = ncase(goodis)+1
    ! Scale cumulative flux : See Note Later
    fluxes(goodis) = fluxes(goodis) + gains(goodis)*bruit(goodis)*scale(goodis)
    if (plot) then
      is = goodis
      call next_flux90 (niter,flux,is)
    endif
    !
    ! Subtract from residual
    !
    maxa = -again(goodis)*bruit(goodis)
    !
    ! Translate appropriate beam
    kx = ix(goodis)-nx/2-1
    ky = iy(goodis)-ny/2-1
    !
!$    ! Print *,'In parallel ',omp_in_parallel()
!$OMP PARALLEL &
!$OMP  & SHARED(nx,ny,kx,ky,goodis,trans)  PRIVATE(i,j)
!$OMP DO
    do j=max(1,ky+1),min(ny,ny+ky)
      do i=max(1,kx+1),min(nx,nx+kx)
        trans(i,j) = sbeam(i-kx,j-ky,goodis)
      enddo
    enddo
!$OMP END DO
    !
    ! Why not subtract everywhere ?
    !     resid = resid + maxa*trans
!    where (smask)
!      resid = resid + maxa*trans
!    end where
!$OMP DO
    do j=1,ny
      do i=1,nx
        resid(i,j) = resid(i,j) + maxa * trans(i,j)
        trans(i,j) = 0.0
      enddo
    enddo
!$OMP END DO
!$OMP END PARALLEL
    if (.not.keep) ok = ok.and.(converge.ge.0.0)
    if (.not.ok) exit
  enddo
  !
  if (niter.eq.miter) then
    string = 'iteration limit'
  else if (sn(goodis).gt.maxsn) then
    string = 'signal to noise stability'
  else if ((.not.keep).and.converge.lt.0.0) then
    string = 'flux convergence'
  else
    string = 'residual'
  endif
  write(chain,104) 'Stopped by ',trim(string),niter,bruit(1),limit
  call map_message(seve%i,rname,chain)
  do is=1,ns
    write(chain,105) '#',is,' Ncomp ',ncase(is),' Flux ',fluxes(is)
    call map_message(seve%i,rname,chain)
  enddo
  !
  ! 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
  !
  write(chain,'(A,1PG11.4)') 'Cleaned flux ',flux
  call map_message(seve%i,rname,chain)
  do i=1,niter
    value = tcc(i)%value
    kx = tcc(i)%ix
    ky = tcc(i)%iy
    is = tcc(i)%type
    if (is.eq.1) then
      clean (kx,ky) = clean(kx,ky) + value
    else
      call add_kernel (clean,nx,ny,value,kx,ky,mk,nker(is),kernel(:,:,is))
    endif
  enddo
  !
  ! Final residual
  cdata = cmplx(clean,0.0)
  ndim = 2
  nn(1) = nx
  nn(2) = ny
  call fourt(cdata,nn,ndim,-1,1,wfft)
  cdata = cdata*tfbeam            ! Complex by Real multiplication
  call fourt(cdata,nn,ndim,1,1,wfft)
  resid = dirty-real(cdata)
  !
  ! Convolution with clean beam is done outside
  return
  !
  101   format(i6,i4,i4,' [',1pg11.4,'] ',1pg11.4,2x,1pg11.4,'  = ',   &
     &    1pg11.4)
  102   format(i6,i4,i4,2x,1pg11.4,' [',1pg11.4,'] ',1pg11.4,'  = ',   &
     &    1pg11.4)
  103   format(i6,i4,i4,2x,1pg11.4,2x,1pg11.4,' [',1pg11.4,'] = ',   &
     &    1pg11.4)
  104   format(a,a,i6,1pg11.4,1x,1pg11.4)
  105   format(a,i1,a,i5,a,1pg11.4)
end subroutine major_multi90
!
