subroutine sub_alma_ter (   &
     &    l_method,l_hdirty,l_hresid,l_hclean,   &
     &    l_hbeam,l_hprim,l_tfbeam,l_list,   &
     &    c_method,c_hdirty,c_hresid,c_hclean,   &
     &    c_hbeam,c_hprim,c_tfbeam,c_list,   &
     &    error,tcc)
  use gkernel_interfaces
  use mapping_interfaces, except_this=>sub_alma_ter
  use clean_def
  use image_def
  use gbl_message
  !--------------------------------------------------------------
  ! @ private
  !
  ! Clean/Mosaic
  !     Perfom a CLEAN based on all CLEAN algorithms,
  !     except the Multi Resolution which requires a different tool
  !     Works for mosaic also, except for the Multi Scale clean
  !     (not yet implemented for this one, but feasible...)
  !--------------------------------------------------------------
  type (clean_par), intent(inout) :: l_method, c_method
  type (gildas), intent(inout) :: l_hdirty, l_hbeam, l_hresid, l_hprim
  type (gildas), intent(inout) :: l_hclean
  type (gildas), intent(inout) :: c_hdirty, c_hbeam, c_hresid, c_hprim
  type (gildas), intent(inout) :: c_hclean
  real, intent(inout) :: l_tfbeam(l_hbeam%gil%dim(2),l_hbeam%gil%dim(3),l_hbeam%gil%dim(1))
  real, intent(inout) :: c_tfbeam(c_hbeam%gil%dim(2),c_hbeam%gil%dim(3),c_hbeam%gil%dim(1))
  logical, intent(inout) :: error
  type (cct_par), intent(inout) :: tcc(l_method%m_iter)
  integer, intent(in) :: l_list(:)
  integer, intent(in) :: c_list(:)
  !
  real, pointer :: c_dirty(:,:)    ! Dirty map
  real, pointer :: c_resid(:,:)    ! Iterated residual
  real, pointer :: c_clean(:,:)    ! Clean Map
  real, pointer :: c_dprim(:,:,:)  ! Primary beam
  real, pointer :: c_dbeam(:,:,:)  ! Dirty beam (per field)
  real, pointer :: c_weight(:,:)
  !
  real, pointer :: l_dirty(:,:)    ! Dirty map
  real, pointer :: l_resid(:,:)    ! Iterated residual
  real, pointer :: l_clean(:,:)    ! Clean Map
  real, pointer :: l_beam(:,:) ! Beam for fit
  real, pointer :: l_dprim(:,:,:)  ! Primary beam
  real, pointer :: l_dbeam(:,:,:)  ! Dirty beam (per field)
  real, pointer :: l_weight(:,:)
  !
  real, allocatable :: w_fft(:) ! TF work area
  complex, allocatable :: w_work(:,:)  ! Work area
  complex, allocatable :: c_work(:,:)  ! Expansion of residual
  real, allocatable :: r_work(:,:) ! Expansion of residual
  type(cct_par), allocatable :: w_comp(:)
  real, allocatable :: w_resid(:,:)
  !
  integer iplane,ibeam
  integer nx,ny,np,mx,my,mp,nc
  integer ier, ix, iy, jx, jy
  real l_max, c_max
  logical do_fft, ok
  character(len=message_length) :: chain
  character(len=7) :: rname = 'COMPACT'
  character(len=2) ans
  integer nker,mker
  parameter (mker=12)
  real smooth
  real, allocatable :: kernel(:,:)
  integer, allocatable :: xcoord(:), ycoord(:)
  integer, allocatable :: labelo(:,:)
  type(cct_par), allocatable :: wcl(:)
  type(cct_par) :: cct_null
  real noise,scale,fhat,long,compact, factor, thre
  real time_begin, time_end
  integer n_extended, kx, ky, kf, n_areas
  integer i, first, last
  logical do_long, more
  integer n_long, n_compact    ! Number of cycles of each type
  integer type_long, type_compact,last_type
  parameter (type_long=1)
  parameter (type_compact=2)
  !
  cct_null%value = 0.0
  cct_null%ix = 0
  cct_null%iy = 0
  !
  error = .false.
  do_fft = .true.
  factor = 0.0
  print *,'Into SUB_ALMA_TER '
  !
  ! Local variables
  nx = l_hclean%gil%dim(1)
  ny = l_hclean%gil%dim(2)
  np = l_hprim%gil%dim(1)
  mx = c_hbeam%gil%dim(1)
  my = c_hbeam%gil%dim(2)
  mp = c_hprim%gil%dim(1)
  nc = nx*ny
  !
  allocate (w_work(nx,ny),stat=ier)
  allocate (r_work(nx,ny),stat=ier)
  allocate (c_work(mx,my),stat=ier)
  allocate (w_fft(2*max(nx,ny)),stat=ier)
  allocate (w_comp(nc),stat=ier)
  !
  ! Global residuals
  allocate (w_resid(nx,ny),stat=ier)
  !
  ! Some global pointers
  l_dprim => l_hprim%r3d
  l_dbeam => l_hbeam%r3d
  l_weight=> l_method%weight(:,:,1)
  c_dprim => c_hprim%r3d
  c_dbeam => c_hbeam%r3d
  c_weight=> c_method%weight(:,:,1)
  !
  ! Relative noise contributions
  long = 1.0/l_hdirty%gil%noise**2
  compact = 1.0/c_hdirty%gil%noise**2
  noise = sqrt(long/compact)   ! Mean noise RATIO
  scale = long+compact
  long = long/scale
  compact = compact/scale
  !
  ! Initialize the kernel
  smooth = c_method%smooth
  smooth = 0.0
  if (smooth.eq.0) then
    nker = 4                   ! *** Must compute the true pixel ratio of ACA / ALMA
    nker = nint (c_hdirty%gil%convert(3,2) / l_hdirty%gil%convert(3,2))
    print *,'Nker ',nker
  elseif  (smooth.lt.4) then
    nker = 8
  else
    nker = mker
  endif
  !
  allocate(kernel(nker,nker),stat=ier)
  call init_kernel(kernel,nker,nker,smooth)
  !
  kx = mx/2
  ky = my/2
  kf = kx*ky
  allocate (labelo(kx,ky),stat=ier)
  allocate (wcl(kf),xcoord(kf),ycoord(kf),stat=ier)
  !
  do_long = c_method%n_major.gt.0
  last_type = type_long
  tcc%type = 1
  !
  ! Loop here if needed
  do iplane = l_method%first, l_method%last
     call gag_cpu (time_begin)
     print *,'Starting loop ',iplane
     l_method%flux = 0.0
     c_method%flux = 0.0
     l_method%n_iter= 0
     c_method%n_iter= 0
     !
     l_method%iplane = iplane
     c_method%iplane = iplane
     call beam_plane(l_method,l_hbeam,l_hdirty)
     ibeam = l_method%ibeam
     !
     ! Local aliases
     l_dirty => l_hdirty%r3d(:,:,iplane)
     l_resid => l_hresid%r3d(:,:,iplane)
     l_clean => l_hclean%r3d(:,:,iplane)
     l_beam  => l_hbeam%r3d(:,:,ibeam)
     !
     c_dirty => c_hdirty%r3d(:,:,iplane)
     c_resid => c_hresid%r3d(:,:,iplane)
     c_clean => c_hclean%r3d(:,:,iplane)
     !
     ! Initialize to Dirty map
     l_resid = l_dirty
     c_resid = c_dirty
     !
     ! Prepare beam parameters
     call get_clean (l_method, l_hbeam, l_beam, error)
     if (error) return
     call get_beam (l_method,l_hbeam,l_hresid,l_hprim,   &
          &        l_tfbeam,w_work,w_fft,fhat,error)
     if (error) return
     !
     call get_beam (c_method,c_hbeam,c_hresid,c_hprim,   &
          &        c_tfbeam,w_work,w_fft,fhat,error)
     if (error) return
     !            PRINT *,'Beam gains ',L_METHOD%BGAIN,C_METHOD%BGAIN
     !            L_METHOD%BGAIN = SQRT(L_METHOD%BGAIN*C_METHOD%BGAIN)
     l_resid = l_resid * l_weight
     c_resid = c_resid * c_weight
     !
     ! Performs decomposition into components:
     ! Only one major cycle per iteration, with a limited number
     ! of components ?
     !
     l_method%ngoal = 1000
     n_long = 0
     n_compact = 0
     !
     ! Locate the maximum of the Compact & Normal images
     l_max = imaxlst (l_method,l_list,l_resid,nx,ny,ix,iy)
     c_max = imaxlst (c_method,c_list,c_resid,mx,my,jx,jy)
     ok = l_max.gt.l_method%ares .or. c_max.gt.c_method%ares
     do while (ok)
        !
        ! Plot for debug
        if (l_method%pcycle) then
           call mrc_clear
           call mrc_plot(c_resid,mx,my,2,'Compact')
           call mrc_plot(l_resid,nx,ny,3,'Long')
        endif
        !
        ! NOISE is the Noise RATIO (mean value over the beams)
        !
        if (l_max.gt.c_max/noise .or. do_long) then
           last_type = type_long  ! Use LONG baselines
        else
           ! May be using Compact baselines only. Check sign however
           l_max = l_resid(ix,iy)
           c_max = c_resid(jx,jy)
           thre = min(0.3,c_method%bgain)
           if (c_max*l_max .gt. 0) then
              ! Same sign, use Compact
              last_type = type_compact
           else
              ! Use higher threshold
              last_type = type_compact
              thre = max(0.7,c_method%bgain)
           endif
        endif
        !
        if (last_type.eq.type_long) then
           l_max = abs(l_max)
           print *,'Using LONG baselines ',l_max,c_max/noise
           if (l_method%qcycle) then
              call sic_wpr('WAIT ? ',ans)
           endif
           !
           ! Find components in LONG baseline image
           call one_cycle90 (l_method,l_hclean,   &   !
                &          l_clean,   &   ! Final CLEAN image
                &          l_dbeam,   &   ! Dirty beams
                &          l_resid,nx,ny,   & ! Residual and size
                &          l_tfbeam, w_work,   &  ! FT of dirty beam + Work area
                &          w_comp, nc,         &    ! Component storage + Size
                &          l_method%beam0(1),l_method%beam0(2),   &   ! Beam center
                &          l_method%patch(1),l_method%patch(2),   &
                &          l_method%bgain,l_method%box,   &
                &          w_fft,   &     ! Work space for FFTs
                &          tcc,   &       ! Component table
                &          l_list, l_method%nlist,   & ! Search list
                &          np,   &        ! Number of fields
                &          l_dprim,   &   ! Primary beams
                &          l_weight,   &  ! Weight
                &          l_max)
           !
           ! Define component type
           tcc(c_method%n_iter+1:l_method%n_iter)%type = 0
           ! Remove from COMPACT baselines
           call remove_incompact(c_method,c_resid,mx,my,   &
                &          c_tfbeam, w_fft, mp,c_dprim,c_weight,   &
                &          tcc,c_method%n_iter+1,l_method%n_iter,nx,ny)
           ! Define number of iterations and type
           tcc(c_method%n_iter+1:l_method%n_iter)%type = 0
           c_method%n_iter = l_method%n_iter
           c_method%flux = l_method%flux
           do_long = .false.
           n_long = n_long + 1
           ! Test SG
           factor = 0
        else
           print *,'Using COMPACT baselines ',l_max,c_max/noise
           if (l_method%qcycle) then
              call sic_wpr('WAIT ? ',ans)
           endif
           !
           ! Select extended area around this maximum
           thre = thre * c_max
           more = .true.
           do while (more)
              wcl = cct_null
              labelo = 0
              call threshold (c_resid,mx,my,   &   ! Initial image and size
                   &            c_method%blc,c_method%trc,   &   ! Image area
                   &            labelo,kx,ky,   &    ! Subset Image of area numbers
                   &            n_areas,   & ! Number of areas
                   &            xcoord,   &  ! Work space for area numbers
                   &            ycoord,kf,   &   ! Area numbers
                   &            thre,0.0,-1.0)
              !
              if ( (l_method%m_iter-l_method%n_iter).lt.   &
                   &            20*nker**2) then
                 c_method%ngoal = 10
              else
                 c_method%ngoal = min (c_method%ngoal,   &
                      &              (l_method%m_iter-l_method%n_iter)/nker**2)
              endif
              print *,'Threshold ',thre,c_method%ngoal
              call load_cct (c_resid,mx,my,   &
                   &            c_method%blc,c_method%trc,   &   ! Image area
                   &            labelo,kx,ky,   &    ! Subset Image of area numbers
                   &            n_extended,wcl,jx,jy,   &
                   &            c_method%gain,thre,c_method%ngoal)
              !
              write(chain,'(A,I6,A,1pg10.3)')   &
                   &  'Selected ',n_extended,' components above ',thre
              call map_message(seve%i,rname,chain)
              if (n_extended*nker**2+l_method%n_iter .le.   &
                   &            l_method%m_iter) then
                 more = .false.
              else
                 print *,'Stopping '
                 ok = .false.
                 more = .false.
                 do_long = .true.
              endif
           enddo
           !
           if (.not.do_long) then
              !
              ! Compute the scale factor
              if (factor.eq.0) then
                 call normal (   &
                      &              w_work,   &    ! Work space for Component TF
                      &              c_tfbeam,   &  ! Beam TF
                      &              mx,my,   & ! image size
                      &              wcl,     &    ! Selected candidate components
                      &              n_extended,   &    ! Selected Number of components
                      &              w_fft,   & ! FFT work space
                      &              factor)    ! Normalisation factor
                 factor = c_method%gain*abs(c_max)/factor
                 print *,'New factor ',factor
              endif
              !
              ! Expand the components on the fine grid.
              first = c_method%n_iter+1
              do i=1,n_extended
                 ix = wcl(i)%ix
                 iy = wcl(i)%iy
                 c_max = wcl(i)%value * factor
                 !
                 ! Define the corresponding component list AND value
                 call expand_kernel(c_method,mx,my,ix,iy,c_max,   &
                      &              tcc,first,last,nx,ny,   &
                      &              kernel, nker)
                 first = last+1
              enddo
              l_method%n_iter = last
              !
              ! Remove List in Compact Baselines
              call remove_incompact(c_method,c_resid,mx,my,   &
                   &            c_tfbeam, w_fft, mp,c_dprim,c_weight,   &
                   &            tcc,c_method%n_iter+1,l_method%n_iter,nx,ny)
              !
              ! Remove List in Long Baselines
              call remove_inlong(l_method,l_resid,nx,ny,   &
                   &            l_tfbeam, w_fft, np,l_dprim,l_weight,   &
                   &            tcc,c_method%n_iter+1,l_method%n_iter)
              !
              ! Define number of components
              c_method%n_iter = l_method%n_iter
              l_method%flux = c_method%flux
              write(chain,'(A,1PG11.4,A,I6,A)')  'Cleaned ',c_method%flux,  &
                     &  ' Jy in ',c_method%n_iter,' components'
              call map_message(seve%i,rname,chain)
              n_compact = n_compact + 1
           endif
        endif
        ! Stop if done
        l_max = imaxlst (l_method,l_list,l_resid,nx,ny,ix,iy)
        c_max = imaxlst (c_method,c_list,c_resid,mx,my,jx,jy)
        ok = ok .and. (l_max.gt.l_method%ares   &
             &        .or. c_max.gt.c_method%ares)
        if (l_method%n_iter.ge.l_method%m_iter) ok = .false.
        if (sic_ctrlc()) ok = .false.
        ! Continue with ALMA only if not enough components yet
        if (l_method%n_iter .lt. c_method%n_major)   &
             &        do_long = .true.
     enddo
     !
     ! Add clean components and residuals to produce clean map
     ! Note that the Kernel is still scaled in the same way as before
     if (l_method%n_iter.ne.0) then
        call alma_make (l_method, l_hclean, tcc)
     else
        l_clean = 0
     endif
     !
     ! Which residual should be added ?...
     ! We don't want to add noise, but to combine it properly...
     ! We may need to go to the full combined gridding business here...
     l_clean = l_clean + l_resid * l_weight * long
     c_clean = c_resid * c_weight * compact
     call expand (nx,ny,r_work,w_work,mx,my,c_clean,c_work,w_fft)
     where (l_weight.lt.l_method%trunca)
        r_work = 0
     end where
     l_clean = l_clean + r_work
     !
     call gag_cpu (time_end)
     write(chain,*) n_long,' Long baselines cycles'
     call map_message(seve%i,'ALMA',chain)
     write(chain,*) n_compact,' Compact array cycles'
     call map_message(seve%i,'ALMA',chain)
     write(chain,*) time_end-time_begin,' CPU'
     call map_message(seve%i,'ALMA',chain)
  enddo
  !
  ! Cleanup
  deallocate (w_work,r_work,c_work)
  deallocate (w_fft,w_comp,w_resid)
  deallocate (kernel)
  deallocate (labelo,wcl,xcoord,ycoord)
end subroutine sub_alma_ter
!
subroutine load_cct (image,nx,ny,blc,trc,label,mx,my,   &
     &    nv,wcl,ix,iy,gain,tmax,ngoal)
  use clean_def
  ! @ private
  integer, intent(in) :: nx,ny,mx,my,blc(2),trc(2)
  integer, intent(out) :: nv
  integer, intent(in) :: ix,iy
  real(4), intent(in) :: image(nx,ny)
  integer, intent(inout) :: label(mx,my)
  type(cct_par), intent(inout) :: wcl(mx*my)
  integer, intent(in) :: ngoal
  real, intent(in) :: gain
  real, intent(out) :: tmax
  !
  integer i,j,ii,jj,label0, jx,jy, nc
  logical ok
  real rmax
  !
  nv = 0
  nc = 0
  jx = ix-blc(1)+1
  jy = iy-blc(2)+1
  ok = .true.
  do while (ok)
     !
     label0 = label(jx,jy)
     !
     ! First pass to find the max of the omitted values
     rmax = 0.0
     do j=1,my
        do i=1,mx
           if (label(i,j).ne.label0 .and. label(i,j).ne.0) then
              ii = blc(1)+i-1
              jj = blc(2)+j-1
              if (abs(image(ii,jj)).gt.rmax) then
                 rmax = abs(image(ii,jj))
                 jx = i
                 jy = j
              endif
           endif
        enddo
     enddo
     !
     ! Not good ...
     !         RMAX = (1.0-GAIN) * RMAX
     !
     do j=1,my
        do i=1,mx
           if (label(i,j).eq.label0) then
              ii = blc(1)+i-1
              jj = blc(2)+j-1
              if (abs(image(ii,jj)).gt.rmax) then
                 nv = nv+1
                 wcl(nv)%influx = image(ii,jj)
                 wcl(nv)%ix = ii
                 wcl(nv)%iy = jj
                 label (i,j) = 0
              endif
           endif
        enddo
     enddo
     if (rmax.eq.0) return
     tmax = rmax
     nc = nc+1
     !
     ! Selectionner au moins NGOAL, en au plus NC=10 ilots
     if (nv.lt.ngoal .and. nc.lt.10) then
        ok = .true.
     else
        ok = .false.
     endif
  enddo
end subroutine load_cct
