!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module clean_support_tool
  use gbl_message
  use gkernel_types, only: polygon_t,varname_length
  !------------------------------------------------------------------------
  ! CLEAN\SUPPORT polygon, mapped on SUPPORT%
  !------------------------------------------------------------------------
  !
  public :: mask_clean,check_mask,get_maskplane,lmask_to_list
  !
  public :: supportpol,support_type
  public :: support_mask,support_poly,support_none
  public :: supportvar
  public :: clean_support
  private
  !
  integer, parameter :: support_mask = 1 
  integer, parameter :: support_poly = -1
  integer, parameter :: support_none = 0
  character(len=varname_length), parameter :: supportvar='SUPPORT'
  !
  integer, save :: support_type  
  type(polygon_t), save :: supportpol
  !
  type support_user_t
   contains
     procedure, public :: init   => clean_support_user_init
     procedure, public :: sicdef => clean_support_user_sicdef
  end type support_user_t
  type (support_user_t) :: clean_support
  !
contains
  !
  subroutine clean_support_user_init(user,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(support_user_t), intent(out)   :: user
    logical,               intent(inout) :: error
    !
    ! Placeholder => Do nothing for the moment
  end subroutine clean_support_user_init
  !
  subroutine clean_support_user_sicdef(user,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(support_user_t), intent(inout) :: user
    logical,               intent(inout) :: error
    !
    call sic_defstructure(supportvar,.true.,error)
    if (error) return
  end subroutine clean_support_user_sicdef
  !
  !***JP: Unclear whether the mask-related routines should be in this module!
  !
  subroutine mask_clean(head,mask,data,raw,smo,length,margin,error) 
    use phys_const
    use image_def
    use gkernel_interfaces
    use mapping_gaussian_tool
    !----------------------------------------------------------------
    ! Build a Mask from a Threshold and Smoothing 
    !----------------------------------------------------------------
    type(gildas), intent(inout) :: head
    real, target, intent(out)   :: mask(head%gil%dim(1),head%gil%dim(2),head%gil%dim(3))
    real,         intent(in)    :: data (head%gil%dim(1),head%gil%dim(2),head%gil%dim(3))
    real,         intent(in)    :: raw
    real,         intent(in)    :: smo
    real,         intent(in)    :: length
    real,         intent(in)    :: margin
    logical,      intent(inout) :: error
    !
    integer :: nx,ny,nc,ix,iy,ic,jx,jy,ndim,dim(2),ier
    real :: xinc, yinc,fact
    real, allocatable :: wfft(:)
    real, pointer :: tmp(:,:)
    complex, allocatable :: ft(:,:)
    character(len=message_length) :: chain
    character(len=*), parameter :: rname='SUPPORT'
    !
    nx = head%gil%dim(1)
    ny = head%gil%dim(2)
    nc = head%gil%dim(3)
    allocate (wfft(2*max(nx,ny)),ft(nx,ny),stat=ier)
    if (ier.ne.0) then
       call map_message(seve%e,rname,'Memory allocation error in MASK_CLEAN')
       error = .true.
       return
    endif
    xinc = head%gil%convert(3,1)
    yinc = head%gil%convert(3,2)
    !
    dim(1) = nx
    dim(2) = ny
    ndim = 2
    jy = margin*ny
    jx = margin*nx
    !
    write(chain,'(A,1PG10.2,1PG10.2,A,0PF8.2,A,F6.2)') 'Threshold',raw,smo, &
         & ',  Smoothing ',length*180.*3600./pi,'", guard band ',margin
    call map_message(seve%i,rname,chain)
    !
    do ic=1,nc
       tmp => mask(:,:,ic)
       !
       ! Guard band of 1/8th of the image size on each edge to
       ! avoid aliased sidelobes
       tmp = 0.0
       if (head%gil%eval.ge.0.0) then
          do iy=jy+1,ny-jy
             do ix=jx+1,nx-jx
                if (abs(data(ix,iy,ic)-head%gil%bval).gt.head%gil%eval) then
                   if (data(ix,iy,ic).ge.raw) tmp(ix,iy) = data(ix,iy,ic)
                endif
             enddo
          enddo
       else
          do iy=jy+1,ny-jy
             do ix=jx+1,nx-jx
                if (data(ix,iy,ic).ge.raw) tmp(ix,iy) = data(ix,iy,ic)
             enddo
          enddo
       endif
       ft(:,:) = cmplx(tmp,0.0)
       !
       call fourt(ft,dim,ndim,-1,0,wfft)
       !
       ! Correct for Beam Area for flux density normalisation
       fact = length**2*pi/(4.0*log(2.0))/abs(xinc*yinc)/(nx*ny)
       call mulgau(ft,nx,ny,&
            length,length,0.0,&
            fact,xinc,yinc)
       call fourt(ft,dim,ndim,1,1,wfft)
       !
       ! Extract Real part
       tmp(:,:) = real(ft)
       where (tmp.lt.smo) tmp = 0.0
    enddo
    deallocate (wfft,ft)
  end subroutine mask_clean  
  !
  subroutine no_check_mask(method,head)
    use image_def
    use clean_types
    !--------------------------------------------------------------
    ! Do not check that the search mask is defined
    !--------------------------------------------------------------
    type(gildas),    intent(in)    :: head
    type(clean_par), intent(inout) :: method
    !
    print *,'Called check_mask'
  end subroutine no_check_mask
  !
  subroutine check_mask(amethod,head)
    use image_def
    use clean_types
    use clean_buffers
    !--------------------------------------------------------------
    ! Check that the search mask is defined
    !--------------------------------------------------------------
    type(gildas),    intent(in)    :: head
    type(clean_par), intent(inout) :: amethod
    !
    integer, save :: last_box(4) !***JP: Why save here?
    integer :: nx,ny
    character(len=10) :: rname='CHECK_MASK'
    !
    nx = head%gil%dim(1)
    ny = head%gil%dim(2)
    if (amethod%do_mask) then
       if (support_type.eq.support_mask) then
          if (mask%head%gil%dim(1).ne.nx .or. mask%head%gil%dim(2).ne.ny) then
             call map_message(seve%w,rname,'Mask size differ')
          endif
          !
          ! Setup the Logical mask from the Real mask and its bounding box
          call get_lmask (mask%head,mask%data(:,:,1),head,d_mask,amethod%box)
          call lmask_to_list(d_mask,nx*ny,d_list,amethod%nlist)
          amethod%imask = 1
       else
          ! Compute the logical mask from the bounding polygon
          call gr8_glmsk(supportpol,d_mask,nx,ny,&
               head%gil%convert(1,1),head%gil%convert(1,2),amethod%box)
          call lmask_to_list(d_mask,nx*ny,d_list,amethod%nlist)
          amethod%imask = -1
       endif
       amethod%do_mask = .false.
       last_box = amethod%box
    else
       amethod%box = last_box
    endif
  end subroutine check_mask
  !
  subroutine get_maskplane(amethod,hmask,hdirty,mask,list)
    use image_def
    use clean_types
    !----------------------------------------------------------------
    ! Define beam plane and check if fit is required
    !----------------------------------------------------------------
    type (clean_par), intent(inout) :: amethod
    type (gildas),    intent(in)    :: hmask
    type (gildas),    intent(in)    :: hdirty ! Used to figure out which plane
    logical,          intent(inout) :: mask(:,:)
    integer,          intent(inout) :: list(:)
    !
    integer :: iplane, nxy
    real(8) :: i_freq
    !
    ! Check if beam parameters must be recomputed
    if (support_type.ne.support_mask) return
    !
    if (hmask%gil%dim(3).le.1) then
       !!print *,'Only one mask Plane '
       amethod%imask = 1
       return ! 
    else 
       i_freq = (amethod%iplane-hdirty%gil%ref(3))*hdirty%gil%fres + hdirty%gil%freq
       iplane = nint((i_freq-hmask%gil%freq)/hmask%gil%fres + hmask%gil%ref(3))
       iplane = min(max(1,iplane),hmask%gil%dim(3)) ! Just  in case
       !!print *,'IPLANE ',iplane,' IMASK ',method%imask
       !
       ! Should also work in OMP mode...
       if (amethod%imask.ne.iplane) then
          !
          ! Optimize: only re-define if needed...
          nxy = hdirty%gil%dim(1)*hdirty%gil%dim(2)
          call get_lmask (hmask,hmask%r3d(:,:,iplane),hdirty,mask,amethod%box)
          call lmask_to_list(mask,nxy,list,amethod%nlist)
          amethod%imask = iplane
       endif
    endif
  end subroutine get_maskplane
  !
  subroutine get_rlist(rmsk,nx,ny,box,list,nl)
    !---------------------------------------------------------------------
    ! Return a LOGICAL mask from the a (0 - non zero) mask, and also
    ! compute its boundaries
    !---------------------------------------------------------------------
    integer,      intent(in)  :: nx          ! X size
    integer,      intent(in)  :: ny          ! Y size
    real(kind=4), intent(in)  :: rmsk(nx,ny) ! Real mask
    integer,      intent(out) :: box(4)      ! Mask Boundary
    integer,      intent(out) :: list(nx*ny) ! List of pixels in mask
    integer,      intent(out) :: nl
    !
    integer :: i,j,k,l
    !
    box(1) = nx
    box(2) = ny
    box(3) = 1
    box(4) = 1
    !
    l = 0
    k = 0
    do j=1,ny
       do i=1,nx
          k = k+1
          if (rmsk(i,j).ne.0) then
             box(1) = min(i,box(1))
             box(2) = min(j,box(2))
             box(3) = max(i,box(3))
             box(4) = max(j,box(4))
             l = l+1
             list(l) = k
          endif
       enddo
    enddo
    nl = l
  end subroutine get_rlist
  !
  subroutine gr4_slmsk (rmsk,lmsk,nx,ny,box)
    !---------------------------------------------------------------------
    ! Return a LOGICAL mask from the a (0 - non zero) mask, and also
    ! compute its boundaries
    !---------------------------------------------------------------------
    integer,      intent(in)  :: nx          ! X size
    integer,      intent(in)  :: ny          ! Y size
    real(kind=4), intent(in)  :: rmsk(nx,ny) ! Real mask
    logical,      intent(out) :: lmsk(nx,ny) ! Logical mask
    integer,      intent(out) :: box(4)      ! Mask boundary (xblc,yblc,xtrc,ytrc)
    !
    integer :: i,j
    !
    box(1) = nx
    box(2) = ny
    box(3) = 1
    box(4) = 1
    !
    do j=1,ny
       do i=1,nx
          if (rmsk(i,j).ne.0) then
             lmsk(i,j) = .true.
             box(1) = min(i,box(1))
             box(2) = min(j,box(2))
             box(3) = max(i,box(3))
             box(4) = max(j,box(4))
          else
             lmsk(i,j) = .false.
          endif
       enddo
    enddo
  end subroutine gr4_slmsk
  !
  subroutine get_lmask(hmask,rmask,hmap,lmask,box)
    use image_def
    !---------------------------------------------------------------------
    ! Return a LOGICAL mask from the a (0 - non zero) mask, and also compute
    ! its boundaries
    !---------------------------------------------------------------------
    type(gildas), intent(in)  :: hmask      ! Mask header
    type(gildas), intent(in)  :: hmap       ! Map header  
    real(kind=4), intent(in)  :: rmask(:,:) ! Real mask
    logical,      intent(out) :: lmask(:,:) ! Logical mask
    integer,      intent(out) :: box(4)     ! Mask boundary (xblc,yblc,xtrc,ytrc)
    !
    integer :: i,j,ier
    integer :: nx,ny
    integer, allocatable :: im(:),jm(:) ! Pixels in mask matching image pixels
    real(kind=8) :: r
    !
    nx = hmap%gil%dim(1)
    ny = hmap%gil%dim(2)
    !
    allocate(im(nx),jm(ny),stat=ier)
    !
    do i=1,nx
       r = (i-hmap%gil%ref(1))*hmap%gil%inc(1) + hmap%gil%val(1)
       im(i) = (r-hmask%gil%val(1))/hmask%gil%inc(1) + hmask%gil%ref(1)
       im(i) = max(1,im(i))
       im(i) = min(hmask%gil%dim(1),im(i))
    enddo
    !
    do i=1,ny
       r = (i-hmap%gil%ref(2))*hmap%gil%inc(2) + hmap%gil%val(2)
       jm(i) = (r-hmask%gil%val(2))/hmask%gil%inc(2) + hmask%gil%ref(2)
       jm(i) = max(1,jm(i))
       jm(i) = min(hmask%gil%dim(2),jm(i))
    enddo
    !
    box(1) = nx
    box(2) = ny
    box(3) = 1
    box(4) = 1
    !
    do j=1,ny
       do i=1,nx
          if (rmask(im(i),jm(j)).ne.0) then
             lmask(i,j) = .true.
             box(1) = min(i,box(1))
             box(2) = min(j,box(2))
             box(3) = max(i,box(3))
             box(4) = max(j,box(4))
          else
             lmask(i,j) = .false.
          endif
       enddo
    enddo
    deallocate(im,jm)
  end subroutine get_lmask
  !
  subroutine lmask_to_list(lmask,m,list,n)
    !---------------------------------------------------
    ! Get list of positions from a Logical mask.
    !---------------------------------------------------
    integer, intent(in)  :: m        ! Number of entries
    logical, intent(in)  :: lmask(m) ! Mask values
    integer, intent(out) :: n        ! Number of TRUE values
    integer, intent(out) :: list(m)  ! Position of entries 
    ! 
    integer :: i,j
    !
    j = 0
    do i=1,m
       if (lmask(i)) then
          j = j+1
          list(j) = i
       endif
    enddo
    n = j
    do i=n+1,m
       list(i) = 0
    enddo
  end subroutine lmask_to_list
  !
  !***JP: The following ones are unused. Keep them for reference.
  !
!!$  !
!!$  subroutine rmask_to_list(rmask,m,list,n)
!!$    !---------------------------------------------------
!!$    ! Get list of positions from a Real mask.
!!$    !---------------------------------------------------
!!$    integer, intent(in)  :: m        ! Number of entries
!!$    real,    intent(in)  :: rmask(m) ! Mask values
!!$    integer, intent(out) :: n        ! Number of TRUE values
!!$    integer, intent(out) :: list(m)  ! Position of entries 
!!$    ! 
!!$    integer :: i,j
!!$    !
!!$    j = 0
!!$    do i=1,m
!!$       if (rmask(i).gt.0) then
!!$          j = j+1
!!$          list(j) = i
!!$       endif
!!$    enddo
!!$    n = j
!!$    do i=n+1,m
!!$       list(i) = 0
!!$    enddo
!!$  end subroutine rmask_to_list
!!$  !
!!$  subroutine get_listsize (mask,m,n)
!!$    !---------------------------------------------------
!!$    ! Count number of TRUE values
!!$    !---------------------------------------------------
!!$    integer, intent(in)  :: m       ! Number of entries
!!$    integer, intent(out) :: n       ! Number of TRUE values
!!$    logical, intent(in)  :: mask(m) ! Mask values
!!$    !
!!$    integer :: i
!!$    !
!!$    n = 0
!!$    do i=1,m
!!$       if (mask(i)) n = n+1
!!$    enddo
!!$  end subroutine get_listsize
!!$  !
!!$  subroutine get_listindex(mask,m,list,n)
!!$    !---------------------------------------------------
!!$    ! Get list of positions in mask.
!!$    !---------------------------------------------------
!!$    integer, intent(in)  :: m       ! Number of entries
!!$    integer, intent(in)  :: n       ! Number of TRUE values
!!$    logical, intent(in)  :: mask(m) ! Mask values
!!$    integer, intent(out) :: list(n) ! Position of entries 
!!$    ! 
!!$    integer :: i,j
!!$    !
!!$    j = 0
!!$    do i=1,m
!!$       if (mask(i)) then
!!$          j = j+1
!!$          list(j) = i
!!$       endif
!!$    enddo
!!$    do i=j+1,n
!!$       list(i) = 0
!!$    enddo
!!$  end subroutine get_listindex
end module clean_support_tool
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
