subroutine flux_comm(line,error)
  use image_def
  use gkernel_types
  use gkernel_interfaces
  use clean_arrays
  use moment_arrays
  use clean_support
  use gbl_message
  use imager_interfaces, except_this => flux_comm
  !---------------------------------------------------------------------
  ! @ private
  ! IMAGER
  !   Support for command
  !       FLUX CURSOR|MASK|SUPPORT [/CCT] 
  ! Compute the Flux in the specified region(s)
  !
  ! The output should be a SIC Structure named FLUX
  !   FLUX%NF   The number of fields
  !   FLUX%NC   The number of channels
  !   FLUX%VELOCITIES     The channel velocities
  !   FLUX%FREQUENCIES     The channel frequencies
  !   FLUX%VALUES[Flux%Nc,Flux%Nf]   The spectra for every field
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  real(8), parameter :: pi=3.141592653589793d0
  integer, parameter :: o_cct=1 ! /CCT option
  real, parameter :: large=3
  character(len=*), parameter :: varflux='FLUX'
  character(len=*), parameter :: rname='FLUX'
  !
  character(len=12) :: key, argum
  integer, parameter :: mvoc=3
  character(len=12) :: vocab(mvoc)
  integer :: ikey
  data vocab/'CURSOR','MASK','SUPPORT'/
  !
  real :: flux, beam_area
  character(len=80) :: chain
  real :: bval, eval
  ! For polygon support
  character(len=12) :: file
  integer :: n
  logical :: fromfile=.false.
  type (polygon_t), save, target :: polflux
  real(kind=4) :: sum,aire,mean,sigma,prev_sigma,minmax(2)
  real(kind=4) :: nsig_clip
  real(kind=4) :: range,center
  logical :: clip,quiet
  ! For Mask support
  real :: threshold, scale
  real, allocatable :: fmask(:,:), gmask(:,:)
  integer :: ier
  integer :: nfields, if, kf
  integer(kind=index_length) :: nx,ny
  integer, allocatable :: npix(:)
  real, allocatable :: sums(:)
  real :: pixel_area
  ! Test type of Display
  integer, parameter :: mcase=4
  integer :: icase,jcase
  character(len=24) :: dircase(mcase)  
  character(len=12) :: showcas(mcase)
  data dircase /'<GREG<AREA','<GREG<P1-1','<GREG<XY','<GREG<M_AREA'/
  data showcas /'VIEW','SHOW','INSPECT','MOMENTS'/
  logical :: active
  integer :: win_num
  !
  integer :: ic
  integer(kind=index_length) :: dim(2)
  real, pointer :: aplane(:,:)
  !
  logical :: do_insert
  !
  if (sic_present(o_cct,0)) then
    call map_message(seve%e,rname,'/CCT option not yet implemented')
    error = .true.
    return
  endif
  !
  do_insert = sic_lire().eq.0
  !
  file = ' '
  argum = ' ' ! 'SUPPORT' or 'CURSOR' as a default ?
  call sic_ke(line,0,1,argum,n,.true.,error)
  call sic_ambigs (rname,argum,key,ikey,vocab,mvoc,error)
  if (error) return
  !
  ! Erase any previous FLUX structure
  if (flux_nf.ne.0 .and. flux_nc.ne.0) then
    call sic_delvariable('FLUX',.false.,error)  ! not User
    if (allocated(flux_velo)) deallocate(flux_velo,flux_freq)
    if (allocated(flux_values)) deallocate(flux_values)
    flux_nf = 0
    flux_nc = 0
  endif
  !
  flux_nc = max(1,hclean%gil%dim(3))   ! Number of channels
  flux_nf = 1                          ! 1 field by default
  allocate(flux_velo(flux_nc),flux_freq(flux_nc),stat=ier)
  do ic = 1,flux_nc
    flux_velo(ic) = (ic-hclean%gil%ref(3))*hclean%gil%vres + hclean%gil%voff
    flux_freq(ic) = (ic-hclean%gil%ref(3))*hclean%gil%fres + hclean%gil%freq
  enddo
  !
  ! Beam area
  beam_area = pi*hclean%gil%majo*hclean%gil%mino/(4.*log(2.))
  ! Pixel area
  pixel_area = abs(hclean%gil%inc(1)*hclean%gil%inc(2))
  ! Blanking values
  bval = hclean%gil%bval
  eval = hclean%gil%eval
  !
  if (key.eq.'CURSOR') then
    ! Call cursor to define - This only makes sense if a single
    ! image plane is defined, or if we are in a "Map" display
    ! That can be tested by the names of the sub-directories
    ! <GREG<AREA  (for VIEW command)
    ! <GREG<P1-1  (for SHOW command)
    ! <GREG<XY    (for INSPECT command)
    ! <GREG<M_AREA for SHOW MOMENTS  (or SHOW COMPOSITE)
    !
    jcase = 0
    do icase=1,mcase
      if (gtexist(dircase(icase))) then
        call gr_execl('CHANGE DIREC '//dircase(icase))
        call relocate(0.d0,0.d0)  ! call_exec1('DRAW RELO 0 0 /USER')
        jcase = icase
        exit
      endif
    enddo
    if (jcase.eq.0) then
      call map_message(seve%e,rname,'No image plane panel available for cursor')
      error = .true.
      return
    else
      call map_message(seve%i,rname,'Defining support from a '//trim(showcas(jcase))//' display')
    endif
    !
    ! and calling the proper routine:
    call greg_poly_define(rname,file,fromfile,polflux,varflux,error)
    if (error)  return
    !
    ! Return back to <GREG
    call gr_execl('CHANGE DIREC <GREG')
    !
    ! Compute moments over polygon for each channel
    allocate(sums(flux_nf),npix(flux_nf),flux_values(flux_nc,flux_nf),stat=ier) 
    do ic=1,flux_nc
      aplane => dclean(:,:,ic)
      center = 0
      range =  0
      call my_moments(aplane,hclean,polflux,.false.,center,range,& 
        & sums(1),aire,npix(1),mean,sigma,minmax)
      !
      ! Convert to Flux
      !
      ! The formula for the Flux depends on the relative size of the beams 
      ! and covered area (aire).
      !
      ! This below assumes that the Area is sufficiently larger than the Beam
      !     flux = sum / beam_area         !
      ! But the minimum significant area is one beam. Since "sum = mean * aire",
      ! we should use "mean" instead of "sum / beam_area" if aire < beam_area.
      ! So the appropriate formula is 
      !     flux = mean * max(aire/beam_area,1.0)
      !
      ! The formula above is not strictly correct, as we should take the 
      ! value towards the centroid when the area is smaller than about
      ! a beam. However the values will not change much across the support
      ! in this case, as the pixels are correlated across one beam, so 
      ! it is a (very) reasonable approximation  in most cases.
      !
      ! It would fail if the support was made of disconnected pixels 
      ! separated by more than one beamwidth.
      !
      ! Put in place
      flux_values(ic,1) = mean * max(aire/beam_area,1.0)
    enddo
  else if (key.eq.'SUPPORT') then
    if (supportpol%ngon.lt.3) then
      call map_message(seve%e,rname,'SUPPORT is not yet defined')
      error = .true.
      return
    endif
    ! Compute moments over polygon for each channel
    allocate(sums(flux_nf),npix(flux_nf),flux_values(flux_nc,flux_nf),stat=ier) 
    ! Compute moments over polygon
    do ic=1,flux_nc
      aplane => dclean(:,:,ic)
      call my_moments(aplane,hclean,supportpol,.false.,center,range, &
        & sums(1),aire,npix(1),mean,sigma,minmax)
      ! Convert to flux, see above for description
      flux_values(ic,1) = mean * max(aire/beam_area,1.0)
    enddo
  else if (key.eq.'MASK') then
    if (hmask%loca%size.eq.0) then
      call map_message(seve%e,rname,'MASK is not yet defined')
      error = .true.
      return
    endif
    nx = hmask%gil%dim(1)
    ny = hmask%gil%dim(2)
    threshold = 0.1
    allocate(fmask(nx,ny),gmask(nx,ny),stat=ier)
    if (hmask%gil%dim(3).gt.1) then
      call map_message(seve%i,rname,'Collapsing Mask planes')
      do ic=1,hmask%gil%dim(3)
        gmask(:,:) = gmask(:,:)+dmask(:,:,ic)
      enddo
    else
      gmask(:,:) = dmask(:,:,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
    call label_field(gmask,nx,ny,fmask,nfields,threshold,  &
      & 0.0,-1.0,error)
    dmask(:,:,1) = fmask     ! Copy back for tests
    hmask%gil%rmax = nfields
    flux_nf = max(1,nfields)
    !
    allocate(sums(flux_nf),npix(flux_nf),flux_values(flux_nc,flux_nf),stat=ier) 
    flux_values = 0
    !
    do ic=1,flux_nc
      aplane => dclean(:,:,ic)
      call label_stat(nx,ny,fmask,aplane,nfields,npix,sums,bval,eval)
      !
      ! Put in place
      do if=1,nfields
        if (npix(if).ne.0) then
          ! Convert to Flux - pixel area was not yet included there
          scale = max(pixel_area/beam_area,1.0/npix(if))
          flux_values(ic,if) = sums(if)*scale
        endif
      enddo
    enddo
    !
  else
    Print *,'Not yet coded for '//key
    error = .true.
  endif
  if (error) return
  !
  ! Define resulting structure
  call sic_defstructure('FLUX',.true.,error)
  dim(1) = flux_nc
  dim(2) = flux_nf
  call sic_def_real('FLUX%VALUES',flux_values,2,dim,.false.,error) 
  call sic_def_real('FLUX%VELOCITIES',flux_velo,1,dim,.false.,error) 
  call sic_def_dble('FLUX%FREQUENCIES',flux_freq,1,dim,.false.,error) 
  call sic_def_inte('FLUX%NF',flux_nf,0,dim,.false.,error) 
  call sic_def_inte('FLUX%NC',flux_nc,0,dim,.false.,error) 
  !
  if (do_insert) call sic_insert_log(line)
  if (flux_nc.ne.1) return
  !
  kf = 1
  do if=1,flux_nf
    if (nfields.gt.1) then
      write(chain,'(A,I0)') 'Zone number ',if      
      kf = 21
    endif
    flux = sums(if)
    ! Printout
    if (flux.lt.0.03) then
      if (flux.gt.0.001) then
        write(chain(kf:),'(A,F6.1,A)') "Total Flux ", flux*1000., " mJy"
      else
        write(chain(kf:),'(A,I4,A)')  "Total Flux ", nint(flux*1e6), "   microJy"
      endif
    else if (flux.lt.0.2) then
      write(chain(kf:),'(A,I4,A)')  "Total Flux ", nint(flux*1e3), "   mJy"
    else
      write(chain(kf:),'(A,F6.1,A)')  "Total Flux ", flux, "Jy"
    endif
    call map_message(seve%i,rname,chain)
  enddo
end subroutine flux_comm
!
subroutine label_field(imagein,ncolumns,nlines,labelout,nfields,threshold,  &
  blank,eblank,error)
  use gildas_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! @ private
  !
  ! Modifie S.Guilloteau LAB 20 Janv 2013
  !    Order the field numbers by number of pixels
  ! Modifie S.Guilloteau
  !   Groupe d Astrophysique de Grenoble 22 Octobre 1985
  ! Valeurs non definies et declaration LabelOut en reel
  !
  ! Origine : A.Bijaoui 25 octobre 1984 Observatoire de Nice
  ! Saidi1 Permet l'etiquettage des domaines a partir d'une
  ! segmentation avec seuil de flux
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in)    :: ncolumns                   ! Number of "Columns"
  integer(kind=index_length), intent(in)    :: nlines                     ! Number of "lines"
  real(kind=4),               intent(in)    :: imagein(ncolumns,nlines)   ! Input image
  real(kind=4),               intent(out)   :: labelout(ncolumns,nlines)  ! Labels of fields
  integer(kind=4),            intent(out)   :: nfields                    ! Number of fields
  real(kind=4),               intent(in)    :: threshold                  ! Threshold
  real(kind=4),               intent(in)    :: blank                      ! Blanking
  real(kind=4),               intent(in)    :: eblank                     ! and tolerance
  logical,                    intent(inout) :: error                      ! Logical error flag
  ! Local
  integer(kind=index_length) :: iline,icolumn
  integer(kind=4) :: l1,l2,la1,la2,la,ier
  integer(kind=4), allocatable :: buf1(:),buf2(:)
  integer(kind=4) :: mfields,nfieldsi,ifield,jfield
  !
  ! Allocate working buffers
  mfields = nlines*ncolumns  ! Maximum number of fields in image
  allocate(buf1(mfields),buf2(mfields),stat=ier)
  if (failed_allocate('FIELD_FIND','buffers',ier,error))  return
  !
  nfieldsi=0
  do iline=1,nlines
    do icolumn=1,ncolumns
      if (imagein(icolumn,iline).lt.threshold) then
        labelout(icolumn,iline)=0.0
      elseif (abs(imagein(icolumn,iline)-blank).le.eblank) then    !SG
        labelout(icolumn,iline)=0.0    !SG
      else
        labelout (icolumn,iline) = 0.0
        if (icolumn.ne.1) then
          l1=labelout(icolumn-1,iline)
          if (l1.ne.0) labelout(icolumn,iline)=l1
        endif
        if (iline.ne.1) then
          l2=labelout(icolumn,iline-1)
          if (l1.eq.0) then
            if (l2.eq.0) then
              nfieldsi=nfieldsi+1
              buf1(nfieldsi)=nfieldsi
              labelout(icolumn,iline)=nfieldsi
            else
              labelout(icolumn,iline)=l2
            endif
          else
            if (l2.ne.0) then
              if (l2.ne.l1) then
                call descen(buf1,l1,la1)
                call descen(buf1,l2,la2)
                la=min0(la1,la2)
                buf1(la1)=la
                buf1(la2)=la
                labelout(icolumn,iline)=la
              endif
            endif
          endif
        endif
      endif
    enddo
  enddo
  !
  nfields=0
  do ifield=1,nfieldsi
    call descen(buf1,ifield,jfield)
    if (ifield.eq.jfield) then
      nfields=nfields+1
      buf2(ifield)=nfields
    endif
  enddo
  do iline=1,nlines
    do icolumn=1,ncolumns
      l1 = labelout(icolumn,iline)
      if (l1.ne.0) then
        call descen(buf1,l1,la1)
        labelout(icolumn,iline)=buf2(la1)
      endif
    enddo
  enddo
  !
  ! Sort the final labels by descending number of pixels...
  buf1(:) = 0  ! buf1 is now used as the number of pixels per field
  do iline=1,nlines
    do icolumn=1,ncolumns
      if (labelout(icolumn,iline).ne.0) then
        ifield = labelout(icolumn,iline)
        buf1(ifield) = buf1(ifield)-1
      endif
    enddo
  enddo
  !
  ! Compute the sorting array
  do iline=1,nfields
    buf2(iline) = iline  ! buf2 is now used as the sorting array
  enddo
  call gi4_trie(buf1,buf2,nfields,error)
  ! Compute back sorting array
  do iline=1,nfields
    buf1(buf2(iline)) = iline  ! buf1 is now used as the back sorting srray
  enddo
  !
  do iline=1,nlines
    do icolumn=1,ncolumns
      if (labelout(icolumn,iline).ne.0) then
        ifield = labelout(icolumn,iline)
        labelout(icolumn,iline) = buf1(ifield)
      endif
    enddo
  enddo
  !
  deallocate(buf1,buf2)
  !
contains
  !
  subroutine descen(label,labin,labout)
    integer(kind=4), intent(inout) :: label(*)
    integer(kind=4), intent(in)    :: labin
    integer(kind=4), intent(out)   :: labout
    ! Local
    integer(kind=4) :: lab
    !
    labout = labin
    do
      lab = label(labout)
      if (lab.eq.labout) return
      labout = lab
    enddo
  end subroutine descen
  !
end subroutine label_field
!
subroutine label_stat(nx,ny,label,data,nf,npix,sums,bval,eval)
  use gildas_def
  !---------------------------------------------------------------------
  !   @ private
  ! IMAGER
  !     Compute statistics from an image and an associated
  !   label fields.
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: nx  ! Number of pixels in X
  integer(kind=index_length), intent(in) :: ny  ! Number of pixels in Y
  real, intent(in) :: label(nx,ny)              ! Label array
  real, intent(in) :: data(nx,ny)               ! Data array
  integer, intent(in) :: nf                     ! Number of fields
  integer, intent(out) :: npix(nf)              ! Number of pixels per field
  real, intent(out) :: sums(nf)                 ! Sum per field
  real, intent(in) :: bval, eval                ! Blanking values
  !
  integer :: i,j
  integer :: ilab
  real :: value
  !
  npix = 0
  sums = 0.
  !
  do j = 1,ny
    do i = 1,nx
      ilab = label(i,j)
      if (ilab.ne.0) then
        value = data(i,j) 
        if (abs(value-bval).gt.eval) then
          npix(ilab) = npix(ilab)+1
          sums(ilab) = sums(ilab)+value
        endif
      endif
    enddo
  enddo
end subroutine label_stat
!
subroutine my_moments(z,head,poly,clip,center,range, &
  sum,aire,npix,mean,sigma,minmax)
  use phys_const
  use image_def
  use greg_types
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! @ private-mandatory
  ! IMAGER
  !   Compute statistics about a 2-D array within a N-gon
  ! Derived from gr8_moments, but using image header instead
  ! of regular grid description
  !---------------------------------------------------------------------
  real(kind=4),    intent(in)  :: z(:,:)     ! Data array
  type(gildas),    intent(in)  :: head       ! Data Header
  type(polygon_t), intent(in)  :: poly       ! Current polygon
  logical,         intent(in)  :: clip       ! Clip out of range values
  real(kind=4),    intent(in)  :: center     ! Center of accepted interval
  real(kind=4),    intent(in)  :: range      ! Half width of accepted interval
  real(kind=4),    intent(out) :: sum        ! Integrated map value
  real(kind=4),    intent(out) :: aire       ! Area of polygon
  integer(kind=4), intent(out) :: npix       ! Number of interior pixels
  real(kind=4),    intent(out) :: mean       ! Mean map value
  real(kind=4),    intent(out) :: sigma      ! RMS value
  real(kind=4),    intent(out) :: minmax(2)  ! Min and max values
  ! Local
  real(kind=8)    :: x,y,s1,s2,value
  integer(kind=4) :: i,j,s0,imin,imax,jmin,jmax
  real(kind=4)    :: b          ! Blanking value
  real(kind=4)    :: eb         ! Tolerance on blanking
  !
  b = head%gil%bval
  eb = head%gil%eval
  !
  s0 = 0
  s1 = 0.
  s2 = 0.
  sigma = 0.
  mean = 0.
  !
  ! Avoid exploring all the Map by finding IMIN,IMAX,JMIN,JMAX
  if (head%gil%inc(1).gt.0.) then
    imin = max (1,    int((poly%xgon1-head%gil%val(1))/head%gil%inc(1)+head%gil%ref(1)) )
    imax = min (head%gil%dim(1),int((poly%xgon2-head%gil%val(1))/head%gil%inc(1)+head%gil%ref(1))+1 )
  else
    imin = max (1,    int((poly%xgon2-head%gil%val(1))/head%gil%inc(1)+head%gil%ref(1)) )
    imax = min (head%gil%dim(1),int((poly%xgon1-head%gil%val(1))/head%gil%inc(1)+head%gil%ref(1))+1 )
  endif
  if (head%gil%inc(2).gt.0.) then
    jmin = max (1,    int((poly%ygon1-head%gil%val(2))/head%gil%inc(2)+head%gil%ref(2)) )
    jmax = min (head%gil%dim(2),int((poly%ygon2-head%gil%val(2))/head%gil%inc(2)+head%gil%ref(2))+1 )
  else
    jmin = max (1,    int((poly%ygon2-head%gil%val(2))/head%gil%inc(2)+head%gil%ref(2)) )
    jmax = min (head%gil%dim(2),int((poly%ygon1-head%gil%val(2))/head%gil%inc(2)+head%gil%ref(2))+1 )
  endif
  !
  ! Now explore a reasonable part of the map
  if (eb.lt.0.0) then
    ! Blanking is disabled
    minmax(:) = z(imin,jmin)  ! First value is valid
    do j=jmin,jmax
      do i=imin,imax
        value = z(i,j) 
        if (.not.clip.or.abs(value-center).le.range) then
          x = (i-head%gil%ref(1))*head%gil%inc(1)+head%gil%val(1)
          y = (j-head%gil%ref(2))*head%gil%inc(2)+head%gil%val(2)
          if (greg_poly_inside(x,y,poly)) then
            s0 = s0 + 1
            s1 = s1 + value
            s2 = s2 + value**2
            if (minmax(1).gt.value)  minmax(1) = value  ! Min
            if (minmax(2).lt.value)  minmax(2) = value  ! Max
          endif
        endif
      enddo
    enddo
  else
    ! Blanking is enabled
    minmax(:) = b  ! First valid value is not known
    do j=jmin,jmax
      do i=imin,imax
        value = z(imin,jmin) 
        if (.not.clip.or.abs(value-center).le.range) then
          if (abs(value-b).gt.eb) then
            x = (i-head%gil%ref(1))*head%gil%inc(1)+head%gil%val(1)
            y = (j-head%gil%ref(2))*head%gil%inc(2)+head%gil%val(2)
            if (greg_poly_inside(x,y,poly)) then
              s0 = s0 + 1
              s1 = s1 + value
              s2 = s2 + value**2
              if (minmax(1).eq.b) then
                minmax(1) = value
              elseif (minmax(1).gt.value) then
                minmax(1) = value  ! Min
              endif
              if (minmax(2).eq.b) then
                minmax(2) = value
              elseif (minmax(2).lt.value) then
                minmax(2) = value  ! Max
              endif
            endif
          endif
        endif
      enddo
    enddo
  endif
  !
  x = abs(head%gil%inc(1)*head%gil%inc(2))
  sum = s1*x
  aire = s0*x
  npix = s0
  if (s0.ne.0) then
    s1 = s1 / s0
    mean = s1  ! Downcast to single precision, do not reuse below
    s2 = s2 / s0
    sigma = sqrt(s2-s1**2)
  endif
end subroutine my_moments
!
