subroutine mask_comm(line,error)
  use gildas_def
  use gbl_message
  use gkernel_types
  use clean_arrays
  use clean_default
  use clean_support
  use gkernel_interfaces
  use imager_interfaces, except_this => mask_comm
  !---------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Support routine for commandADVANCED\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] [/FROM ....]  
  !                 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
  !
  ! Constants
  character(len=*), parameter :: rname='MASK'
  !
  integer, parameter :: mvoc=15
  character(len=12) :: vocab(mvoc), key, lkey
  data vocab /'ADD','APPLY','CHECK','COLLAPSE','INITIALIZE', &
    & 'INTERACTIVE','LABEL','OVERLAY','READ','REGIONS','REMOVE', &
    & 'SHOW','THRESHOLD','USE','WRITE'/
  integer, parameter :: mfig=4
  character(len=12) :: figure(mfig), kfig
  data figure /'CIRCLE','ELLIPSE','POLYGON','RECTANGLE'/
  integer :: margs(mfig)
  data margs /3,5,1,5/
  !
  ! Local ---
  character(len=96), save  :: lstring=' '
  type(gildas) :: head
  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
  logical :: is_image
  logical :: rdonly
  !
  ! Code ----
  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
    if (sic_present(0,2)) then
      call sic_ke(line,0,2,name,nc,.true.,error)
      if (error) return
      call gildas_null(head) 
      is_image = .false.    ! Can check against a file
      call sub_readhead('MASK',name,head,is_image,error,rdonly) !,fmt,type)
      if (error) return
      call mask_check(name,head,error)
    else
      call mask_check(mask_template,hmask_temp,error)
    endif
    if (do_insert) call sic_insert_log(line)
    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(line,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 exec_program('READ MASK '//name(1:nc))
    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 
  case ('LABEL')
    call mask_to_label(error)
    if (error) return
  case ('COLLAPSE')
    call mask_collapse(error)
    if (error) return
  !
  ! These need the MASK and the Clean image
  case ('INTERACTIVE') 
    call mask_check(mask_template,hmask_temp,error)
    if (error) return
    !
    argum = '1'
    call sic_ke(line,0,2,argum,nc,.false.,error)
    call exec_program('@ p_mask interactive '//argum)
    do_insert = .false.
  case ('ADD','REMOVE')
    call mask_check(mask_template,hmask_temp,error)
    if (error) return
    !
    lkey = key
    call sic_lower(lkey)
    if (key.eq.'ADD') then
      lkey = 'add'
    else
      lkey = 'rm'
    endif
    !
    narg = sic_narg(0)
    if ((narg.eq.1).and.(lkey.eq.'rm')) then
      if (len_trim(lstring).eq.0) return ! Silent return
      call map_message(seve%i,rname,'Removing '//lstring(4:))
      continue ! Re-use the previous Lstring
    else
      call sic_ke(line,0,2,argum,nc,.true.,error)
      if (error) return  !
      call sic_ambigs (rname,argum,kfig,ikey,figure,mfig,error)
      if (error) return
      call sic_lower(kfig)
      lstring = kfig
      !
      if (narg.eq.margs(ikey)+2) then
        na = len_trim(lstring)+2
        if (kfig.ne.'polygon') then
          ! 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
            lstring(na:) = chain
            na = na + len_trim(chain)
          enddo
        else
          call sic_ch(line,0,3,chain,nc,.true.,error)
          if (error) return
          lstring(na:) = chain(1:nc)
        endif
      else
        call map_message(seve%e,rname,trim(key)//' '//trim(kfig)//' requires ' &
          & //char(margs(ikey)+ichar('0'))//' additional arguments')
        error = .true.
        return
      endif
    endif
    aline = '@ p_mask '//trim(lkey)//' '//lstring
    call exec_program(aline)
  case default
    select case (key)
    case ('APPLY') 
      call mask_apply(line,error)
      do_insert = .false.
    case ('OVERLAY') 
      call mask_check(mask_template,hmask_temp,error)
      if (error) return
      call exec_program('@ p_mask over')
    !
    ! Only MASK is needed below
    case ('USE')
      call mask_present(error)
      if (error) return
      call sub_support_mask(rname,.true.,.false.,error)
    case ('SHOW')
      call mask_present(error)
      if (error) return
      call exec_program('SHOW MASK')
    case ('WRITE')
      call mask_present(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)
    return
  end select
  !
  ! Activate the modified Mask if needed
  if (support_type.eq.support_mask) then
    call sub_support_mask(rname,.true.,.false.,error)
  endif
  if (do_insert) call sic_insert_log(line)
  !
  ! A final trick to avoid inserting the command
  call no_logstack()
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
  !
  ! Constants
  character(len=*), parameter :: rname='MASK'
  !
  ! Local ---
  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)
  !
  ! Update the Optimization counter if it is a known buffer
  call set_buffer_modified(argum)
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
  !*
  ! IMAGER -- MASK internal routine: Apply a mask
  !!
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: hin    !! Data cube header
  type(gildas), intent(in) :: hmask  !! Mask header
  real, intent(inout) :: din(hin%gil%dim(1),hin%gil%dim(2),hin%gil%dim(3))
  !! Data cube to be masked
  logical :: error                   !! Logical error flag
  !
  ! Local ---
  character(len=*), parameter :: rname='MASK'
  integer :: iplane, imask
  real(4) :: velocity
  real :: blank
  !
  ! Code ----
  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)
      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 in Velocity
    do iplane=1,hin%gil%dim(3)
      velocity = (iplane-hin%gil%ref(3))*hin%gil%vres + hin%gil%voff
      imask = nint((velocity-hmask%gil%voff)/hmask%gil%vres + hmask%gil%ref(3))
      imask = min(max(1,imask),hmask%gil%dim(3)) ! Just  in case
      where (hmask%r3d(:,:,imask).eq.0) din(:,:,iplane) = blank
    enddo
  endif
  !
end subroutine sub_mask_apply
!
subroutine gdf_compare_2d(hone,htwo,equal)
  use image_def
  !---------------------------------------------------------------------
  ! @ private
  !!   IMAGER -- GDF: Check 2D consistency of data cubes
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: hone  !! First header
  type(gildas), intent(in) :: htwo  !! Second header
  logical, intent(out) :: equal     !! Logical result
  !
  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 iso_c_binding
  use gkernel_interfaces
  use imager_interfaces, only : map_message, sub_mask_threshold, mask_init
  use clean_arrays
  use clean_default
  use clean_support
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Support for command ADVANCED\MASK THRESHOLD
  !
  !   ADVANCED\MASK  THRESHOLD Value Unit [SMOOTH Smooth Length]  
  !                  [GUARG Guard] [REGIONS Nregions] [/FROM MaskData]
  !
  !  Automatic Mask builder by Thresholding from data in MaskData  
  !
  !  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 MaskData if specified, fall back to CLEAN or SKY depending on 
  !   last one available. Mask is a 3D data cube.
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line  !! Command line
  logical, intent(inout) :: error       !! Logical error flag
  !
  ! Code ----
  call mask_init(line,'3D',error)
  if (error) then
    support_type = support_none
    return
  endif
  !
  call sub_mask_threshold(hmask_temp,mask_template,line,error)
  hmask%gil%eval = -1.0
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  !! Command line
  logical, intent(inout) :: error       !! Logical error flag
  !
  integer :: nregions
  logical, parameter :: doflux=.false.
  !
  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,doflux,error)
  if (error) return
  hmask%gil%rmax = nregions
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
  !
  !   ADVANCED\MASK  THRESHOLD Value Unit [SMOOTH Smooth Length]  
  !                  [GUARG Guard] [REGIONS Nregions] [/FROM MaskData]
  !
  !  Automatic Mask builder by Thresholding from data in MaskData  
  !
  !  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 MaskData if specified, fall back to CLEAN or SKY depending on 
  !   last one available. Mask is a 3D data cube.
  !!
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: head        !! Header of data used for threshold
  character(len=*), intent(in) :: name    !! Data cube name
  character(len=*), intent(in) :: line    !! Command line
  logical, intent(inout) :: error         !! Logical error flag
  !
  ! Constants
  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
  logical, parameter :: doflux=.true.
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  character(len=*), parameter :: rname='MASK'  
  integer, parameter :: mvoc=3
  character(len=8) :: vocab(mvoc)
  data vocab /'SMOOTH','GUARD','REGIONS'/
  !
  ! Local ---
  character(len=12) :: cunit
  character(len=8) :: string, lstring, key
  integer :: icode, ns
  character(len=64) :: chain
  real :: raw,smo,length,noise,margin,jyperk,lwave,unit
  integer :: ier, nregions, mregions, ikey, iarg, narg
  logical :: debug
  !
  ! Code ----
  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_ch(Line,o_thre,iarg,lstring,ier,.false.,error)
  string = lstring
  call sic_upper(string)
  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 ('NATIVE','UNIT')
    unit = 1.0
  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
    !
    ns = len_trim(string)
    if (string(ns-1:ns).eq.'JY') then
      if (head%char%unit.eq."K") then
        unit = 1./jyperk
      endif
      ns = ns-2
    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
      ns = ns-1
    else
      call map_message(seve%e,rname,'Invalid threshold unit, see HELP MASK THRESHOLD')
      error = .true.
      return
    endif
    ! Scale modifier
    if (ns.gt.0) then
      select case (string(1:ns))
      case ('MILLI')
        unit = 1E-3*unit
      case ('MICRO')
        unit = 1E-6*unit
      case ('M')
        if (lstring(1:ns).eq.'m') then
          unit = 1E-3*unit
        else
          unit = 1E6*unit
        endif
      case default
        call map_message(seve%e,rname,'Invalid threshold unit, see HELP MASK THRESHOLD')
        error = .true.
        return
      end select
    endif
    !
  end select
  iarg = iarg+1
  !
  !TEST! 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_MASK',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
  mregions = nregions
  call mask_prune(hmask,dmask,mregions,doflux,error,head%r3d)
  if (error) return
  if (nregions.ne.0) then
    write(chain,'(A,I0,A,I0)') 'Kept only ',nregions,' regions, out of ',mregions
  else
    write(chain,'(A,I0,A)') 'Found ',mregions,' regions'
    nregions = mregions
  endif
  call map_message(seve%i,rname,chain)
  !
  ! 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 
  ! NO - keep the mask as is with Region numbers
  !
  ! Command MASK APPLY can use it, and in scripts,
  !   LET Masked Raw /where Mask.ne.0  
  ! will do the job as well
  hmask%gil%rmin = 0.0
  hmask%gil%rmax = nregions
  !
  ! Attempt to make it Writeable
  hmask%loca%read = .false.
  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 
  !
  !   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        !! Data header
  real, intent(out), target :: mask(:,:,:)    !! Mask cube
  real, intent(in) :: data (:,:,:)            !! Data cube
  real, intent(in) :: raw             !! Raw threshold
  real, intent(in) :: smo             !! Smooth threshold
  real, intent(in) :: length          !! Smoothing length
  real, intent(in) :: margin          !! Guard band
  integer, intent(in) :: icode        !! Code for threshold sign
  logical, intent(out) :: error       !! Logical error flag
  !
  ! Constants
  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
  !
  ! Local ---
  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
  !
  ! Code ----
  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 if (nc.gt.1) 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,doflux,error,values) 
  use clean_def
  use image_def
  use gbl_message
  use gkernel_interfaces
  use imager_interfaces, only : mulgau, map_message, label_field
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !*
  ! IMAGER -- Support routine for  
  !     MASK THRESHOLD Args... REGIONS Regions  
  ! and   
  !     MASK REGIONS Regions  
  !
  !   Regions are ordered by decreasing number of pixels, or if requested 
  ! (doflux = .true. and values present) by decreasing integrated flux.
  !!!
  !---------------------------------------------------------------------
  type (gildas), intent(inout) :: head        !! Data header
  real, intent(inout), target :: mask(:,:,:)  !! Mask to be pruned
  integer, intent(inout) :: nregions          !! Number of regions selected
  logical, intent(in) :: doflux               !! Order by flux
  logical, intent(out) :: error               !! Logical error flag
  real, intent(in), optional :: values(:,:,:) !! Intensity values
  !
  ! Local ---
  character(len=*), parameter :: rname='MASK'
  integer :: ic, nc, nx, ny, ier, nfields, mfields
  integer :: ir, ix, iy
  real, pointer :: tmp(:,:)
  real, allocatable :: stmp(:,:),rtmp(:,:)
  real, allocatable :: fluxes(:)
  integer, allocatable :: isort(:)
  !
  ! Code ---
  nc = head%gil%dim(3)    ! Number of "channels" of Mask
  nx = head%gil%dim(1)
  ny = head%gil%dim(2)
  if (doflux ) then
    if (present(values)) then
      if (size(values,1).ne.nx .or. size(values,2).ne.ny &
        & .or. size(values,3).ne.nc) then
        call map_message(seve%e,rname,'MASK and Data size mismatch')
        error = .true.
        return
      endif
    else
      call map_message(seve%e,rname,'Programming error: doflux set and no values argument')
      error = .true.
      return
    endif
  endif
  !
  ! Pruning if more than 1 region
  allocate(stmp(nx,ny),rtmp(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)
    rtmp = mask(:,:,ic)   ! Can save this copy ...
    !
    ! Pruning small isolated regions
    where (rtmp.ne.0) rtmp = 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 OR by flux
    !
    call label_field(rtmp,head%gil%dim(1),head%gil%dim(2), &
      & stmp,nfields,0.1,0.0,-1.0,error)
    mfields = max(mfields,nfields)
    !
    if (doflux.and.nfields.ne.0) then
      allocate(fluxes(nfields),isort(nfields))
      fluxes = 0.0
      do iy=1,ny
        do ix=1,nx
          if (stmp(ix,iy).ne.0) then
            ir = stmp(ix,iy)
            fluxes(ir) = fluxes(ir)-values(ix,iy,ic) 
          endif
        enddo
      enddo
      !
      ! Re-order the NFIELDS flux values
      do ir=1,nfields
        isort(ir) = ir
      enddo
      call gr4_trie(fluxes,isort,nfields,error)
      do iy=1,ny
        do ix=1,nx
          if (stmp(ix,iy).ne.0) then
            ir = stmp(ix,iy)
            stmp(ix,iy) = isort(ir)
          endif
        enddo
      enddo
      deallocate(fluxes,isort)
    endif
    tmp = stmp     ! Copy back 
    if (nregions.ne.0) then
      ! Prune excess regions
      where (tmp.gt.nregions) tmp = 0.
    endif
  enddo
  if (nregions.eq.0) nregions = mfields
end subroutine mask_prune
!
subroutine mask_setup(line,iopt,iarg,error)
  use iso_c_binding
  use clean_arrays
  use clean_types
  use clean_default
  use clean_support
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message, sub_readhead
  !---------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Support for command  
  !      MASK INIT [2D|3D] [/FROM Variable]
  !!
  !--------------------------------------------------------------------- 
  character(len=*), intent(in) :: line  !! Comand line
  integer, intent(in) :: iopt, iarg     !! Option and Argument numbers
  logical, intent(inout) :: error       !! Logical error flag
  !
  ! Constants
  character(len=*), parameter :: rname='MASK'
  integer, parameter :: o_from=1 ! /FROM Variable option
  !
  ! Local ---
  logical :: is_image
  logical :: rdonly
  integer :: n
  character(len=64) :: name
  type (c_ptr) :: cptr
  !
  ! Code ----
  error = .false.
  !
  is_image = .true.     ! Only on Images
  if (sic_present(iopt,iarg)) then
    call sic_ke(line,iopt,iarg,name,n,.true.,error)
    if (error) return    !
    mask_template = name
  else if (last_shown.eq.'CLEAN') then
    if (hclean%loca%size.eq.0) then
      call map_message(seve%e,rname,'no Clean image')
      error = .true.
      return
    endif
    mask_template = 'CLEAN'
  else if (last_shown.eq.'SKY') then
    if (hsky%loca%size.eq.0) then
      call map_message(seve%e,rname,'no SKY image')
      error = .true.
      return
    endif
    mask_template = 'SKY'
  else if (hsky%loca%size.ne.0) then
    mask_template = 'SKY'
  else if (hclean%loca%size.ne.0) then
    mask_template = 'CLEAN'
  else if (hdirty%loca%size.ne.0) then
    mask_template = 'DIRTY'
  else
    call map_message(seve%e,'MASK','No CLEAN, DIRTY or SKY available')
    error = .true.
    return
  endif
  !
  call sic_delvariable('DATAMASK',.false.,error)
  call gildas_null(hmask_temp)
  call sub_readhead('MASK',mask_template,hmask_temp,is_image,error,rdonly) !,fmt,type)
  if (error) return
  !
  call adtoad(hmask_temp%loca%addr,cptr,1)
  call c_f_pointer(cptr,hmask_temp%r3d,hmask_temp%gil%dim(1:3))
  call sic_def_char('DATAMASK',mask_template,.false.,error)  
  !
end subroutine mask_setup
!
subroutine mask_init(line,key,error)
  use iso_c_binding
  use clean_arrays
  use clean_types
  use clean_default
  use clean_support
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message, mask_setup
  !---------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Support for command  
  !   MASK INIT [2D|3D] [/FROM CubeVariable]
  !!
  !--------------------------------------------------------------------- 
  character(len=*), intent(in) :: line  !! Command line
  character(len=*), intent(in) :: key   !! Action key: 
  !!  ' ' reset, 2D or 3D initialize with specified rank
  logical, intent(inout) :: error       !! Logical error flag
  !
  ! Constants
  character(len=*), parameter :: rname='MASK'
  integer, parameter :: o_from=1 ! /FROM Variable option
  !
  ! Local ---
  integer :: ier
  !
  ! Code ----
  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
  call gildas_null(hmask)
  ! And do not try to use it...
  user_method%do_mask = .false.
  !
  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
  !
  call mask_setup(line,o_from,1,error)
  if (error) return
  !
  call gdf_copy_header(hmask_temp,hmask,error)
  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_present(error)
  use clean_arrays
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !   IMAGER
  ! Support for command MASK 
  !   Check MASK existence
  !---------------------------------------------------------------------
  logical, intent(inout) :: error
  !
  character(len=*), parameter :: rname='MASK'
  !
  if (hmask%loca%size.eq.0) then
    call map_message(seve%e,rname,'No Mask defined')
    error = .true.
    return
  endif  
end subroutine mask_present
!
subroutine mask_check(name,head,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 
  
  !   Check MASK existence and conformance.
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: name  !! Cube variable name
  type(gildas), intent(in) :: head      !! Cube header 
  logical, intent(inout) :: error       !! Logical error flag
  !
  character(len=*), parameter :: rname='MASK'
  !
  if (hmask%loca%size.eq.0) then
    call map_message(seve%e,rname,'No Mask defined, use MASK INIT first')
    error = .true.
    return
  endif  
  !
  if (any(hmask%gil%dim(1:2).ne.head%gil%dim(1:2))) then
    call map_message(seve%e,rname,'Mask and '//trim(name)//' sizes do not match')
    error = .true.
    return
  else if (hmask%gil%dim(3).ne.1) then
    ! Check matching velocity range would be better
    if (hmask%gil%dim(3).ne.head%gil%dim(3)) then
      call map_message(seve%w,rname,'Mask and '//trim(name)//' planes mismatch, proceed at own risk',seve%e)
    endif
  endif 
end subroutine mask_check
!
subroutine mask_to_label (error)
  use clean_arrays
  use clean_types
  use clean_default
  use gbl_message
  use imager_interfaces, only : map_message, sub_mask_to_label
  !---------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Support for command MASK LABEL
  !
  ! Attribute a unique lable to each connex region of the MASK.
  !!
  !---------------------------------------------------------------------
  logical, intent(out) :: error  !! Logical error flag
  !
  ! Local ---
  integer :: nfields
  !
  ! Code ----
  if (hmask%loca%size.eq.0) then
    call map_message(seve%e,'MASK','No Mask defined')
    error = .true.
    return
  endif
  error = .false.
  !
  hmask%r3d => dmask
  call sub_mask_to_label (hmask,hmask%r3d(:,:,1),nfields,error)
  hmask%gil%rmax = nfields
end subroutine mask_to_label
!
subroutine mask_collapse (error)
  use clean_arrays
  use clean_types
  use clean_default
  use gbl_message
  use gkernel_interfaces
  use imager_interfaces, only : map_message, sub_mask_to_label
  !---------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Support for command MASK COLLAPSE
  !
  !   Collapse a 3D mask into a 2D one by the .OR. of all planes.
  !!
  !---------------------------------------------------------------------
  logical, intent(out) :: error  !! Logical error flag
  !
  ! Local ---
  integer :: i, ier
  real, allocatable :: cmask(:,:)
  !
  ! Code ----
  if (hmask%loca%size.eq.0) then
    call map_message(seve%e,'MASK','No Mask defined')
    error = .true.
    return
  endif
  error = .false.
  !
  if (hmask%gil%dim(3).le.1) return
  !
  allocate(cmask(hmask%gil%dim(1),hmask%gil%dim(2)),stat=ier)
  cmask = 0.
  do i=1,hmask%gil%dim(3)
    cmask(:,:) = cmask(:,:) + dmask(:,:,i)
  enddo
  !
  call sic_delvariable('MASK',.false.,error)
  deallocate(dmask)
  allocate(dmask(hmask%gil%dim(1),hmask%gil%dim(2),1),stat=ier)
  !
  hmask%gil%dim(3) = 1
  dmask(:,:,1) = cmask(:,:)
  hmask%loca%size = hmask%gil%dim(1)*hmask%gil%dim(2)
  ! 
  hmask%r3d => dmask
  call cube_minmax('MASK',hmask,error)
  call sic_mapgildas('MASK',hmask,error,dmask)
end subroutine mask_collapse
!
subroutine sub_mask_to_label (hmask,fmask,nfields,error)
  use gkernel_types
  use gbl_message
  use imager_interfaces, only : map_message, label_field
  !---------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Support for command MASK LABEL
  !
  ! Attribute a unique label to each connex region of a MASK.
  ! Automatically collapse to 2D if mask is 3D.
  !! 
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: hmask         !! Mask structure
  real, intent(inout) :: fmask(:,:)         !! 2-D final mask
  integer, intent(out) :: nfields           !! Number of regions
  logical, intent(out) :: error             !! Error flag
  !
  integer :: ic,ier
  real :: threshold
  real, allocatable :: gmask(:,:)
  !
  threshold = 0.1
  allocate(gmask(hmask%gil%dim(1),hmask%gil%dim(2)),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,'MASK','Temporary Mask allocation error')
    error = .true.
    return
  endif
  if (hmask%gil%dim(3).gt.1) then
    call map_message(seve%i,'MASK','Collapsing Mask planes')
    do ic=1,hmask%gil%dim(3)
      gmask(:,:) = gmask(:,:)+hmask%r3d(:,:,ic)
    enddo
  else
    gmask(:,:) = hmask%r3d(:,:,1)
  endif
  where (gmask.ne.0) gmask = 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 isolated regions
  error = .false.
  !
  call label_field(gmask,hmask%gil%dim(1),hmask%gil%dim(2), &
    & fmask,nfields,threshold,0.0,-1.0,error)
  if (error) return
end subroutine sub_mask_to_label
