subroutine mask_comm(line,error)
  use gildas_def
  use gbl_message
  use gkernel_types
  use clean_arrays
  use gkernel_interfaces
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !
  !   IMAGER
  ! Support routine for command
  !   ADVANCED\MASK Arguments... 
  !
  ! Several modes
  !   MASK  ADD Figure Description
  !                 Add the corresponding figure to mask
  !   MASK  APPLY Variable  
  !                 Apply the current mask to 3-D Variable
  !   MASK  INIT [2D|3D]
  !                 Initialize a mask
  !   MASK  OVERLAY
  !                 Overlay the mask on the current Image
  !   MASK  READ File
  !                 Read a Mask from disk (is that a .msk or a .pol ?) 
  !                 (redundant with READ MASK )
  !   MASK  REGIONS Nregions
  !                 Only keep the most important domains
  !   MASK  REMOVE  Fig_Description
  !                 Removed the figure from mask
  !   MASK  USE   
  !                 Activate the current mask as a Support
  !                 (redundant with SUPPORT /MASK)
  !   MASK  SHOW    
  !                 as SHOW MASK
  !   MASK  THRESHOLD Value Unit [SMOOTH Smooth Length] [GUARG Guard]
  !                 [REGIONS Nregions]
  !                 automatic Mask builder by Thresholding
  !   MASK  WRITE File
  !                 Write a mask to disk 
  !                 (almost redundant with WRITE MASK ? )
  !
  !   MASK          Launch interactive mask definition
  !          (would be better on currently displayed image, rather
  !           than only the CLEAN data cube. Rank could depend
  !           on how many channels are displayed)
  !
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: line   ! Input command line
  logical,          intent(out) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='MASK'
  !
  type(gildas) :: head
  integer, parameter :: mvoc=13
  character(len=12) :: vocab(mvoc), key, lkey
  data vocab /'ADD','APPLY','CHECK','INITIALIZE','INTERACTIVE','OVERLAY', &
    & 'READ','REGIONS', 'REMOVE', 'SHOW','THRESHOLD','USE','WRITE'/
  integer, parameter :: mfig=4
  character(len=12) :: figure(mfig), kfig
  data figure /'CIRCLE','ELLIPSE','POLYGON','RECTANGLE'/
  !
  character(len=24) :: argum, chain
  character(len=filename_length) :: name
  character(len=commandline_length) :: aline
  integer :: ikey,is,nc,na,narg
  logical :: do_insert
  real :: r4
  integer :: nchans(2)
  !
  error = .false.
  !
  do_insert = sic_lire().eq.0
  !
  ! If no argument, activate the default interactive mode
  argum = 'INTERACTIVE'
  !
  call sic_ke(line,0,1,argum,nc,.false.,error)
  if (error) return  !
  call sic_ambigs (rname,argum,key,ikey,vocab,mvoc,error)
  if (error) return
  !
  if (key.eq.'CHECK') then
    call mask_check(.true.,error)
    return
  endif
  ! These create the MASK
  select case(key)
  case ('INITIALIZE')
    if (sic_narg(0).eq.1) then
      argum = '3D'
    else
      call sic_ke(line,0,2,argum,nc,.false.,error)
    endif
    call mask_init(argum,error)
    if (error) return
    call exec_program('@ p_mask init NO')  ! Support is void at this stage
  case ('READ') 
    call sic_ch(line,0,2,name,nc,.true.,error)
    if (error) return
    !
    call gildas_null(head)
    call sic_parse_file(name,' ','.msk',head%file)
    call gdf_read_header (head,error)
    if (error) return
    !
    nchans = 0
    call map_read (head,'MASK',nchans,.false.,error)  
    call gdf_close_image (head,error)
    call exec_program('@ p_mask init YES')  ! Support is filled 
  case ('THRESHOLD')
    call mask_threshold(line,error)
    if (error) return  
    call exec_program('@ p_mask init YES')  ! Support is filled 
  case ('REGIONS')
    call mask_regions(line,error)
    if (error) return  
    call exec_program('@ p_mask init YES')  ! Support is filled 
  !
  ! These need the MASK and the Clean image
  case ('INTERACTIVE') 
    call mask_check(.true.,error)
    if (error) return
    !
    argum = '1'
    call sic_ke(line,0,2,argum,nc,.false.,error)
    call exec_program('@ p_mask interactive '//argum)
  case ('ADD','REMOVE')
    call mask_check(.true.,error)
    if (error) return
    call sic_ke(line,0,2,argum,nc,.false.,error)
    if (error) return  !
    call sic_ambigs (rname,argum,kfig,ikey,figure,mfig,error)
    if (error) return
    call sic_lower(kfig)
    lkey = key
    call sic_lower(lkey)
    narg = sic_narg(0)
    if (narg.gt.2) then
      aline = '@ p_mask '//trim(lkey)//' '//kfig
      na = len_trim(aline)+2
      if (kfig.eq."polygon") then
        if (narg.gt.3) then
          call map_message(seve%e,rname,'Too many arguments')
          error = .true.
          return
        endif
        call sic_ch(line,0,3,chain,nc,.true.,error)
        aline(na:) = chain
        na = na + len_trim(chain)
      else
        ! Get the numerical values of all arguments
        do is=3,narg
          call sic_r4(line,0,is,r4,.true.,error)
          if (error) return
          write(chain,*) r4
          aline(na:) = chain
          na = na + len_trim(chain)
        enddo
      endif
      call exec_program(aline)
    else
      call exec_program('@ p_mask '//trim(lkey)//' '//kfig)
    endif
  case ('APPLY') 
    call mask_check(.true.,error)
    if (error) return
    call mask_apply(line,error)
    do_insert = .false.
  case ('OVERLAY') 
    call mask_check(.true.,error)
    if (error) return
    call exec_program('@ p_mask over')
  !
  ! Only MASK is needed below
  case ('USE')
    call mask_check(.false.,error)
    if (error) return
    call exec_program('SUPPORT /MASK')
  case ('SHOW')
    call mask_check(.false.,error)
    if (error) return
    call exec_program('SHOW MASK')
  case ('WRITE')
    call mask_check(.false.,error)
    if (error) return
    !
    is = sic_start(0,2) 
    call exec_program('WRITE MASK '//line(is:))
  case default
    call map_message(seve%e,rname,trim(key)//' not yet supported')
    error = .true.
    return
  end select  
  if (do_insert) call sic_insert_log(line)
end subroutine mask_comm
!
subroutine mask_apply(line,error)
  use gildas_def
  use gbl_message
  use gkernel_types
  use clean_arrays
  use gkernel_interfaces
  use imager_interfaces, only : map_message
  use iso_c_binding
  !---------------------------------------------------------------------
  ! @ private
  !   IMAGER
  ! Support routine for command
  !   ADVANCED\MASK APPLY Variable
  !---------------------------------------------------------------------  
  character(len=*), intent(in)  :: line   ! Input command line
  logical,          intent(out) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='MASK'
  !
  type(sic_descriptor_t) :: desc
  integer(kind=4) :: nc
  character(len=6) :: argum
  logical :: equal, found
  type(c_ptr) :: cptr
  real(4), pointer :: r3ptr(:,:,:)
  !
  if (hmask%loca%size.eq.0) then
    call map_message(seve%e,rname,'No mask defined')
    error = .true.
    return
  endif
  error = .false.
  !
  call sic_ke(line,0,2,argum,nc,.false.,error)
  if (error) return
  !
  if (argum.eq.'MASK') then
    call map_message(seve%e,rname,'Cannot MASK the Mask...')
    error = .true.
    return
  else if (argum.eq.'CCT') then
    call map_message(seve%w,rname,'Applying MASK to CCT not fully tested...')
    call cct_mask_comm(line,error)
    return  
  endif
  !
  ! Any SIC 2-D+ variable with matching coordinate is acceptable
  ! But "get_gildas" mechanism is not acceptable, since the Header
  ! must be modified for the Blanking.
  !
  ! Look at the SIC variable
  call sic_descriptor(argum,desc,found)  
  if (.not.found) then
    call map_message(seve%e,rname,'No such SIC variable '//argum)
    error = .true.
    return
  endif
  if (.not.associated(desc%head)) then
    ! Else, no match anyway
    call map_message(seve%w,rname,  &
      'Variable '//trim(argum)//' does not provide a header')
      error = .true.
      return
  endif
  !
  ! Check that desc%head and HMASK match in 2-D and that Frequency axis
  ! can be interpolated properly
  call gdf_compare_2d(desc%head,hmask,equal)
  if (.not.equal) then
    call map_message(seve%e,rname,'MASK and '//trim(argum)//' do not match')
    error = .true.
    return
  endif
  !
  hmask%r3d => dmask
  call adtoad(desc%addr,cptr,1)
  call c_f_pointer(cptr,r3ptr,desc%dims(1:3))
  call sub_mask_apply(desc%head,hmask,r3ptr,error)
  desc%head%gil%blan_words = 2
  desc%head%gil%eval = max(desc%head%gil%eval,0.0)
end subroutine mask_apply
  !
subroutine sub_mask_apply(hin,hmask,din,error)
  use image_def
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !
  !   Apply a mask
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: hin
  type(gildas), intent(in) :: hmask
  real, intent(inout) :: din(hin%gil%dim(1),hin%gil%dim(2),hin%gil%dim(3))
  logical :: error
  !
  character(len=*), parameter :: rname='MASK'
  integer :: iplane, ipm
  real(8) :: i_freq
  real :: blank
  !
  blank = hin%gil%bval
  !
  !!Print *,'Mask rank ',hmask%gil%ndim,hmask%gil%dim(1:3)
  if (hmask%gil%dim(3).le.1) then
    !
    ! Apply Mask to all planes
    do iplane=1,hin%gil%dim(3)
      !!PRINT *,'DOING ',iplane,hin%gil%dim(3),' Blank ',blank
      where (hmask%r3d(:,:,1).eq.0) din(:,:,iplane) = blank
    enddo
  else
    if (hin%gil%faxi.ne.3) then
      call map_message(seve%e,rname,'3rd axis is not Frequency | Velocity')
      error = .true.
      return
    endif
    !
    ! Find matching planes
    do iplane=1,hin%gil%dim(3)
      ! This may be the better way of doing it:
      i_freq = (iplane-hin%gil%ref(3))*hin%gil%fres + hin%gil%freq
      ! i_freq = (ibeam-hbeam%gil%ref(4))*hbeam%gil%fres + hbeam%gil%freq
      ipm = nint((i_freq-hmask%gil%freq)/hmask%gil%fres + hmask%gil%ref(3))
      ipm = min(max(1,ipm),hmask%gil%dim(3)) ! Just  in case
      where (hmask%r3d(:,:,ipm).eq.0) din(:,:,iplane) = blank
    enddo
  endif
end subroutine sub_mask_apply
!
subroutine gdf_compare_2d(hone,htwo,equal)
  use image_def
  !---------------------------------------------------------------------
  ! @ private
  !   Check 2D consistency of data cubes
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: hone
  type(gildas), intent(in) :: htwo
  logical, intent(out) :: equal
  !
  real(8) :: tolerance=0.001    ! Pixels...
  real(8) :: x0, y0
  integer :: i
  !
  ! Compare first 2 axes
  equal = .true.
  do i=1,2
    if (hone%gil%dim(i).ne.htwo%gil%dim(i)) then
      equal = .false.
      return
    else
      x0 = (0-hone%gil%ref(i))*hone%gil%inc(i) + hone%gil%val(i)
      y0 = (0-htwo%gil%ref(i))*htwo%gil%inc(i) + htwo%gil%val(i)
      if ( abs(x0-y0).gt.tolerance*abs(hone%gil%inc(i)) ) then
        equal = .false.
        return
      endif
    endif
  enddo
end subroutine gdf_compare_2d  
!
subroutine mask_threshold(line,error)
  use gkernel_interfaces
  use imager_interfaces, only : map_message, sub_mask_threshold
  use clean_arrays
  use clean_default
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !   IMAGER
  ! Support for command
  !   ADVANCED\MASK  THRESHOLD Value Unit [SMOOTH Smooth Length] 
  !                  [GUARG Guard] [REGIONS Nregions]
  !                 automatic Mask builder by Thresholding
  !
  !  Value    Thresholding (in Unit) of the Clean image
  !  Smooth   Thresholding (in Unit) after smoothing
  !  Length   Smoothing length (in arcsec): default is Clean beam major axis
  !  Guard    Guard band ignored at edges
  !  Nregions Number of separate areas kept in mask.
  !
  ! Select CLEAN or SKY depending on last available
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  if (last_shown.eq.'CLEAN') then
    if (.not.associated(hclean%r3d)) hclean%r3d => dclean
    call sub_mask_threshold(hclean,last_shown,line,error)
  else if (last_shown.eq.'SKY') then
    if (.not.associated(hsky%r3d)) hsky%r3d => dsky
    call sub_mask_threshold(hsky,last_shown,line,error)
  else if (hsky%loca%size.ne.0) then
    if (.not.associated(hsky%r3d)) hsky%r3d => dsky
    call sub_mask_threshold(hsky,'SKY',line,error)
  else if (hclean%loca%size.ne.0) then
    if (.not.associated(hclean%r3d)) hclean%r3d => dclean
    call sub_mask_threshold(hclean,'CLEAN',line,error)
  else
    call map_message(seve%e,'MASK','No CLEAN or SKY available')
    error = .true.
  endif
end subroutine mask_threshold
!
subroutine mask_regions(line,error)
  use gkernel_interfaces
  use imager_interfaces, only : map_message, mask_prune
  use clean_arrays
  use clean_default
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !   IMAGER
  ! Support for command
  !   ADVANCED\MASK  REGIONS Nregions
  !
  ! Keep only the requested number of Regions
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  integer :: nregions
  !
  if (hmask%loca%size.eq.0) then
    call map_message(seve%e,'MASK','No mask defined')
    error = .true.
    return
  endif
  !
  call sic_i4(line,0,2,nregions,.false.,error)
  if (nregions.eq.0) return
  !
  call mask_prune(hmask,dmask,nregions,error)
end subroutine mask_regions
!
subroutine sub_mask_threshold(head,name,line,error)
  use gkernel_interfaces
  use imager_interfaces, only : map_message, mask_clean, mask_prune
  use clean_default
  use clean_arrays
  use clean_support
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !   IMAGER
  ! Support for command
  !   ADVANCED\MASK  THRESHOLD Value Unit [SMOOTH Smooth Length] 
  !                  [GUARG Guard] [REGIONS Nregions]
  !                 automatic Mask builder by Thresholding
  !
  !  Value    Thresholding (in Unit) of the Clean image
  !  Smooth   Thresholding (in Unit) after smoothing
  !  Length   Smoothing length (in arcsec): default is Clean beam major axis
  !  Guard    Guard band ignored at edges
  !  Nregions Number of separate areas kept in mask.
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: head      ! Header of data used for threshold
  character(len=*), intent(in) :: name  ! 
  character(len=*), intent(in) :: line  ! Command line
  logical, intent(inout) :: error       ! Error code
  !
  integer, parameter :: o_thre=0 ! In command line, not in option
  integer, parameter :: a_offs=1 ! But shifted by 1 argument
  integer, parameter :: code_pos=1
  integer, parameter :: code_neg=-1
  integer, parameter :: code_all=0
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  character(len=*), parameter :: rname='MASK'  
  character(len=12) :: cunit
  integer, parameter :: mvoc=3
  character(len=8) :: vocab(mvoc), string, key
  data vocab /'SMOOTH','GUARD','REGIONS'/
  !
  integer :: icode, ns
  character(len=64) :: chain
  real :: raw,smo,length,noise,margin,jyperk,lwave,unit
  integer :: ier, nregions, ikey, iarg, narg
  logical :: debug
  !
  narg = sic_narg(o_thre)
  if (narg.lt.3) then
    call map_message(seve%e,rname,'Invalid syntax, see HELP MASK THRESHOLD')
    error = .true.
    return
  endif
  !
  if (head%loca%size.eq.0) then
    call map_message(seve%e,rname,'No '//trim(name)//' image')
    error = .true.
    return
  endif
  raw = 5.0
  smo = 3.0
  length = 0
  margin = 0.18
  nregions = 0
  iarg = a_offs+1
  !
  ! First argument is the Threshold, coded in a strange way
  call sic_ch(line,o_thre,iarg,string,ier,.false.,error)
  if (string(1:1).eq.'+') then
    icode = code_pos
  else if (string(1:1).eq.'-') then
    icode = code_neg
  else
    icode = code_all
  endif
  call sic_r4(line,o_thre,iarg,raw,.false.,error)
  if (error) return
  iarg = iarg+1
  !
  ! Second argument is the Unit
  unit = 1.0
  call sic_ke(Line,o_thre,iarg,string,ier,.false.,error)
  select case (string)
  case ('%')
    raw = raw*head%gil%rmax*0.01
  case ('NOISE','SIGMA')
    noise = max(hdirty%gil%noise,head%gil%noise,head%gil%rms)
    !!noise = max(head%gil%noise,head%gil%rms)
    !!Print *,'Noise ',noise
    if (noise.le.0) then
      call map_message(seve%e,rname,'No noise estimate, use STATISTIC before')
      error = .true.
      return
    endif
    unit = noise
  case default
    if (head%gil%majo.ne.0) then
      lwave = 2.99792458e8/head%gil%freq*1e-6
      jyperk = 2.0*1.38e3*pi*head%gil%majo*head%gil%mino/(4.*log(2.0)*lwave**2)
    else
      jyperk = 1
    endif
    !
    if (string(1:5).eq.'MILLI') then
      unit = 1E-3
    else if (string(1:5).eq.'MICRO') then
      unit = 1E6
    endif
    !
    ns = len_trim(string)
    if (string(ns-1:ns).eq.'JY') then
      if (head%char%unit.eq."K") then
        unit = 1./jyperk
      endif
    else if (string(ns:ns).eq.'K') then
      cunit = head%char%unit
      call sic_upper(cunit)
      if (cunit.eq."JY".or.cunit.eq."JY/BEAM") then
        unit = jyperk
      endif
    else
      call map_message(seve%e,rname,'Invalid threshold unit, see HELP MASK THRESHOLD')
      error = .true.
      return
    endif
  end select
  iarg = iarg+1
  !
  !! Print *,'NARG ',narg,' IARG ',iarg
  do while (iarg.lt.narg)
    call sic_ke(line,o_thre,iarg,string,ier,.false.,error)
    !! Print *,'STRING ',trim(string)
    call sic_ambigs (rname,string,key,ikey,vocab,mvoc,error)
    if (error) return
    select case (key)
    case ('GUARD')
      iarg = iarg+1
      call sic_r4(line,o_thre,iarg,margin,.false.,error)
      if (error) return
      if (margin.lt.0 .or. margin.gt.0.5) then
        call map_message(seve%e,rname,'Margin must be >0 and <0.5')
        error = .true.
        return
      endif
    case ('SMOOTH')
      iarg = iarg+1
      call sic_r4(line,o_thre,iarg,smo,.false.,error)
      iarg = iarg+1
      length = head%gil%majo
      if (iarg.le.narg) then
        call sic_ch(line,o_thre,iarg,string,ier,.false.,error)
        if (string.ne.'*') then
          call sic_r4(line,o_thre,iarg,length,.false.,error)
          if (error) then
            call map_message(seve%e,rname,'Invalid Length argument, expected * or Number of "')
            return
          endif
          if (length.lt.0 .or. length.gt.60.0) then
            call map_message(seve%e,rname,'Length must be >0 and < 60" (most likely...)' )
            error = .true.
            return
          endif
          length = length*pi/180./3600.
        endif
      endif
    case ('REGIONS') 
      iarg = iarg+1
      call sic_i4(line,o_thre,iarg,nregions,.false.,error)
    end select
    iarg = iarg+1
  enddo
  !
  debug = .false.
  call sic_get_logi('DEBUG',debug,error)
  if (debug) then
    print *,'RAW     ',raw, ' Unit ',unit
    print *,'SMOOTH  ',smo
    print *,'LENGTH  ',length*180*3600/pi
    print *,'MARGIN  ',margin
    print *,'REGIONS ',nregions
  endif
  error = .false.
  !
  !
  call sic_delvariable('MASK',.false.,error)
  if (allocated(dmask)) deallocate(dmask)    
  call gdf_copy_header(head,hmask,error)
  allocate(dmask(hmask%gil%dim(1),hmask%gil%dim(2),hmask%gil%dim(3)),   &
   &        stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Mask memory allocation error')
    error = .true.
    return
  endif
  !
  call mask_clean(hmask,dmask,head%r3d,raw*unit,smo*unit,length,      &
    & margin,icode,error)
  if (error) return
  if (nregions.ne.0) then
    write(chain,'(A,I0,A)') 'Kept only ',nregions
    call mask_prune(hmask,dmask,nregions,error)
    if (error) return
    ier = len_trim(chain)+1
    write(chain(ier:),'(A,I0,A)') ' regions, out of ',nregions
    call map_message(seve%i,rname,chain)
  endif
  !
  ! sic_mapgildas produces a Read-Only variable, so preset the
  ! content as 0/1 and the Min Max as appropriate for convenience.
  where(dmask.ne.0) dmask = 1.0 
  hmask%gil%rmin = 0.0
  hmask%gil%rmax = 1.0
  !
  call sic_mapgildas('MASK',hmask,error,dmask)
  user_method%do_mask = .true.
  support_type = 1 ! First plane will be used by default 
  !
end subroutine sub_mask_threshold
!
subroutine mask_clean (head,mask,data,raw,smo,length,margin, &
  icode,error) 
  !$ use omp_lib
  use clean_def
  use image_def
  use gbl_message
  use gkernel_interfaces
  use imager_interfaces, only : mulgau, map_message
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !
  ! IMAGER
  !   Support routine for MASK THRESHOLD 
  !     (and the now obsolete SUPPORT /THRESHOLD)
  !
  !   Builds a Mask from a Threshold and Smoothing 
  !
  !   icode indicates whether the mask is from Positive, Negative
  !   or Both values compared to the Threshold.
  ! 
  !   The mask is the .OR. of the Raw and Smooth version of the image.
  !   Blanking are set to Zero.
  !---------------------------------------------------------------------
  type (gildas), intent(inout) :: head
  real, intent(out), target :: 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
  integer, intent(in) :: icode      ! Code for sign
  logical, intent(out) :: error
  !
  real(8), parameter :: pi=3.141592653589793d0
  character(len=*), parameter :: rname='MASK'
  integer, parameter :: code_pos=1
  integer, parameter :: code_neg=-1
  integer, parameter :: code_all=0
  !
  integer nx,ny,nc,ix,iy,ic,jx,jy,ndim,dim(2),ier,kc
  real xinc, yinc,fact
  real, allocatable :: wfft(:)
  real, allocatable :: stmp(:,:)
  complex, allocatable :: ft(:,:)
  character(len=80) :: chain
  real :: lsmooth
  !
  integer(kind=index_length) :: nxy
  !
  lsmooth = length/1.665 ! FWHM to Sigma, just an empirical factor
  ! that produces a rather natural result. 2 would be good also !...
  !
  nx = head%gil%dim(1)
  ny = head%gil%dim(2)
  nc = head%gil%dim(3)
  allocate (wfft(2*max(nx,ny)),ft(nx,ny),stmp(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)
  !
  if (length.ne.0) then
    write(chain,'(A,F10.1,A)') 'Smoothing by ',length*180*3600/pi,' arcsec'
    call map_message(seve%i,rname,chain)
  endif
  !
  mask = 0.0
  nxy = nx*ny
  !
  !$OMP PARALLEL DEFAULT(none) & 
  !$OMP & SHARED(head,mask,data, nx,ny,jx,jy,nc,nxy, length, smo, raw) &
  !$OMP & SHARED(icode, xinc, yinc, dim, ndim, lsmooth) &
  !$OMP & PRIVATE(ic, kc, stmp, ft, wfft, ix, iy, fact, ier)
  !
  !$OMP DO
  do ic=1,nc
    !
    !
    ! Guard band of margin-th of the image size on each edge to
    ! avoid aliased sidelobes and "raw" thresholding
    stmp = 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
            stmp(ix,iy) = data(ix,iy,ic)
          endif
        enddo
      enddo    
    else
      do iy=jy+1,ny-jy
        do ix=jx+1,nx-jx
          stmp(ix,iy) = data(ix,iy,ic)
        enddo
      enddo
    endif
    !
    ! a 2-D version may be implemented by using kc=1 instead of kc=ic
    kc = ic
    if (icode.eq.code_all) then 
      do iy=jy+1,ny-jy
        do ix=jx+1,nx-jx
          if (abs(stmp(ix,iy)).gt.raw) mask(ix,iy,kc) = mask(ix,iy,kc)+1.0
        enddo
      enddo
    else if (icode.eq.code_neg) then
      do iy=jy+1,ny-jy
        do ix=jx+1,nx-jx
          if (stmp(ix,iy).lt.-raw) mask(ix,iy,kc) = mask(ix,iy,kc)+1.0
        enddo
      enddo
    else
      do iy=jy+1,ny-jy
        do ix=jx+1,nx-jx
          if (stmp(ix,iy).gt.raw) mask(ix,iy,kc) = mask(ix,iy,kc)+1.0
        enddo
      enddo
    endif
    !
    if (length.ne.0) then
      !
      ! Smoothing of initial image
      ft(:,:) = cmplx(stmp,0.0)
      call fourt(ft,dim,ndim,-1,0,wfft)
      !
      fact = 1.0
      call mulgau(ft,nx,ny,   &
           &    lsmooth, lsmooth, 0.0,   &
           &    fact,xinc,yinc, -1)
      call fourt(ft,dim,ndim,1,1,wfft)
      !
      ! Extract Real part
      stmp(:,:) = abs(real(ft))
      if (icode.eq.code_all) then 
        stmp = abs(stmp)
      else if (icode.eq.code_neg) then
        stmp = -stmp
      endif
      !! fact = lsmooth**2*pi/(4.0*log(2.0))/abs(xinc*yinc)/(nx*ny) ! Flux Factor
      fact = 1.0/(nx*ny)      ! Brightness factor
      ! Correct for Beam Area for flux density normalisation
      fact = smo/fact
      do iy=jy+1,ny-jy
        do ix=jx+1,nx-jx
          if (stmp(ix,iy).gt.fact) mask(ix,iy,kc) = mask(ix,iy,kc)+1.0
        enddo
      enddo
    endif
    !
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  !
end subroutine mask_clean
!
subroutine mask_prune (head,mask,nregions,error) 
  use clean_def
  use image_def
  use gbl_message
  use gkernel_interfaces
  use imager_interfaces, only : mulgau, map_message
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !
  ! IMAGER
  !   Support routine for 
  !     MASK THRESHOLD Args... REGIONS Regions
  ! and 
  !     MASK REGIONS Regions
  !   commands
  !---------------------------------------------------------------------
  type (gildas), intent(inout) :: head
  real, intent(inout), target :: mask(:,:,:)
  integer, intent(inout) :: nregions
  logical, intent(out) :: error
  !
  character(len=*), parameter :: rname='MASK'
  integer :: ic, nc, nx, ny, ier, nfields, mfields
  real, pointer :: tmp(:,:)
  real, allocatable :: stmp(:,:)
  !
  ! Pruning if needed
  if (nregions.eq.0) return
  !
  nc = head%gil%dim(3)    ! Number of "channels" of Mask
  nx = head%gil%dim(1)
  ny = head%gil%dim(2)
  allocate(stmp(nx,ny),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Prune - Memory allocation error')
    error = .true.
    return
  endif
  !
  mfields = 0
  do ic=1,nc
    tmp => mask(:,:,ic)
    !
    ! Pruning small isolated regions
    where (tmp.ne.0) tmp = 1.0
    !
    ! The mask is now a 0/1 valued image
    ! We convert it to a 0 - N valued image,
    ! where the N is the number of separate regions
    ! Label fields and Sort them by size
    !
    call label_field(tmp,head%gil%dim(1),head%gil%dim(2), &
      & stmp,nfields,0.1,0.0,-1.0,error)
    mfields = max(mfields,nfields)
    tmp = stmp     ! Copy back 
    where (tmp.gt.nregions) tmp = 0.
  enddo
  nregions = mfields
end subroutine mask_prune
!
subroutine mask_init(key,error)
  use clean_arrays
  use clean_types
  use clean_default
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !   IMAGER
  !     Support for command
  !   MASK INIT [2D|3D]
  !--------------------------------------------------------------------- 
  character(len=*), intent(in) :: key
  logical, intent(inout) :: error
  !
  character(len=*), parameter :: rname='MASK'
  integer :: ier
  !
  error = .false.
  !
  ! Free the current MASK if any
  save_data(code_save_mask) = .false.
  call sic_delvariable ('MASK',.false.,error)
  if (allocated(dmask)) deallocate(dmask,stat=ier)
  hmask%loca%size = 0
  if (key.eq.' ') return
  !
  if (key.ne.'2D'.and.key.ne.'3D') then
    call map_message(seve%e,rname,' INITIALIZE invalid argument '//trim(key))
    error = .true.
    return
  endif
  !
  !!Print *,'Last_Shown ',last_shown
  if (last_shown.eq.'CLEAN') then
    if (hclean%loca%size.eq.0) then
      call map_message(seve%e,rname,' INITIALIZE : no Clean image')
      error = .true.
      return
    endif
    call gdf_copy_header(hclean,hmask,error)  
  else if (last_shown.eq.'SKY') then
    if (hsky%loca%size.eq.0) then
      call map_message(seve%e,rname,' INITIALIZE : no Sky image')
      error = .true.
      return
    endif
    call gdf_copy_header(hsky,hmask,error)  
  else if (hsky%loca%size.ne.0) then
    if (.not.associated(hsky%r3d)) hsky%r3d => dsky
    call gdf_copy_header(hsky,hmask,error)  
  else if (hclean%loca%size.ne.0) then
    if (.not.associated(hclean%r3d)) hclean%r3d => dclean
    call gdf_copy_header(hclean,hmask,error)  
  else
    call map_message(seve%e,rname,' INITIALIZE : no Clean or Sky image')
    error = .true.
    return
  endif
  !
  if (key.eq.'2D') hmask%gil%dim(3) = 1
  allocate(dmask(hmask%gil%dim(1),hmask%gil%dim(2),hmask%gil%dim(3)),   &
   &        stat=ier)
  dmask = 0.0 ! By default, nothing is selected
  hmask%loca%size = hmask%gil%dim(1)*hmask%gil%dim(2)*hmask%gil%dim(3)
  !
  call sic_mapgildas ('MASK',hmask,error,dmask)
end subroutine mask_init
!
subroutine mask_check(all,error)
  use clean_arrays
  use clean_types
  use clean_default
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !   IMAGER
  ! Support for command MASK
  !---------------------------------------------------------------------
  logical, intent(in) :: all
  logical, intent(inout) :: error
  character(len=*), parameter :: rname='MASK'
  !
  error = .true.
  !
  if (hmask%loca%size.eq.0) then
    call map_message(seve%e,rname,'No Mask defined')
    return
  endif  
  !
  if (last_shown.eq.'SKY') then
    if (any(hmask%gil%dim(1:2).ne.hsky%gil%dim(1:2))) then
      call map_message(seve%e,rname,'Mask and Sky sizes do not match')
      return
    else if (hmask%gil%dim(3).ne.1) then
      ! Check matching velocity range would be better
      if (hmask%gil%dim(3).ne.hsky%gil%dim(3)) then
        call map_message(seve%w,rname,'Mask and Sky planes mismatch, proceed at own risk',3)
      endif
    endif 
    !
  else if (last_shown.eq.'CLEAN') then
    if (any(hmask%gil%dim(1:2).ne.hclean%gil%dim(1:2))) then
      call map_message(seve%e,rname,'Mask and Clean sizes do not match')
      return
    else if (hmask%gil%dim(3).ne.1) then
      ! Check matching velocity range would be better
      if (hmask%gil%dim(3).ne.hclean%gil%dim(3)) then
        call map_message(seve%w,rname,'Mask and Clean planes mismatch, proceed at own risk',3)
      endif
    endif 
  endif
  error = .false.
end subroutine mask_check
