subroutine statistic (line,error)
  use gkernel_interfaces
  use gkernel_types
  use imager_interfaces, except_this=>statistic
  use clean_def
  use clean_arrays
  use clean_default
  use clean_types
  use clean_support
  use gbl_message
  use iso_c_binding
  !----------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !     Support for command
  !   STATISTIC Image [PlaneStart PlaneEnd] [/EDGE Edge] [/NOISE Variable]
  !     [/UPDATE [NOISE|EXTREMA]]
  !
  !     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...) or any SIC Image variable
  ! 
  !----------------------------------------------------------------------
  character(len=*), intent(inout) :: line
  logical, intent(out) :: error
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  integer, parameter :: o_edge=1
  integer, parameter :: o_noise=2
  integer, parameter :: o_update=3
  !
  type (gildas), pointer :: hstat
  type (gildas), target :: htmp
  real, pointer :: dstat(:,:,:)
  integer ier, ipfirst, iplast, na, nx, ny, nz, nv
  character(len=12) argum,stype
  logical do_mask, do_whole, do_update
  real valmin, valmax, mean, rms, noise, beam, flux, sec, jyperk
  integer imin, imax, jmin, jmax, kmin, kmax, box(4), n
  integer(kind=size_length) :: n_sup, n_off
  character(len=4) :: rname = 'STAT'
  character(len=24) :: prefix
  character(len=3) :: fixpre
  character(len=64) :: var
  character(len=80) :: chain
  real :: scale, uscale, edge
  real, save :: stat_noise = 0.0
  !
  type(sic_descriptor_t) :: desc
  logical :: found, verbose, is_avar, rdonly , do_extrema
  character(len=8) :: cnoise='NOISE'
  character(len=8) :: cextr='EXTREMA'
  !
  type(c_ptr) :: cptr
  real, pointer :: r
  real(8), pointer :: d
  logical, pointer :: a_mask(:,:)
  logical, target :: null_mask(1,1)
  !
  sec = 180*3600/pi
  ! Save DO_MASK
  do_mask = user_method%do_mask
  verbose = .not.sic_present(o_noise,0)
  do_update = sic_present(o_update,0)
  if (do_update) then
    argum = 'NOISE'
    call sic_ke(line,o_update,1,argum,na,.false.,error)
    error = .true.
    if (na.le.8) then
      if (argum(1:na).eq.cnoise(1:na)) then
        do_extrema = .false.
        error = .false.
      else if (argum(1:na).eq.cextr(1:na)) then
        do_extrema = .true.
        error = .false.
      endif
    endif
    if (error) then
      call map_message(seve%e,rname,'Invalid keyword '//argum(1:na)//' for option /UPDATE')
      return
    endif
  else
    do_extrema = .false.
  endif
  !
  ! Type of image (default = last_shown)
  !
  argum = last_shown
  call sic_ke (line,0,1,argum,na,.false.,error)
  stype = argum
  !
  ! Plane
  ipfirst = 0
  call sic_get_inte ('FIRST',ipfirst,error)
  call sic_i4(line,0,2,ipfirst,.false.,error)
  if (error) return
  iplast = ipfirst
  call sic_i4(line,0,3,iplast,.false.,error)
  if (error) return  
  !
  ! Allocate memory
  is_avar = .false.
  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
    dstat => dclean
  case ('DIRTY')
    if (.not.allocated(ddirty)) then
      call map_message(seve%e,rname,'No Dirty image')
      error = .true.
      return
    endif
    hstat => hdirty
    dstat => ddirty
  case ('RESIDUAL')
    if (.not.allocated(dresid)) then
      call map_message(seve%e,rname,'No Residual image')
      error = .true.
      return
    endif
    hstat => hresid
    dstat => dresid
  case ('SKY')
    if (.not.allocated(dsky)) then
      call map_message(seve%e,rname,'No Sky image')
      error = .true.
      return
    endif
    hstat => hsky
    dstat => dsky
  case ('CONTINUUM')
    if (.not.allocated(dcont)) then
      call map_message(seve%e,rname,'No Continuum image')
      error = .true.
      return
    endif
    hstat => hcont
    cptr = c_loc(dcont)
    hstat%gil%dim(3) = 1
    CALL C_F_POINTER(CPTR, DSTAT, hstat%gil%dim(1:3) )    
  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
      call i8toi8(desc%addr,cptr,1)
      CALL C_F_POINTER(CPTR, DSTAT, desc%dims(1:3) )
      !
      is_avar = associated(desc%head)
    else
      call map_message(seve%e,rname,'Unkown image type '//trim(STYPE))
      error = .true.
      return
    endif
  end select
  !
  if (do_extrema) then
    hstat%loca%addr = locwrd(dstat)
    call gdf_get_extrema(hstat,error)
    return
  endif
  !
  ! Local support
  nx = hstat%gil%dim(1)
  ny = hstat%gil%dim(2)
  nz = max(1,hstat%gil%dim(3)) 
  !
  if (ipfirst.eq.0) ipfirst = 1
  ipfirst = min(nz,ipfirst)
  if (iplast.gt.0) then
    iplast = min(nz,iplast)
  else
    iplast = nz+iplast
  endif
  write(chain,'(A,I0,A,I0,A)') 'plane range [',ipfirst,'-',iplast,']'
  if (iplast.lt.ipfirst) then
    call map_message(seve%e,rname,'Invalid '//chain)
    error = .true.
    return
  else if (sic_lire().eq.0) then
    call map_message(seve%i,rname,'Using '//chain)  
  endif
  !
  ! Avoid edges
  do_whole =.false.
  !! box = [nx/16,ny/16,15*nx/16,15*ny/16]
  edge = 1./16.
  call sic_r4(line,o_edge,1,edge,.false.,error)
  if (edge.eq.0) then
    do_whole = .true.
  else if (edge.gt.0 .and. edge.lt.1) then
    box(1) = nint(nx*edge)
    box(2) = nint(ny*edge)
    box(3) = nx-box(1)+1
    box(4) = ny-box(2)+1
  else
    call map_message(seve%e,rname,'Invalid Edge value, must be in [0,1[')
    error = .true.
    return
  endif
  !
  if (do_mask.and.(.not.do_whole)) then
    !  - Re-evaluate the Mask and List
    ier = 0
    if (.not.allocated(d_mask)) then
      allocate(d_mask(nx,ny),d_list(nx*ny),stat=ier)
    else if (nx.ne.ubound(d_mask,1) .or. ny.ne.ubound(d_mask,2)) then
      deallocate (d_mask,d_list)
      allocate(d_mask(nx,ny),d_list(nx*ny),stat=ier)
    endif
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Error getting support memory')
      error = .true.
      return
		endif
    method%do_mask = .true.
    method%nlist = 0
    !!Print *,' DO_Mask ',do_mask,' Method Mask ',method%nlist
    !!Print *,' MASK ',hmask%loca%size
  else if (.not.do_whole) then
    ! 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
  !
  if (do_whole) then
    if (verbose) call map_message(seve%i,rname,'Using the whole image')
    a_mask => null_mask
    box = [1,1,nx,ny]    ! Must be initialized properly
  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
    a_mask => d_mask
  endif
  !
  ! Compute stat
  nv = iplast-ipfirst+1
  if (do_whole) then
    call compute_stat(nx,ny,nv,dstat(:,:,ipfirst:iplast), & ! memory(ipstat)
       &    box,valmin,imin,jmin,kmin,valmax,imax,jmax,kmax, & 
       &    mean,rms,noise, &
       &    n_sup,n_off,hstat%gil%bval,hstat%gil%eval)
  else
    call compute_stat(nx,ny,nv,dstat(:,:,ipfirst:iplast), & ! memory(ipstat)
       &    box,valmin,imin,jmin,kmin,valmax,imax,jmax,kmax, & 
       &    mean,rms,noise, &
       &    n_sup,n_off,hstat%gil%bval,hstat%gil%eval, &
       &    a_mask)
  endif
  !
  ! Return values 
  if (do_update) then
    hstat%gil%rmax = valmax
    hstat%gil%rmin = valmin
    hstat%gil%minloc(1:3) = [imin,jmin,kmin+ipfirst-1]
    hstat%gil%maxloc(1:3) = [imax,jmax,kmax+ipfirst-1]
    hstat%gil%rms = noise
    !
    if (is_avar) then
      rdonly = desc%readonly
      desc%readonly = .false.
      call gdf_copy_header(hstat,desc%head,error)
      desc%readonly = rdonly
    endif
  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
    select case(stype) 
    case ('CLEAN','SKY','CONTINUUM') 
      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,kmin,') : ',valmin*scale, &
        prefix,valmin/jyperk*uscale,fixpre
      write(6,1002) ' Map maximum at (',imax,jmax,kmax,') : ',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 '//trim(stype)//' map: ',flux*scale,trim(prefix)
      write(6,105) ' Tb scale for '//trim(stype)//' 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 ('TOTAL_FLUX',.false.,error)
      call sic_def_real ('TOTAL_FLUX',flux,0,0,.false.,error)
      !
      ! Set the CLEAN rms to the Off source noise.
      hstat%gil%rms = noise
    case default
      write(6,1002) ' Map minimum at (',imin,jmin,kmin,') : ',valmin*scale, prefix
      write(6,1002) ' Map maximum at (',imax,jmax,kmax,') : ',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
    end select
    !
  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
    !
    if (desc%type.eq.fmt_r4) then
      call adtoad(desc%addr,cptr,1)
      call c_f_pointer(cptr,r)
      r = stat_noise
    else if (desc%type.eq.fmt_r8) then
      call adtoad(desc%addr,cptr,1)
      call c_f_pointer(cptr,d)
      d = stat_noise
    else
      call map_message(seve%e,rname,'/NOISE variable must be Real or Double')
      error = .true.
      return
    endif
    !
  endif
  !
  !
  101   format (1x,a,i0,a,i0,a)
  104   format (1x,a,f10.4,a)
  105   format (1x,a,f9.4,a)
  106   format (1x,a,f7.3,a,f7.3,a,f5.0,a)
  1002  format (a,i6,',',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,nv,amap,box, &
     &    vmin,ipmin,jpmin,kpmin,vmax,ipmax,jpmax,kpmax, &
     &    mean,rms,noise,np,nn, &
     &    bval,eval, support)
  use gildas_def
  !$ use omp_lib
  !--------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !    Statistics on image
  !--------------------------------------------------------------
  integer(kind=size_length), intent(out) :: np ! Number of source data points
  integer(kind=size_length), intent(out) :: nn ! Number of empty sky data points
  integer, intent(in) :: nx,ny,nv     ! Image size
  real, intent(in) :: amap(nx,ny,nv)  ! Input data cube
  integer, intent(out) :: ipmin, jpmin, kpmin  ! Position of Min
  integer, intent(out) :: ipmax, jpmax, kpmax  ! Position of Max
  integer, intent(in) ::  box(4)      ! 2-D subset being considered 
  real, intent(out) :: vmin, vmax     ! Min Max
  real, intent(out) :: mean, rms, noise  ! Statistic values
  real, intent(in) :: bval, eval      ! Blanking values
  logical, intent(in), optional :: support(:,:)  ! 2-D support
  !
  integer(kind=size_length) :: i,j,k,nb
  real(8) :: val, mean1, mean2, meano
  real, allocatable :: valmin(:), valmax(:)
  integer, allocatable :: imin(:), jmin(:), kmin(:)
  integer, allocatable :: imax(:), jmax(:), kmax(:)
  integer :: it,nt, jt(1)
  logical :: do_support
  !
  do_support = present(support)
  !
  nt = 1
  !$ nt = omp_get_max_threads()
  allocate(valmin(nt),valmax(nt),imin(nt),imax(nt), &
  & jmin(nt),jmax(nt),kmin(nt),kmax(nt))
  !
  valmin(:) = huge(0.)                ! Large enough
  valmax(:) = -valmin
  mean1 = 0.
  mean2 = 0.
  meano = 0.
  nn = 0
  np = 0
  nb = 0
  !
  it = 1
  !
  if (eval.lt.0.) then
    if (do_support) then
      !
      !$OMP PARALLEL DEFAULT(none)  &
      !$OMP & SHARED(nv,box,amap,support)  &
      !$OMP & REDUCTION(+:np,nn,mean1,mean2,meano) &
      !$OMP & SHARED(valmin,imin,jmin,kmin,valmax,imax,jmax,kmax) &
      !$OMP & PRIVATE(it,i,j,k,val)
      !$ it = omp_get_thread_num()+1
      !$OMP DO COLLAPSE(3)
      do k = 1,nv
        do j = box(2),box(4)
          do i = box(1),box(3)
            val = amap(i,j,k)
            if (support(i,j)) then
              np  = np+1
              mean1 = mean1+val
              mean2 = mean2+val*val
              if (valmax(it).lt.val) then
                valmax(it) = val
                imax(it) = i
                jmax(it) = j
                kmax(it) = k
              endif
              if (valmin(it).gt.val) then
                valmin(it) = val
                imin(it) = i
                jmin(it) = j
                kmin(it) = k
              endif
            else
              nn = nn+1
              meano = meano+val*val
            endif
          enddo
        enddo
      enddo
      !$OMP END DO
      !$OMP END PARALLEL
    else
      !$OMP PARALLEL DEFAULT(none)  &
      !$OMP & SHARED(nv,box,amap)   &
      !$OMP & REDUCTION(+:mean1,mean2)  &
      !$OMP & SHARED(valmin,imin,jmin,kmin,valmax,imax,jmax,kmax) &
      !$OMP & PRIVATE(it,i,j,k,val)
      !$ it = omp_get_thread_num()+1
      !$OMP DO COLLAPSE(3)
      do k = 1,nv
        do j = box(2),box(4)
          do i = box(1),box(3)
            val = amap(i,j,k)
            mean1 = mean1+val
            mean2 = mean2+val*val
            if (valmax(it).lt.val) then
              valmax(it) = val
              imax(it) = i
              jmax(it) = j
              kmax(it) = k
            endif
            if (valmin(it).gt.val) then
              valmin(it) = val
              imin(it) = i
              jmin(it) = j
              kmin(it) = k
            endif
          enddo
        enddo
      enddo
      !$OMP END DO
      !$OMP END PARALLEL
      np  = (box(4)-box(2)+1)*(box(3)-box(1)+1)*nv
    endif
  else
    ! With Blanking
    if (do_support) then
      !$OMP PARALLEL DEFAULT(none) &
      !$OMP & SHARED(nv,box,amap,support,bval,eval) &
      !$OMP & REDUCTION(+:np, nn,nb,mean1,mean2,meano) &
      !$OMP & SHARED(valmin,imin,jmin,kmin,valmax,imax,jmax,kmax) &
      !$OMP & PRIVATE(it,i,j,k,val)
      !$ it = omp_get_thread_num()+1
      !$OMP DO COLLAPSE(3)
      do k=1,nv
        do j = box(2),box(4)
          do i = box(1),box(3)
            val = amap(i,j,k)
            if (support(i,j)) then
              if (abs(val-bval).gt.eval) then
                np  = np+1
                mean1 = mean1+val
                mean2 = mean2+val*val
                if (valmax(it).lt.val) then
                  valmax(it) = val
                  imax(it) = i
                  jmax(it) = j
                  kmax(it) = k
                endif
                if (valmin(it).gt.val) then
                  valmin(it) = val
                  imin(it) = i
                  jmin(it) = j
                  kmin(it) = k
                endif
              else
                nb = nb+1
              endif ! Blanking
            else
              if (abs(val-bval).gt.eval) then
                nn = nn+1
                meano = meano+val*val
              else
                nb = nb+1
              endif
            endif ! Support
          enddo ! i
        enddo ! j 
      enddo ! k
      !$OMP END DO
      !$OMP END PARALLEL
    else
      !$OMP PARALLEL DEFAULT(none) &
      !$OMP & SHARED(nv,box,amap,bval,eval) &
      !$OMP & REDUCTION(+:np,mean1,mean2,nb) &
      !$OMP & SHARED(valmin,imin,jmin,kmin,valmax,imax,jmax,kmax) &
      !$OMP & PRIVATE(it,i,j,k,val)
      !$ it = omp_get_thread_num()+1
      !$OMP DO COLLAPSE(3)
      do k=1,nv
        do j = box(2),box(4)
          do i = box(1),box(3)
            val = amap(i,j,k)
            if (abs(val-bval).gt.eval) then
              mean1 = mean1+val
              mean2 = mean2+val*val
              if (valmax(it).lt.val) then
                valmax(it) = val
                imax(it) = i
                jmax(it) = j
                kmax(it) = k
              endif
              if (valmin(it).gt.val) then
                valmin(it) = val
                imin(it) = i
                jmin(it) = j
                kmin(it) = k
              endif
              np = np+1
            else
              nb = nb+1
            endif
          enddo
        enddo
      enddo
      !$OMP END DO
      !$OMP END PARALLEL
    endif
  endif
  !
  ! Reduce the Min-Max now
  jt = minloc(valmin)
  it = jt(1)
  ipmin = imin(it)
  jpmin = jmin(it)
  kpmin = kmin(it)
  vmin = valmin(it)
  jt = maxloc(valmax)
  it = jt(1)
  ipmax = imax(it)
  jpmax = jmax(it)
  kpmax = kmax(it)
  vmax = valmax(it)
  !
  mean1 = mean1/real(np)
  mean2 = mean2/real(np)
  rms = sqrt(mean2-mean1*mean1)
  if (nn.ne.0) then
    noise = sqrt(meano/nn)
  else
    noise = rms
  endif
  mean = mean1
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
