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] [/FILE FileName]
  !     [/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, or
  !     If the /FILE option is given, the work is done from an output file
  !!
  !----------------------------------------------------------------------
  character(len=*), intent(inout) :: line !! Command line
  logical, intent(out) :: error           !! Logical error flag
  !
  ! Constants
  real(8), parameter :: pi=3.14159265358979323846d0
  integer, parameter :: o_edge=1
  integer, parameter :: o_file=2
  integer, parameter :: o_noise=3
  integer, parameter :: o_update=4
  character(len=*), parameter :: rname = 'STATISTIC'
  character(len=8), parameter :: cnoise= 'NOISE   '
  character(len=8), parameter :: cextr = 'EXTREMA '
  !
  ! Local ---
  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
  character(len=filename_length) :: file
  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, idx, i, j
  integer :: my_blc(2), my_trc(2)
  integer(kind=size_length) :: n_sup, n_off
  character(len=24) :: prefix, postfix
  character(len=3) :: fixpre
  character(len=64) :: var
  character(len=80) :: chain
  character(len=42) :: short
  character(len=12) :: uunit
  real :: scale, uscale, edge
  real, save :: stat_noise = 0.0
  !
  type(sic_descriptor_t) :: desc
  logical :: found, verbose, is_avar, rdonly , do_extrema, do_sky, do_noise
  !
  type(c_ptr) :: cptr
  real, pointer :: r
  real(8), pointer :: d
  real(4), pointer :: a_mask(:,:,:)
  real(4), target :: null_mask(1,1,1)
  logical :: old_fit, old_plot
  !
  ! Code ---
  sec = 180*3600/pi
  ! Save DO_MASK
  do_mask = the_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
  do_sky = .false.
  !
  ! 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  
  !
  do_noise = sic_present(o_noise,1)
  if (do_noise) then
    call sic_ke(line,o_noise,1,var,n,.true.,error)
    if (error) return
  endif
  !
  ! Avoid edges
  ! ! 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.le.0).or.(edge.gt.1)) then
    call map_message(seve%e,rname,'Invalid Edge value, must be in [0,1[')
    error = .true.
    return
  endif
  !
  ! 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
    do_sky = .not.sic_present(o_noise,2)
  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_present(o_file,0)) then
      ! /FILE option
      call sic_ch(line,0,1,file,n,.true.,error)
      call gildas_null(htmp)
      call sic_parse_file (file,' ','.gdf',htmp%file)
      call gdf_read_header(htmp,error)
      if (error) return
      !
      if (htmp%gil%dim(4).gt.1) then
        call map_message(seve%e,rname,'/FILE option only valid for 2D or 3D data')
        error = .true.
        return
      endif
      htmp%blc(3) = max(1,min(ipfirst,htmp%gil%dim(3)))
      if (iplast.eq.0) then
        htmp%trc(3) = htmp%gil%dim(3)
      else
        htmp%trc(3) = min(htmp%gil%dim(3),iplast)
      endif
      if (htmp%blc(3).gt.htmp%trc(3)) then
        call map_message(seve%e,rname,'Invalid plane range')
        error = .true.
        return
      endif
      !
      hstat => htmp
      !
      allocate(dstat(hstat%gil%dim(1),hstat%gil%dim(2),hstat%gil%dim(3)),stat=ier)
      if (ier.ne.0) then
        call map_message(seve%e,rname,'/FILE memory allocation failure')
        error = .true.
        return
      endif
      call gdf_read_data(htmp,dstat,error)
      !
      ipfirst = 0
      iplast  = 0
      hstat%blc = 0
      hstat%trc = 0
    else 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 SIC image or Buffer '//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
  if (.not.sic_present(o_file,0)) then
    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
    endif
    if (sic_lire().eq.0) call map_message(seve%i,rname,'Using '//chain)
  else 
    if (sic_lire().eq.0) call map_message(seve%i,rname,'Using file '//file)
  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_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 if (support_type.eq.support_mask) then
    if (verbose) call map_message(seve%i,rname,'Using current Mask')
    a_mask => dmask
  else if (support_type.eq.support_poly) then
    if (verbose)  call map_message(seve%i,rname,'Using current Support')
    ! Mask evaluation from Polygon if any
    call check_mask(the_method,hstat)
    if (allocated(d_mask)) then
      allocate(a_mask(nx,ny,1),stat=ier)
      a_mask = 0
      where (d_mask) a_mask(:,:,1) = 1.
    else
      a_mask => null_mask
    endif
  else
    my_blc = user_method%blc
    my_trc = user_method%trc
    call check_box(nx,ny,my_blc,my_trc)
    if (verbose) then
      write(chain,'(A,X,I0,X,I0,A,X,I0,X,I0)') 'Using default Box: BLC', &
      & my_blc,'; TRC ',my_trc
      call map_message(seve%i,rname,chain)
    endif
    allocate(a_mask(nx,ny,1),stat=ier)
    a_mask = 0
    do j=my_blc(2),my_trc(2)
      do i=my_blc(1),my_trc(1)
        a_mask(i,j,1) = 1.0
      enddo
    enddo
  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
  !
  ! Clean up the local mask
  if (support_type.eq.support_mask) then
    nullify (a_mask)
  else if (associated(a_mask,null_mask)) then
    nullify (a_mask)
  else
    deallocate(a_mask,stat=ier)
  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)  
  !
  ! Update STAT_NOISE if a SKY image is handled...
  if (do_sky) then
    old_plot = noise_plot
    old_fit = noise_fit
    noise_type = 0
    noise_plot = .false.
    noise_fit = .true.
    call exec_program('@ p_view_noise SKY stat_noise')
    noise_plot = old_plot
    noise_fit = old_fit
    noise = stat_noise
  endif
  !
  if (verbose) then
    write(*,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
    !
    ! Compute Total Flux if possible
    jyperk = 0
    uunit = hstat%char%unit
    call sic_upper(uunit)
    if (uunit.eq.'JY/BEAM') call get_jyperk(hstat,beam,jyperk)
    !
    if (jyperk.ne.0) then
      !
      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(*,1002) ' Map minimum at (',imin,jmin,kmin,') : ',valmin*scale, &
        & prefix,valmin/jyperk*uscale,fixpre
      write(*,1002) ' Map maximum at (',imax,jmax,kmax,') : ',valmax*scale, &
        & prefix,valmax/jyperk*uscale,fixpre
      !
      write(*,1003) ' RMS:       On-source:                   ', rms*scale, &
        & trim(prefix),rms/jyperk*uscale,fixpre
      write(*,1003) ' RMS:      Off-source:                   ', noise*scale, &
        & trim(prefix), noise/jyperk*uscale,fixpre
      write(*,1003) ' RMS:         Thermal:                   ', hstat%gil%noise*scale, &
        & trim(prefix), hstat%gil%noise/jyperk*uscale,fixpre
      !
      write(*,'(A,F8.1,A,F8.1)') ' Dynamic range: ',valmax/noise,  &
        & ' -- ',-3.0*valmax/valmin
      write(*,105) ' Tb scale for '//trim(stype)//' map: 1 '//fixpre//' = ',   &
        &      jyperk*uscale*scale,trim(prefix)
      write(*,106) 'Clean Beam is ',   &
        &      hstat%gil%majo*sec,' x ',hstat%gil%mino*sec,   &
        &      ' sec at PA = ',hstat%gil%posa*180/pi,' deg'
      !
      flux = (mean*n_sup)/beam
      if (flux.gt.1) then
        scale = 1.0
        prefix = ' '//hstat%char%unit 
      endif
      idx = index(prefix,'/')
      if (idx.eq.0) then
        idx = len_trim(prefix)
      else
        idx = idx-1
      endif
      postfix = ' '
      if ((nv.gt.1).and.(hstat%gil%faxi.ne.0)) then
        scale = scale*abs(hstat%gil%inc(hstat%gil%faxi))
        if (hstat%char%code(hstat%gil%faxi).eq.'VELOCITY') then
          postfix = '.km/s'
        else if (hstat%char%code(hstat%gil%faxi).eq.'FREQUENCY') then
          postfix = '.MHz'
        endif
      endif
      write(*,104) 'Total flux in '//trim(stype)//' map: ',flux*scale,trim(prefix(1:idx))//postfix
      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
    else
      ! Figure out the expected intensity range
      if (valmax*scale.gt.1E5) then
        write(short,1002) ' Map minimum at (',imin,jmin,kmin,') : '
        write(*,*) short,valmin*scale, prefix
        write(short,1001) ' Map maximum at (',imax,jmax,kmax,') : '
        write(*,*) short,valmax*scale, prefix
        write(*,*) ' RMS:       On-source:                   ', rms*scale,trim(prefix)
        write(*,*) ' RMS:      Off-source:                   ', noise*scale,trim(prefix)
        write(*,*) ' RMS:         Thermal:                   ', hstat%gil%noise*scale,trim(prefix)
      else
        write(*,1002) ' Map minimum at (',imin,jmin,kmin,') : ',valmin*scale, prefix
        write(*,1002) ' Map maximum at (',imax,jmax,kmax,') : ',valmax*scale, prefix
        write(*,1003) ' RMS:       On-source:                   ', rms*scale,trim(prefix)
        write(*,1003) ' RMS:      Off-source:                   ', noise*scale,trim(prefix)
        write(*,1003) ' RMS:         Thermal:                   ', hstat%gil%noise*scale,trim(prefix)
      endif
      !
      if (stype.eq.'DIRTY') hstat%gil%rms = noise
    endif
    !
  else if (do_noise) then
    ! /NOISE option
    ! 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
  !
  ! To be checked... What happens if working on a file ?
  !
  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)
  1001  format (a,i6,',',i6,',',i6,a,f10.3,a,f10.3,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-mandatory
  !*
  ! IMAGER -- Support for command STATISTIC
  !
  !    Compute 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
  real, intent(in), optional :: support(:,:,:)   !! 3-D support
  !
  integer(kind=size_length) :: i,j,k,l,nb
  real(8) :: val, mean1, mean2, meano
  real, allocatable :: valmin(:), valmax(:)
  integer, allocatable :: imin(:), jmin(:), kmin(:)
  integer, allocatable :: imax(:), jmax(:), kmax(:)
  integer :: nm,it,nt, jt(1)
  logical :: do_support
  !
  do_support = present(support)
  if (do_support) then
    nm = ubound(support,3)
  else
    nm = 0
  endif
  !
  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,nm,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,l,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)
            l = min(nm,k)
            val = amap(i,j,k)
            if (support(i,j,l).ne.0) 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,nm,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,l,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)
            l = min(nm,k)
            val = amap(i,j,k)
            if (support(i,j,l).ne.0) 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
  !*
  ! IMAGER -- Utility routine
  !
  !   Derive the Jy/beam conversion factor and Beam solid angle
  !!
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: hstat  !! Data header
  real, intent(out) :: jyperk        !! Conversion from K to Jy
  real, intent(out) :: beam          !! Beam solid angle
  !
  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
