subroutine statistic (line,error)
  use gkernel_interfaces
  use gkernel_types
  use imager_interfaces, except_this=>statistic, no_interface=>compute_stat
  use clean_def
  use clean_arrays
  use clean_default
  use clean_types
  use clean_support
  use gbl_message
  !----------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !     Support for command
  !   STATISTIC Image [Edge] [/WHOLE] [/NOISE Variable]
  !
  !     Compute Statistics on internal image, and optionally
  !   return the noise level in the specified Variable.
  !   Image is the name of one of the internal images (DIRTY, CLEAN,
  !   RESIDUAL, SKY, etc...)
  ! 
  !----------------------------------------------------------------------
  character(len=*), intent(inout) :: line
  logical, intent(out) :: error
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  integer, parameter :: o_whole=2
  integer, parameter :: o_noise=1
  !
  type (gildas), pointer :: hstat
  type (gildas), target :: htmp
  real, pointer :: dstat(:,:)
  integer ier, plane, na, nx, ny
  character(len=12) argum,stype
  logical do_whole, do_mask
  real valmin, valmax, mean, rms, noise, beam, flux, sec, lambda, jyperk
  integer imin, imax, jmin, jmax, n_sup, n_off, box(4), ntype, n
  character(len=4) :: rname = 'STAT'
  character(len=24) :: prefix
  character(len=3) :: fixpre
  character(len=64) :: var
  real :: scale, uscale, edge
  real, save :: stat_noise = 0.0
  !
  type(sic_descriptor_t) :: desc
  integer(kind=4), save, target :: memory(2)
  integer(kind=address_length) :: ip, ipstat
  logical :: found, verbose  
  !
  ! Save DO_MASK
  do_mask = user_method%do_mask
  verbose = .not.sic_present(o_noise,0)
  !
  ! Type of image (default = last_shown)
  !
  argum = last_shown
  call sic_ke (line,0,1,argum,na,.false.,error)
  stype = argum
  !
  ! Plane
  plane = 0
  if (sic_present(0,2)) then
    call sic_i4(line,0,2,plane,.false.,error)
    if (error) return
  else
    call sic_get_inte ('FIRST',plane,error)
  endif
  if (plane.le.0) plane = 1
  !
  ! Allocate memory
  ipstat = 0
  select case (stype)
  case ('CLEAN')
    if (.not.allocated(dclean)) then
      call map_message(seve%e,rname,'No Clean image')
      error = .true.
      return
    endif
    hstat => hclean
    plane = min(plane,hstat%gil%dim(3))
    dstat => dclean(:,:,plane)
  case ('DIRTY')
    if (.not.allocated(ddirty)) then
      call map_message(seve%e,rname,'No Dirty image')
      error = .true.
      return
    endif
    hstat => hdirty
    plane = min(plane,hstat%gil%dim(3))
    dstat => ddirty(:,:,plane)
  case ('RESIDUAL')
    if (.not.allocated(dresid)) then
      call map_message(seve%e,rname,'No Residual image')
      error = .true.
      return
    endif
    hstat => hresid
    plane = min(plane,hstat%gil%dim(3))
    dstat => dresid(:,:,plane)
  case ('SKY')
    if (.not.allocated(dsky)) then
      call map_message(seve%e,rname,'No Sky image')
      error = .true.
      return
    endif
    hstat => hsky
    plane = min(plane,hstat%gil%dim(3))
    dstat => dsky(:,:,plane)
  case ('CONTINUUM')
    if (.not.allocated(dcont)) then
      call map_message(seve%e,rname,'No Continuum image')
      error = .true.
      return
    endif
    hstat => hcont
    dstat => dcont
  case default
    if (sic_varexist(stype)) then
      !
      ! Statistic on any SIC Image variable
      call get_gildas(rname,stype,desc,htmp,error)
      if (error) return
      hstat => htmp
      ipstat = gag_pointer(desc%addr,memory)
    else
      call map_message(seve%e,rname,'Unkown image type '//trim(STYPE))
      error = .true.
      return
    endif
  end select
  !
  if (ipstat.eq.0) then
    hstat%loca%addr = locwrd(dstat)
    ipstat = gag_pointer(hstat%loca%addr,memory)
  endif
  !
  ! Local support
  nx = hstat%gil%dim(1)
  ny = hstat%gil%dim(2)
  !
  if (sic_present(o_whole,0)) then
    !    1) /WHOLE option
    !  - set all the support to .true. (ie compute stat on the whole image)
    do_whole = .true.
  elseif  (do_mask) then
    !  - Re-evaluate the Mask and List
    if (.not.allocated(d_mask)) then
      allocate(d_mask(nx,ny),d_list(nx*ny),stat=ier)
      if (ier.ne.0) then
        call map_message(seve%e,rname,'Error getting support memory')
        error = .true.
        return
      endif
    endif
    method%do_mask = .true.
    method%nlist = 0
    do_whole = .false.
    !!Print *,' DO_Mask ',do_mask,' Method Mask ',method%nlist
    !!Print *,' MASK ',hmask%loca%size
  else
    ! Re-use current List
    do_whole = (method%nlist.eq.0) 
    !!Print *,' DO_Whole ',do_whole,' Method list ',method%nlist
    !!Print *,' MASK ',hmask%loca%size
  endif
  !
  ! Avoid edges
  !! box = [nx/16,ny/16,15*nx/16,15*ny/16]
  edge = 1./16.
  call sic_r4(line,0,2,edge,.false.,error)
  box(1) = nint(nx*edge)
  box(2) = nint(ny*edge)
  box(3) = nx-box(1)+1
  box(4) = ny-box(2)+1
  !
  if (do_whole) then
    if (verbose) call map_message(seve%i,rname,'Using the whole image')
    if (sic_present(o_whole,1)) box = [1,1,nx,ny]
  else
    ! Re-compute the Mask from current Mask, Support or Box
    ! Default Box from BLC & TRC
    call check_box(nx,ny,method%blc,method%trc)
    method%box = (/method%blc(1),method%blc(2),method%trc(1),method%trc(2)/)
    ! call check_area(method,hstat,.true.)
    ! Print *,'Checking Mask ',method%do_mask
    ! Mask evaluation from List
    call check_mask(method,hstat)
    !!Print *,'Method list ',method%nlist, ' Box ',method%box
    box(1) = min(box(1),method%box(1))
    box(2) = min(box(2),method%box(2))
    box(3) = max(box(3),method%box(3))
    box(4) = max(box(4),method%box(4))
    !!Print *,'Support Type ',support_type,' Mask ',support_mask,' Poly ',support_poly
    if (verbose) then
      if (support_type.eq.support_mask) then
        call map_message(seve%i,rname,'Using current Mask')
      else if (support_type.eq.support_poly) then
        call map_message(seve%i,rname,'Using current Support')
      else
        call map_message(seve%i,rname,'Using default Box')
      endif
    endif
  endif
  !
  ! Compute stat
  if (do_whole) then
    call compute_stat(nx,ny,memory(ipstat),box,   &
       &    valmin,imin,jmin,valmax,imax,jmax,mean,rms,noise, &
       &    n_sup,n_off,hstat%gil%bval,hstat%gil%eval, &
       &    .false.,memory(ipstat))
  else
    call compute_stat(nx,ny,memory(ipstat),box,   &
       &    valmin,imin,jmin,valmax,imax,jmax,mean,rms,noise, &
       &    n_sup,n_off,hstat%gil%bval,hstat%gil%eval,        &
       &    .true.,d_mask)
  endif
  !
  call sic_delvariable ('STAT_NOISE',.false.,error)
  stat_noise = noise
  call sic_def_real ('STAT_NOISE',stat_noise,0,0,.false.,error)  
  !
  if (verbose) then
    write(6,101) 'Found ',n_sup,' pixels on, ',n_off,' off source'
    !
    ! Find the appropriate unit (Jy, mJy or microJy)
    if (noise.lt.1e-5) then
      scale = 1e6
      prefix = ' micro'//hstat%char%unit
    else if (noise.lt.0.01) then
      scale = 1e3
      prefix = ' m'//hstat%char%unit
    else
      scale = 1.0
      prefix = ' '//hstat%char%unit
    endif
    !
    ! If CLEAN or SKY image, compute total flux
    if (stype.eq.'CLEAN' .or. stype.eq.'SKY') then
      call get_jyperk(hstat,beam,jyperk)
      beam = beam/abs(hstat%gil%convert(3,1)*hstat%gil%convert(3,2))
      !
      if (jyperk*scale.gt.1e3) then
        uscale = 1e-3
        fixpre = 'mK'
      else
        uscale = 1
        fixpre = ' K'
      endif
      !
      write(6,1002) ' Map minimum at (',imin,jmin,') : ',valmin*scale, &
        prefix,valmin/jyperk*uscale,fixpre
      write(6,1002) ' Map maximum at (',imax,jmax,') : ',valmax*scale, &
        prefix,valmax/jyperk*uscale,fixpre
      !
      write(6,1003) ' RMS:       On-source:            ', rms*scale, &
        & trim(prefix),rms/jyperk*uscale,fixpre
      write(6,1003) ' RMS:      Off-source:            ', noise*scale, &
        trim(prefix), noise/jyperk*uscale,fixpre
      write(6,1003) ' RMS:         Thermal:            ', hstat%gil%noise*scale, &
        & trim(prefix), hstat%gil%noise/jyperk*uscale,fixpre
      !
      write(6,'(A,F8.1,A,F8.1)') ' Dynamic range: ',valmax/noise,  &
        & ' -- ',-3.0*valmax/valmin
      flux = (mean*n_sup)/beam
      write(6,104) 'Total flux in CLEAN map: ',flux*scale,trim(prefix)
      write(6,105) ' Tb scale for CLEAN map: 1 '//fixpre//' = ',   &
       &      jyperk*uscale*scale,trim(prefix)
      write(6,106) 'Clean Beam is ',   &
       &      hstat%gil%majo*sec,' x ',hstat%gil%mino*sec,   &
       &      ' sec at PA = ',hstat%gil%posa*180/pi,' deg'
      call sic_delvariable ('CLEANFLUX',.false.,error)
      call sic_def_real ('CLEANFLUX',flux,0,0,.false.,error)
      !
      ! Set the CLEAN rms to the Off source noise.
      hstat%gil%rms = noise
    else
      write(6,1002) ' Map minimum at (',imin,jmin,') : ',valmin*scale, prefix
      write(6,1002) ' Map maximum at (',imax,jmax,') : ',valmax*scale, prefix
      write(6,1003) ' RMS:       On-source:            ', rms*scale,trim(prefix)
      write(6,1003) ' RMS:      Off-source:            ', noise*scale,trim(prefix)
      write(6,1003) ' RMS:         Thermal:            ', hstat%gil%noise*scale,trim(prefix)
      !
      if (stype.eq.'DIRTY') hstat%gil%rms = noise
    endif
    !
  else
    ! /NOISE option
    call sic_ke(line,o_noise,1,var,n,.true.,error)
    if (error) return
    !! call sic_let_real(var,noise,error) !! That seems to work only for GLOBAL variables
    !
    call sic_descriptor(var,desc,found)  
    if (.not.found) then
      call map_message(seve%e,rname,'/NOISE variable does not exist')
      error = .true.
      return
    endif
    !
    ip = gag_pointer(desc%addr,memory)
    if (desc%type.eq.fmt_r4) then
      call r4tor4(stat_noise,memory(ip),1)
    else if (desc%type.eq.fmt_r8) then
      call r4tor8(stat_noise,memory(ip),1)
    else
      call map_message(seve%e,rname,'/NOISE variable must be Real or Double')
      error = .true.
      return
    endif
    !
  endif
  !
  !
  101   format (1x,a,i8,a,i8,a)
  104   format (1x,a,f9.3,a)
  105   format (1x,a,f8.3,a)
  106   format (1x,a,f7.3,a,f7.3,a,f5.0,a)
  1002  format (a,i6,',',i6,a,f10.3,a,f10.3,a)
  1003  format (A,0PF10.3,A,0PF10.3,A) 
  !
end subroutine statistic
!
subroutine compute_stat(nx,ny,amap,box, &
     &    valmin,imin,jmin,valmax,imax,jmax,mean,rms,noise,np,nn, &
     &    bval,eval, do_support, support)
  !--------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !    Statistics on image
  !--------------------------------------------------------------
  integer, intent(out) :: np, nn
  integer, intent(in) :: nx,ny
  real, intent(in) :: amap(nx,ny)
  integer, intent(out) :: imin, jmin, imax, jmax
  integer, intent(in) ::  box(4)
  real, intent(out) :: valmin, valmax, mean, rms, noise
  real, intent(in) :: bval, eval
  logical :: do_support
  logical, intent(in) :: support(nx,ny)
  !
  integer i,j,nb
  real val, mean2
  !
  valmin = 1e30                ! ??
  valmax = -1e30
  mean = 0.
  mean2 = 0.
  noise = 0.
  nn = 0
  np = 0
  nb = 0
  !
  if (eval.lt.0.) then
    if (do_support) then
      do i = box(1),box(3)
        do j = box(2),box(4)
          val = amap(i,j)
          if (support(i,j)) then
            np  = np+1
            mean = mean+val
            mean2 = mean2+val*val
            if (valmax.lt.val) then
              valmax = val
              imax = i
              jmax = j
            endif
            if (valmin.gt.val) then
              valmin= val
              imin = i
              jmin = j
            endif
          else
            nn = nn+1
            noise = noise+val*val
          endif
        enddo
      enddo
    else
      do i = box(1),box(3)
        do j = box(2),box(4)
          val = amap(i,j)
          mean = mean+val
          mean2 = mean2+val*val
          if (valmax.lt.val) then
            valmax = val
            imax = i
            jmax = j
          endif
          if (valmin.gt.val) then
            valmin= val
            imin = i
            jmin = j
          endif
        enddo
      enddo
      np  = (box(4)-box(2)+1)*(box(3)-box(1)+1)
    endif
  else
    ! With Blanking
    if (do_support) then
      do i = box(1),box(3)
        do j = box(2),box(4)
          val = amap(i,j)
          if (support(i,j)) then
            if (abs(val-bval).gt.eval) then
              np  = np+1
              mean = mean+val
              mean2 = mean2+val*val
              if (valmax.lt.val) then
                valmax = val
                imax = i
                jmax = j
              endif
              if (valmin.gt.val) then
                valmin= val
                imin = i
                jmin = j
              endif
            else
              nb = nb+1
            endif ! Blanking
          else
            if (abs(val-bval).gt.eval) then
              nn = nn+1
              noise = noise+val*val
            else
              nb = nb+1
            endif
          endif ! Support
        enddo
      enddo
    else
      do i = box(1),box(3)
        do j = box(2),box(4)
          val = amap(i,j)
          if (abs(val-bval).gt.eval) then
            mean = mean+val
            mean2 = mean2+val*val
            if (valmax.lt.val) then
              valmax = val
              imax = i
              jmax = j
            endif
            if (valmin.gt.val) then
              valmin= val
              imin = i
              jmin = j
            endif
            np = np+1
          else
            nb = nb+1
          endif
        enddo
      enddo
    endif
  endif
  !
  mean = mean/np
  mean2 = mean2/np
  rms = sqrt(mean2-mean*mean)
  if (nn.ne.0) then
    noise = sqrt(noise/nn)
  else
    noise = rms
  endif
end subroutine compute_stat
!
subroutine get_jyperk(hstat,beam,jyperk)
  use image_def
  !---------------------------------------------------------------------
  ! @ public
  !   Derive the Jy/beam conversion factor and Beam solid angle
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: hstat
  real, intent(out) :: jyperk
  real, intent(out) :: beam
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  real :: lambda
  !
  if (hstat%gil%reso_words.eq.0) then
    jyperk = 0
    beam = 0
  else
    beam = pi*hstat%gil%majo*hstat%gil%mino/4./log(2.0)
    lambda = 2.99792458e8/hstat%gil%freq*1e-6
    jyperk = 2.0*1.38023e3*beam/lambda**2.
  endif
end subroutine get_jyperk
