module use_continuum
  !TEST! logical :: debug=.false.
  integer, parameter :: code_hollow=1
  integer, parameter :: code_void=0 
  integer, parameter :: code_empty=-1
  integer, parameter :: code_ok=2
  integer, save :: i_the_method=1   !! Method
  real, save :: thremu=3.0      !! Rejection Threshold
  integer, save :: mcount=8     !! Maximum number of iterations
  real, save :: logwings=3.5    !! Gaussian threshold
  real, save :: clip_value=2.5  !! GLOBAL clipping value
  integer :: nhist              !! Histogram size
end module use_continuum
!
subroutine map_continuum(line,error)
  use use_continuum
  use image_def
  use clean_def
  use clean_default
  use clean_arrays
  use clean_types
  use gkernel_interfaces
  use imager_interfaces, except_this => map_continuum 
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Support for MAP_CONTINUUM  /METHOD command
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line    !! command line
  logical, intent(inout) :: error         !! Logical error flag
  !
  ! Constants 
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  character(len=*), parameter :: rname='MAP_CONTINUUM'
  integer, parameter :: o_the_method=1
  integer, parameter :: i_global=1
  integer, parameter :: i_gauss=2
  integer, parameter :: i_scm=3
  integer, parameter :: i_egm=4
  integer, parameter :: i_cscm=5
  integer :: i_hist=0
  integer, parameter :: mmeth=5
  character(len=8) :: vmeth(mmeth), cmeth
  data vmeth/'GLOBAL','GAUSS', 'SCM','EGM','C-SCM'/
  ! 
  ! Local ---
  integer :: imeth
  character(len=16) :: name
  character(len=80) :: chain
  integer :: n, nchan, ier, na
  integer(kind=index_length) :: dim(2), mhist
  type(gildas) :: hmap
  real, allocatable, target, save :: spectrum(:,:)
  real :: xsize, ysize, factor, cx, cy, rms
  real(8) :: funit
  integer :: imin,imax,jmin,jmax,i1,i2, box(4), nx,ny
  logical :: do_mask
  !
  ! Code ----
  call sic_delvariable('CONTINUUM',.false.,error)
  if (allocated(dcont)) deallocate(dcont)
  call sic_delvariable('CLIPPED',.false.,error)
  if (allocated(spectrum)) deallocate(spectrum)
  !
  error = .false.
  call gildas_null(hmap)
  call gildas_null(hcont)
  !
  name = 'CLEAN'
  call sic_ke(line,0,1,name,n,.false.,error)
  select case (name)
  case ('CLEAN')
    if (hclean%loca%size.eq.0) then
      call map_message(seve%e,rname,'No CLEAN data loaded')
      error = .true.
      return
    endif
    call gdf_copy_header(hclean,hmap,error)
    hmap%r3d => dclean
    ! Number of pixels per beam
    factor = abs(pi*hmap%gil%majo*hmap%gil%mino/hmap%gil%inc(1)/hmap%gil%inc(2))
  case ('SKY')
    if (hsky%loca%size.eq.0) then
      call map_message(seve%e,rname,'No SKY data loaded')
      error = .true.
      return
    endif
    call gdf_copy_header(hsky,hmap,error)
    hmap%r3d => dsky
    ! Number of pixels per beam
    factor = abs(pi*hmap%gil%majo*hmap%gil%mino/hmap%gil%inc(1)/hmap%gil%inc(2))
  case ('DIRTY')
    if (hdirty%loca%size.eq.0) then
      call map_message(seve%e,rname,'No DIRTY data loaded')
      error = .true.
      return
    endif
    call gdf_copy_header(hdirty,hmap,error)
    hmap%r3d => ddirty
    factor = 1.0
  case default
    call map_message(seve%e,rname,'Only work on CLEAN or DIRTY images')
    error = .true.
    return
  end select
  !
  if (sic_present(o_the_method,0)) then
    call sic_ke(line,o_the_method,1,name,na,.true.,error)
    if (error) return
    call sic_ambigs (rname,name,cmeth,imeth,vmeth,mmeth,error)
    if (error) return
    i_the_method = imeth
    call map_message(seve%w,rname,'Switching to the_method '//vmeth(i_the_method),3)
    select case(cmeth)
    case ('GLOBAL')
      ! /METHOD GLOBAL Clip Nhist
      clip_value = 2.5
      call sic_r4(line,o_the_method,2,clip_value,.false.,error)
      if (clip_value.lt.1.0 .or. clip_value.gt.5.0) then
        call map_message(seve%e,rname,'Clipping value outside of recommended [1-5] range')
        error = .true.
        return
      endif
      i_hist = 3  ! Size of histogram at end of argument list
    case ('GAUSS')
      ! /METHOD  GAUSS Clip Nhist Miter
      call sic_r4(line,o_the_method,2,logwings,.false.,error)
      if (error) return
      i_hist = 3
      call sic_i4(line,o_the_method,4,mcount,.false.,error)
      if (error) return
    case ('SCM','C-SCM')
      ! /METHOD SCM Clip Miter
      call sic_r4(line,o_the_method,2,thremu,.false.,error)
      if (error) return
      call sic_i4(line,o_the_method,3,mcount,.false.,error)
      if (error) return 
      i_hist = 5  ! No histogram needed.      
    case ('EGM')
      ! /METHOD EGM Clip Nhist Miter
      call map_message(seve%e,rname,'Method EGM not yet implemented',3)
      error = .true.
      return
    end select
  else  
    call map_message(seve%i,rname,'Using the_method '//vmeth(i_the_method))
  endif
  !
  ! Copy header to Continuum
  call gdf_copy_header(hmap,hcont,error)
  !
  ! Must have a conservative value of the noise, not just an arbitrary estimate
  rms = max(hmap%gil%noise, hmap%gil%rms)
  !
  ! Define continuum data
  hcont%gil%ndim = 2
  hcont%gil%dim(3) = 1
  allocate(dcont(hcont%gil%dim(1),hcont%gil%dim(2)), &
    &   spectrum(hmap%gil%dim(3),4),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  hcont%r2d => dcont
  !
  nchan = hmap%gil%dim(3)
  mhist = max(8,nint(sqrt(real(nchan))))
  mhist = min(mhist,32)
  mhist = max(8,mhist)
  nhist = mhist
  !
  call sic_i4(line,o_the_method,i_hist,nhist,.false.,error) 
  if (nchan.lt.32) then
    write(chain,'(A,I0,A)') 'Too few channels [',nchan,'], display only'
    call map_message(seve%w,rname,chain)
    nhist = 1
  else if (nhist.lt.8 .or. nhist.gt.max(8,nchan/8)) then
    write(chain,'(A,I0,A)') 'Histogram size out of allowed range [8-',nchan/8,']'
    call map_message(seve%e,rname,chain)
    error = .true.
    return
  else if (nhist.gt.mhist)  then
    write(chain,'(A,I0,A)') 'Histogram size out of recommended range [8-',mhist,']'
    call map_message(seve%w,rname,chain)
  endif
  ! 
  ! We use the mechanics of MASK and SUPPORT as in the STATISTIC command
  nx = hmap%gil%dim(1)
  ny = hmap%gil%dim(2)
  do_mask = the_method%do_mask  ! Bug before 25-Nov-2021
  !
  if (do_mask) then
    call copy_method(user_method,the_method)
    !
    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
      the_method%do_mask = .true.
      the_method%nlist = 0
    endif
    box = [nx,ny,1,1] 
    the_method%box = [nx,ny,1,1] 
    call check_area(the_method,hmap,.true.) ! Needed !...
    call check_mask(the_method,hmap)
    box(1) = min(box(1),the_method%box(1))
    box(2) = min(box(2),the_method%box(2))
    box(3) = max(box(3),the_method%box(3))
    box(4) = max(box(4),the_method%box(4))
    call map_message(seve%i,rname,'Using current support')
    !
    if (i_the_method.eq.i_global) then
      call global_continuum(hmap,hcont,spectrum,error,box,d_mask)
    else
      call local_continuum(i_the_method,hmap,hcont,spectrum,error, &
      & rms,box,d_mask)
    endif
    if (error) return  
  else
    call get_size_factor(funit)
    !
    xsize = area_size(1)*funit
    ysize = area_size(2)*funit
    !
    if (xsize.eq.0. .and. ysize.eq.0.) then
      box = [1,1,nx,ny]
    else
      call map_message(seve%i,rname,'Using current SIZE')
      cx = area_center(1)*funit
      cy = area_center(2)*funit
      !
      i1 = (cx-0.5*xsize-hmap%gil%val(1))/hmap%gil%inc(1) + hmap%gil%ref(1)
      i2 = (cx+0.5*xsize-hmap%gil%val(1))/hmap%gil%inc(1) + hmap%gil%ref(1)
      imin = min(i1,i2)
      imax = max(i1,i2)
      Print *,'IMIN ',imin,' IMAX ',imax
      imin = max(1,imin)
      i1 = (cy-0.5*ysize-hmap%gil%val(2))/hmap%gil%inc(2) + hmap%gil%ref(2)
      i2 = (cy+0.5*ysize-hmap%gil%val(2))/hmap%gil%inc(2) + hmap%gil%ref(2)
      jmin = min(i1,i2)
      jmax = max(i1,i2)
      jmin = max(1,jmin)
      Print *,'JMIN ',jmin,' JMAX ',jmax
      !
      imin = min(imin,hmap%gil%dim(1))
      imax = min(imax,hmap%gil%dim(1))
      jmin = min(jmin,hmap%gil%dim(2))
      jmax = min(jmax,hmap%gil%dim(2))
      !
      box(1) = imin
      box(2) = jmin
      box(3) = imax
      box(4) = jmax
    endif
    !
    if (i_the_method.eq.i_global) then
      call global_continuum(hmap,hcont,spectrum,error,box)
    else
      call local_continuum(i_the_method,hmap,hcont,spectrum,error, &
        & rms,box)
    endif
    if (error) return  
  endif
  !
  hcont%loca%addr = locwrd(hcont%r2d) 
  hcont%loca%size = hcont%gil%dim(1) * hcont%gil%dim(2)
  call gdf_get_extrema (hcont,error)
  !
  call sic_mapgildas('CONTINUUM',hcont,error,dcont)
  dim(1) = hmap%gil%dim(3)
  dim(2) = 4
  !
  ! Scale to Jy if possible (CLEAN data)
  if (factor.eq.0) factor = 1
  spectrum(:,2) = spectrum(:,2)/factor
  spectrum(:,3) = spectrum(:,3)/factor
  where(spectrum(:,4).ne.0) 
    spectrum(:,4) = 1.0
  end where
  call sic_def_real('CLIPPED',spectrum,2,dim,.false.,error)
  !
  call exec_program('@ p_continuum')   
  !
end subroutine map_continuum
!
subroutine global_continuum(hmap,hcont,spectrum,error,box,mask)
  !$ use omp_lib
  use use_continuum
  use image_def
  use gbl_message
  use gkernel_interfaces
  use imager_interfaces, except_this => global_continuum
  !---------------------------------------------------------------------
  ! @ public-mandatory
  !*
  !   IMAGER -- Support for MAP_CONTINUUM
  !
  !   The method is to find a global set of windows (along 3rd axis)
  !   based on the mean spectrum in a selected region (defined by 
  !   a mask), and to compute the continuum as the average
  !   of the "line-free" channels outside of these windows.
  !
  !     The method uses a space-invariant spectral map. The error
  !   map of the derived continuum is thus constant. The method may
  !   fail to find weak continuum sources in fields which contain
  !   bright, spectrally confused, sources 
  !!
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: hmap               !! Input line data cube
  type(gildas), intent(inout) :: hcont           !! Output continuum image
  real, intent(out) :: spectrum(:,:)             !! Output spectrum
  logical, intent(out) :: error                  !! Logical error flag
  integer(kind=4), intent(in) :: box(4)          !! Bounding box of mask
  logical, intent(in), optional :: mask(:,:)     !! Optional mask
  !
  character(len=*), parameter :: cname='MAP_CONTINUUM'
  !
  ! Local ---
  integer, allocatable :: mylines(:), oulines(:)
  real, pointer :: rmask(:,:)
  real :: blank, val
  integer :: nchan
  integer(kind=size_length) :: kxy,mhist, mchan
  integer :: nx,ny,ix,iy,ier,ic,kc,ib,nb,inb,iextent
  logical :: debug=.false.
  real(8) :: elapsed_s, elapsed_e, elapsed
  character(len=120) :: chain
  !
  ! Code ---
  elapsed_s = 0
  elapsed_e = 0
  error = .false.
  !
  nchan = hmap%gil%dim(3)
  mchan = nchan
  nx = hmap%gil%dim(1)
  ny = hmap%gil%dim(2)
  mhist = nhist
  !
  allocate(mylines(nchan),oulines(nchan),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,cname,'Memory allocation error')
    error = .true.
    return
  endif
  spectrum = 0.0
  do ic=1,nchan
    spectrum(ic,1) = (ic-hmap%gil%ref(3))*hmap%gil%vres + hmap%gil%voff
  enddo
  ! 
  if (hcont%gil%blan_words.ne.2 .or. hcont%gil%eval.lt.0) then
    !    
    ! We need to define a Blanking value outside of the range
    blank = minval(hmap%r3d)
    if (blank.gt.0) then
      hcont%gil%bval = -2.0*blank*nchan
      hcont%gil%eval = 0.0
    else if (blank.lt.0) then
      hcont%gil%bval = 3.0*blank*nchan
      hcont%gil%eval = 0.0
    else
      hcont%gil%bval = -1.0
      hcont%gil%eval = 0.0
    endif
  endif
  !
  ! Compute the mean spectrum
  !$ elapsed_s = omp_get_wtime()
  if (present(mask)) then
    !
    kxy = 0
    do iy=box(2),box(4)
      do ix=box(1),box(3)
        if (mask(ix,iy)) kxy = kxy+1
      enddo
    enddo
    !
    if (hmap%gil%eval.ge.0.0) then
      !$OMP PARALLEL DEFAULT(none)                 &
      !$OMP & SHARED(nchan,box,hmap,spectrum,mask) &
      !$OMP & PRIVATE(ix,iy,ic,val)
      !$OMP DO 
      do ic=1,nchan
        do iy=box(2),box(4)
          do ix=box(1),box(3)
            if (mask(ix,iy)) then
              val = hmap%r3d(ix,iy,ic)
              if (abs(val-hmap%gil%bval).gt.hmap%gil%eval) then
                spectrum(ic,2) = spectrum(ic,2) + val
              endif
            endif
          enddo
        enddo
      enddo
      !$OMP END DO
      !$OMP END PARALLEL
    else
      !$OMP PARALLEL DEFAULT(none)                 &
      !$OMP & SHARED(nchan,box,hmap,spectrum,mask) &
      !$OMP & PRIVATE(ix,iy,ic,val)
      !$OMP DO 
      do ic=1,nchan
        do iy=box(2),box(4)
          do ix=box(1),box(3)
            if (mask(ix,iy)) then
              val = hmap%r3d(ix,iy,ic)
              spectrum(ic,2) = spectrum(ic,2) + val
            endif
          enddo
        enddo
      enddo
      !$OMP END DO
      !$OMP END PARALLEL
    endif
  else
    if (all(box.eq.0)) then
      kxy = nx*ny
      ! This is in principle already parallelized
      do ic = 1,nchan
        call gr4_mean(hmap%r3d(:,:,ic),hmap%gil%dim(1)*hmap%gil%dim(2),  &
          & hmap%gil%bval,hmap%gil%eval,spectrum(ic,2)) 
      enddo
    else
      kxy = (box(4)-box(2)+1)*(box(3)-box(1)+1)
      !
      if (hmap%gil%eval.ge.0.0) then
        !$OMP PARALLEL DEFAULT(none)            &
        !$OMP & SHARED(nchan,box,hmap,spectrum) &
        !$OMP & PRIVATE(ix,iy,ic,val)
        !$OMP DO
        do ic=1,nchan
          do iy=box(2),box(4)
            do ix=box(1),box(3)
              val = hmap%r3d(ix,iy,ic)
              if (abs(val-hmap%gil%bval).gt.hmap%gil%eval) then
                spectrum(ic,2) = spectrum(ic,2) + val
              endif
            enddo
          enddo
        enddo
        !$OMP END DO
        !$OMP END PARALLEL
      else
        !$OMP PARALLEL DEFAULT(NONE)            &
        !$OMP & SHARED(nchan,box,hmap,spectrum) &
        !$OMP & PRIVATE(ix,iy,ic)
        !$OMP DO
        do ic=1,nchan
          do iy=box(2),box(4)
            do ix=box(1),box(3)
              spectrum(ic,2) = spectrum(ic,2) + hmap%r3d(ix,iy,ic)
            enddo
          enddo
        enddo
        !$OMP END DO
        !$OMP END PARALLEL
      endif
    endif
  endif
  !$  elapsed_e = omp_get_wtime()
  !$  elapsed = elapsed_e - elapsed_s
  !$  write(chain,'(a,f9.2,a)') 'Finished Building Spectrum ',elapsed
  !$  call map_message(seve%i,cname,chain)
  !
  spectrum(:,3) = spectrum(:,2)
  !
  if (nhist.gt.1) then
    !
    ! Find out the line free regions
    call clip_lineregions(cname,spectrum(:,3),mchan,mhist,  &
      & hcont%gil%bval,hcont%gil%eval,clip_value,debug,0.0,1.0)
    nb = 0
    call guess_lineregions(spectrum(:,3),mchan,       &
      & hcont%gil%bval,hcont%gil%eval,            &
      & mylines,nb)
    !
    ! Expand line regions by continuity
    inb = nb
    iextent = 8
    call clip_expand(hmap%gil%dim(3),mylines,inb,oulines,nb,iextent)
    !
    ! These are the line-contaminated channels
    do ib=1,nb
      spectrum(oulines(ib),4) = 1
    enddo
  endif
  !$  elapsed_e = omp_get_wtime()
  !$  elapsed = elapsed_e - elapsed_s
  !$  write(chain,'(a,f9.2,a)') 'Finished Defining Windows',elapsed
  !$  call map_message(seve%i,cname,chain)
  !
  ! Compute the continuum image 
  kc = 0
  do ic=1,nchan
    if (spectrum(ic,4).ne.0) cycle ! Skip the Line Contaminated channels
    kc = kc+1
    if (kc.eq.1) then
      hcont%r2d = hmap%r3d(:,:,ic)
    else
      rmask => hmap%r3d(:,:,ic)
      if (hmap%gil%eval.ge.0) then
        !$OMP PARALLEL SHARED(hcont,rmask,hmap) &
        !$OMP & PRIVATE(ix,iy)
        !$OMP DO COLLAPSE(2)
        do iy=1,hmap%gil%dim(2)
          do ix=1,hmap%gil%dim(1)
            if ((abs(rmask(ix,iy)-hmap%gil%bval).gt.hmap%gil%eval).and. &
            &   (abs(hcont%r2d(ix,iy)-hmap%gil%bval).gt.hmap%gil%eval) ) &
            & hcont%r2d(ix,iy) = hcont%r2d(ix,iy) + rmask(ix,iy)
          enddo
        enddo
        !$OMP END DO
        !$OMP END PARALLEL
      else
        !$OMP PARALLEL SHARED(hcont,rmask,hmap) &
        !$OMP & PRIVATE(ix,iy)
        !$OMP DO COLLAPSE(2)
        do iy=1,hmap%gil%dim(2)
          do ix=1,hmap%gil%dim(1)
            hcont%r2d(ix,iy) = hcont%r2d(ix,iy) + rmask(ix,iy)
          enddo
        enddo
        !$OMP END DO
        !$OMP END PARALLEL
      endif
    endif
  enddo
  !$  elapsed_e = omp_get_wtime()
  !$  elapsed = elapsed_e - elapsed_s
  !$  write(chain,'(a,f9.2,a)') 'Finished Computing Continuum',elapsed
  !$  call map_message(seve%i,cname,chain)
  !
  if (kc.ne.0) then
    where (abs(hcont%r2d-hcont%gil%bval).gt.hcont%gil%eval) hcont%r2d = hcont%r2d/kc
    hcont%gil%rms = hmap%gil%rms /sqrt(real(kc))
    hcont%gil%noise = hmap%gil%noise /sqrt(real(kc))
  endif
  !
  ! Return the number of pixels here. It will serve
  ! to normalize the spectrum after that.
  spectrum(:,4) = kxy*spectrum(:,4)
end subroutine global_continuum
!
subroutine local_continuum(i_code,hmap,hcont,spectrum,error,rms,box,mask)
  !$ use omp_lib
  use use_continuum
  use image_def
  use gbl_message
  use gkernel_interfaces
  use imager_interfaces, except_this => local_continuum
  !---------------------------------------------------------------------
  ! @ public-mandatory
  !*
  !   IMAGER --  Support for command  
  !     MAP_CONTINUUM /METHOD GAUSS|SCM|c-SCM [Threshold]
  !
  !     Support routine to derive the continuum image, pixel per pixel
  !   The noise is no longer space-invariant, but the the_method is able to
  !   identify weak continuum sources in the presence of strong, spectrally
  !   confused sources.
  !
  !
  !   Several methods are available:  
  !   -  A Gaussian fitting the_method   
  !     This method is a variant of the Sigma Clipping Median, 
  !   that works if there is no strong confusion. It avoids re-computing
  !   median (a slow operation) by taking into account that in this
  !   case, the mean value can be found by fitting a parabola 
  !   in the histogram of the channel values. The fit is made stable
  !   against outliers by adjusting the Min Max of the histogram
  !   so that the parabolic fit converges. 
  !     This is the the_method used in UV_PREVIEW
  !   
  !   -  SCM and c-SCM (corrected Sigma Clipping Median), as in 
  !      the CASA plugin STATCONT
  !
  !   -  That of Jordan Mollet et al 2018  
  !     Fit an Exponentially modified Gaussian function
  !     to the Histogram of intensity values for all channels. Still not
  !     implemented, though.
  !!
  !---------------------------------------------------------------------
  integer, intent(in) :: i_code           !! Code of the_method
  type(gildas), intent(in) :: hmap        !! Input line data cube
  type(gildas), intent(inout) :: hcont    !! Output continuum image
  real, intent(out) :: spectrum(:,:)      !! Output spectrum
  logical, intent(out) :: error           !! Logical error flag
  real, intent(in) :: rms                 !! Expected RMS (from theoretical noise)
  integer(kind=4), intent(in) :: box(4)   !! Bounding box of mask
  logical, intent(in), optional :: mask(:,:)    !! Optional mask
  !
  ! Constants
  real, parameter :: sec_to_rad = acos(-1.0)/3600/180
  integer, parameter :: max_count=4 ! < 8 for sure
  integer, parameter :: i_gauss=2, i_scm=3, i_egm=4, i_cscm=5
  character(len=*), parameter :: rname='GAUSS'
  !
  ! Local ---
  real, allocatable :: array(:,:), noises(:,:)
  real, allocatable :: temp(:), tmp(:)
  real, allocatable :: hist(:,:), logv(:), logf(:)
  integer :: ier, nx,ny,nc,ix,jy,jc
  integer :: nchan
  integer(kind=index_length) :: mchan
  !
  integer :: mloc(2), count, mhist, i, nxy, kc, mxy, next, percentage_step
  real :: a,b,c,d, amin, amax, arms, amed, aoff, mu, peak, sigma, val
  character(len=64) :: ch, mess
  !
  real :: bval, eval, blank, brms, crms, noise, tnoise
  logical :: goon, outside_mask
  logical :: debug, corrected, do_mask, gbl_error, old_debug
  !
  integer :: jmin,jmax, imin,imax, code
  integer :: ihollow, iout, ilong, inone, ndata, npos, nneg
  integer :: ithreads, mthreads
  logical :: omp_nested = .false.
  !
  ! Code ----
  mcount = 8
  call sic_get_inte('COUNTS',mcount,error)
  logwings = 3.5
  call sic_get_real('WINGS',logwings,error)
  !
  debug = .false.
  call sic_get_logi('DEBUG',debug,error)
  if ((i_code.eq.i_gauss).and.(.not.debug)) then
    call map_message(seve%w,rname,'Method GAUSS is still experimental, and may loop forever',1)
  endif
  !
  percentage_step = 10.
  nx = hmap%gil%dim(1)
  ny = hmap%gil%dim(2)
  nchan = hmap%gil%dim(3)
  mchan = nchan
  nc = hmap%gil%dim(3)
  !
  mhist = nhist 
  !
  allocate(array(nx,ny), noises(nx,ny), temp(nc), tmp(nc), hist(mhist,2), logv(mhist), logf(mhist), stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  !
  spectrum = 0.0
  do kc=1,nchan
    spectrum(kc,1) = (kc-hmap%gil%ref(3))*hmap%gil%vres + hmap%gil%voff
  enddo
  !
  ! RMS is the expected RMS noise
  ! We could check that it is actually reached outside of the
  ! area to be analyzed in a first pass..
  !
  imin = box(1)
  imax = box(3)
  jmin = box(2)
  jmax = box(4)
  !
  blank = hmap%gil%rmin
  if (blank.gt.0) then
    bval = -2.0*blank
    eval = blank
  else if (blank.lt.0) then
    bval = 3.0*blank
    eval = -blank
  else
    bval = -1.0
    eval = 0.0
  endif
  write(ch,'(A,1PG11.3,1X,1PG11.3)') '/BLANK ',bval,eval 
  !
  array = bval
  !
  i = 0
  nxy = 0
  ihollow = 0
  iout = 0
  ilong = 0
  inone = 0
  tnoise = 0.
  do_mask = present(mask)
  gbl_error = .false.
  mxy = (jmax-jmin+1)*(imax-imin+1)
  !
  next = imax-imin+1
  !$ mthreads = omp_get_max_threads()
  !$ ithreads = 1
  !$ call ompset_thread_nesting(rname, mthreads, ithreads, omp_nested)
  call progress_report('Computing',1,next,mxy,percentage_step)
  !
  !$OMP PARALLEL DEFAULT(NONE) &
  !$OMP & SHARED (hmap,array,noises,mask, spectrum, percentage_step) &
  !$OMP & SHARED (jmin,jmax,imin,imax,do_mask,nchan,i_code,bval,eval,thremu,rms) &
  !$OMP & SHARED (logwings, debug, nhist, mhist, mcount, mchan, ch, i, next) & 
  !$OMP & SHARED (mxy, nxy, ihollow, iout, ilong, inone, tnoise, gbl_error) &
  !$OMP & PRIVATE(val,amin,amax,arms,aoff,amed,goon,count,corrected,code, error) &
  !$OMP & PRIVATE(ix,jy,outside_mask,kc,jc,a,b,c,d,mu,sigma,mloc,noise) &
  !$OMP & PRIVATE(npos, nneg, ndata, peak, brms, crms) &
  !$OMP & PRIVATE(temp,tmp,hist,logv,logf, old_debug)
  !$OMP DO COLLAPSE(2) REDUCTION(+:ihollow,iout,ilong,inone,tnoise) 
  do jy=jmin,jmax
    do ix=imin,imax
      !$OMP CRITICAL 
      if (debug) Print *,'Start IX IY ',ix,jy,' Error ',gbl_error
      !! if (gbl_error) cycle
      !$OMP END CRITICAL
      !
      ! Test if inside or outside the mask
      outside_mask = .false.
      if (do_mask) then
        outside_mask = .not.mask(ix,jy)
      endif
      !
      ! Ignore if outside
      if (outside_mask) cycle
      !
      error = .false. 
      !
      ! Get the spectrum
      if (debug) Print *,'Getting new NXY at ',ix,jy
      temp(:) = hmap%r3d(ix,jy,:)
      noise = 0
      !
      ! increment the integrated spectrum "On-the-Fly"
      !$OMP CRITICAL
      nxy = nxy+1
      !$OMP END CRITICAL
      if (debug) Print *,'Got NXY ',nxy
      do kc=1,nchan
        val = hmap%r3d(ix,jy,kc)
        if (abs(val-hmap%gil%bval).gt.hmap%gil%eval) then
          spectrum(kc,2) = spectrum(kc,2) + val     ! Worry in Parallel mode, see GLOBAL code
        endif
      enddo
      !
      amed = 0
      !
      select case(i_code)
      case (i_gauss)
        old_debug = .false.
        noise = 0
        call medgauss (temp,nchan,bval,eval,aoff, &
          & debug,code,ndata,noise, rms)
        if (old_debug.neqv.debug) then
          Print *,'Debug change at ',ix,jy
        endif
        !
        !!Print *,'Code OK ',code,code_ok,' Aoff ',aoff
        if (code.eq.code_hollow) then
          ihollow = ihollow+1
          ndata = 0
          noise = 0
        else if (code.eq.code_void) then
          ndata = 0
          noise = 0
          inone = inone+1
        else if (code.eq.code_empty) then
          noise = 0
          ilong = ilong+1
        else
          ! Correct for the Offset
          amed = amed+aoff
          !
        endif
        if (noise.ne.noise) Print *,'NXY ',nxy,' NDATA ',ndata,' Noise ',noise,' Amed ',amed,' IX JY ',ix,jy,' Code ',code
      case (i_scm,i_cscm)
        !
        ! Define the Histogram range around the median
        goon = .true.
        brms = rms
        crms = 0.1*rms
        count = 0
        amed = 0
        do while (goon)
          call median_filter (temp,mchan,bval,eval,aoff,amin,amax,arms,thremu)
          if (debug) print *,' Amin ',amin,', Amax ',amax,', Aoff ',aoff,' RMS ',rms, arms
          goon = (amin.lt.amax)     ! Protect against fully constant data (0 in models...)
          goon = goon .and. abs(arms-brms).gt.crms
          brms = arms
          crms = 0.1*brms
          count = count+1
          if (count.gt.mcount) then
            ilong = ilong+1
            goon = .false.
          endif
          amed = amed+aoff
        enddo
        !
        ! Evaluate the noise on the continuum - How many data points ?
        temp(:) = hmap%r3d(ix,jy,:) - amed
        tmp = 0
        where(temp.gt.amax) tmp = 1.0
        npos = sum(tmp)
        tmp = 0
        where (temp.lt.amin) tmp = 1.0
        nneg = sum(tmp)
        ndata = nchan-npos-nneg
        noise = arms/sqrt(max(ndata-1.0,1.0))
        !
        ! Debias by % of Positive or Negative outliers
        if (i_code.eq.i_cscm) then
          tmp = 0
          where(temp.gt.arms) tmp = 1.0
          npos = sum(tmp)
          !
          tmp = 0
          where(temp.lt.-arms) tmp = 1.0
          nneg = sum(tmp)
          !
          if ( & 
            & ( (nneg.gt.0.33*ndata) .and. (npos.le.0.33*ndata) .and. ((nneg-npos).gt.0.25*ndata) ).or. &
            & ( (nneg.gt.0.33*ndata) .and. (npos.gt.0.33*ndata) .and. ((nneg-npos).gt.0.25*ndata) ) &
            & ) then
            ! Case A, absorption dominated 
            amed = amed+noise
          else if ( &
            & ( (nneg.gt.0.33*ndata) .and. (npos.le.0.33*ndata) .and. ((nneg-npos).le.0.25*ndata) ) &
            & ) then
            ! Case B, slightly absorption dominated
            amed = amed+0.5*noise
          else if ( &
            & ( (npos.gt.0.33*ndata) .and. (nneg.le.0.33*ndata) .and. ((npos-nneg).le.0.25*ndata) ) &
            & ) then
            ! Case C, slightly emission dominated
            amed = amed-0.5*noise
          else if ( & 
            & ( (npos.gt.0.33*ndata) .and. (nneg.le.0.33*ndata) .and. ((npos-nneg).gt.0.25*ndata) ).or. &
            & ( (npos.gt.0.33*ndata) .and. (nneg.gt.0.33*ndata) .and. ((npos-nneg).gt.0.25*ndata) ) &
            & ) then
            ! Case D, emission dominated
            amed = amed-noise
          endif
        endif
      case (i_egm)
        error = .true.
        amed = 0
      end select
      ! OK, we got the Histogram, now we can analyze it
      ! hist(:,2) are the values of flux in the various channels
      ! hist(:,1) are the number of channels with these values
      !
      ! Now we can fit the distribution by some analytic function
      ! to find out the most likely value, i.e. the "continuum" flux
      !
      ! Depending on the SkewNess, this function can be a Gaussian
      ! or a much more complex one
      if (amed.ne.amed)  then
        Print *,'NaN at ',ix,jy
        amed = 0
      endif
      array(ix,jy) = amed
      if (noise.eq.noise) then
        noises(ix,jy) = noise
        tnoise = tnoise+noise
      else
        Print *,'Invalid noise ',noise,' at ',ix,jy
      endif
      !
      if (sic_ctrlc()) error = .true.
      if (error) gbl_error = .true.
      !$OMP CRITICAL
!TEST!      if (debug) print *,'NXY ',nxy,' Next ',next,' MXY ',mxy
      call progress_report(' ',nxy,next,mxy,percentage_step)
!TEST!      if (debug) print *,'End progress report '
      !$OMP END CRITICAL
      if (debug) Print *,'End IX ',ix
    enddo ! IX
  enddo ! JY
  !$OMP END DO
  !$OMP END PARALLEL
  write(6,'(A)') '...  Done.'
  !
  ! Interpolate blanked pixels ?
  error = .false.
  hcont%r2d = 0
  where(array.ne.bval) hcont%r2d  = array
  hcont%gil%blan_words = 2
  !
  spectrum(:,3) = spectrum(:,2)
  spectrum(:,4) = 0
  !
  if (ihollow.ne.0) then
    write(mess,'(A,I0,A)') 'Corrected ',ihollow,' Pixels with hollow histograms'
    call map_message(seve%w,rname,mess,3)
  endif
  if (iout.ne.0) then
    write(mess,'(A,I0,A)') 'Corrected ',iout,' Pixels with out of range solutions'
    call map_message(seve%w,rname,mess,3)
  endif
  if (ilong.ne.0) then
    write(mess,'(A,I0,A)') 'Found ',ilong,' Pixels with non converged median'
    call map_message(seve%w,rname,mess,3)
  endif
  if (inone.ne.0) then
    write(mess,'(A,I0,A)') 'Found ',inone,' Pixels with no data'
    call map_message(seve%w,rname,mess,3)
  endif
  !
  hcont%gil%noise = hcont%gil%noise /sqrt(nchan-1.0)
  if (nxy.ne.0) then
    tnoise = tnoise/nxy
    hcont%gil%rms = tnoise
  else
    hcont%gil%rms = 0
  endif
  !
end subroutine local_continuum
!  
subroutine comp_r4_shape_blank (x,n,mean,rms,skew,vblank4,eblank4)
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private-mandatory 
  !*
  ! IMAGER --  Compute Mean, Rms and Skewness of an array  
  ! Protected against NaNs and Using Blanking Values. 
  !
  ! If Blanking is enabled, will return blanking value if no valid result. 
  ! If Blanking is not enabled, will return NaN if no valid result.
  !!
  !---------------------------------------------------------------------
  real(4),          intent(in)  :: x(*)  
  !! Input data values 
  integer(kind=size_length), intent(in)  :: n     
  !! Number of data values
  real(4),          intent(out) :: mean  
  !! Output mean value
  real(4),          intent(out) :: rms   
  !! Output root mean square
  real(4),          intent(out) :: skew  
  !! Output skewness 
  real(4),          intent(in)  :: vblank4 
  !! Blanking value
  real(4),          intent(in)  :: eblank4
  !! Blanking tolerance. If < 0, no blanking
  !
  ! Local
  integer(kind=size_length) :: i,count
  real(4) :: s0,s1,s2,y,z, num
  !
  !TEST!Print *,'N ',n,' Bval ',vblank4,eblank4
  mean = vblank4
  rms = 0.
  skew = 0.
  if (n.lt.1) return
  !
  s0 = 0.
  s1 = 0.
  s2 = 0.
  count = 0
  do i = 1,n
    if (x(i).eq.x(i)) then
      if (eblank4.ge.0) then
        if (abs(x(i)-vblank4).gt.eblank4) then
          s0 = s0+x(i)
          count = count+1
        endif
      else
        s0 = s0+x(i)
        count = count+1
      endif
    endif
  enddo
  if (count.gt.0) then
    s0 = s0/dble(count)
  else
    mean = vblank4
    return
  endif
  !
  ! Note philosophique: Count is the same in the 2 loops
  do i = 1,n
    if (x(i).eq.x(i)) then
      if (eblank4.lt.0) then
        y = x(i)-s0
        z = y*y
        s1 = s1 + z 
        s2 = s2 + z*y
      else
        if (abs(x(i)-vblank4).gt.eblank4) then
          y = x(i)-s0
          z = y*y
          s1 = s1 + z 
          s2 = s2 + z*y
        endif
      endif
    endif
  enddo
  num = real(count)
  s1 = s1/(num-1)
  rms = sqrt (s1)
  !
  s2 = s2/num
  ! Correct for sample size
  skew = s2/(rms*rms*rms)*sqrt(num*(num-1))/(num-2)
end subroutine comp_r4_shape_blank
!
function continuum_emg(x, amp, mu, sig, lamb)
  !! IMAGER -- Implementation of an Exponentially modified Gaussian function
  real(4) :: continuum_emg ! intent(out)
  real(4), intent(in) :: x
  ! Input value
  real(4), intent(in) :: amp 
  !! Amplitude of function
  real(4), intent(in) :: mu  
  !! Position
  real(4), intent(in) :: sig 
  !! Width
  real(4), intent(in) :: lamb 
  !! Exponential factor
  !
  continuum_emg = &
  & amp*exp(lamb*(2.*mu+lamb*sig*sig-2.*x)/2.)*(1.-erf((mu+lamb*sig*sig-x)/(sqrt(2.)*sig)))
end function continuum_emg
!
function continuum_gauss(x, amp, mu, sig)
  real(4) :: continuum_gauss ! intent(out)
  !! IMAGER -- Implementation of a Gaussian function 
  real(4), intent(in) :: x
  ! Input value
  real(4), intent(in) :: amp 
  !! Amplitude of function
  real(4), intent(in) :: mu  
  !! Position
  real(4), intent(in) :: sig 
  !! Width
  !
  continuum_gauss = amp*exp(-0.5*((x-mu)/sig)**2)
end function continuum_gauss
!
subroutine get_logv(logv,logwings,temp,nchan,hist,nhist,mcount,amin,amax,bval,eval)
  use gildas_def
  !-------------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Support for command MAP_CONTINUUM 
  !
  !   Derive the histogram of the intensity distribution
  !   and make sure its logarithm is suitable for Gaussian fitting 
  !   (i.e. of parabolic shape)
  !!
  !-------------------------------------------------------------------------
  integer, intent(in) :: nchan  
  !! Number of data points
  integer, intent(in) :: nhist                    
  !! Number of histogram bins
  real, intent(out) :: logv(nhist)                
  !! Log of bin contents
  real, intent(in) :: logwings                    
  !! Truncation threshold
  real, intent(in) :: temp(nchan)                 
  !! Data points
  real, intent(out) :: hist(nhist,2)              
  !! Histogram
  real, intent(out) :: amin, amax                 
  !! Range of selected values
  real, intent(in) :: bval             
  !! Blanking value
  real, intent(in) :: eval                  
  !! Blanking tolerance
  integer, intent(in) :: mcount                   
  !! Maximum number of loops
  !
  integer :: code                  ! Operation code
  !
  ! Derive histogram
  call my_histo44(temp,nchan,hist,nhist,2,amin,amax,bval,eval)  
  !
  ! Verify its shape
  code = 0
  call check_logv(logv,logwings,temp,nchan,hist,nhist,amin,amax,bval,eval,mcount,code)
end subroutine get_logv
!
subroutine check_logv(logv,logwings,temp,nchan,hist,nhist,amin,amax,bval,eval,mcount,code)
  use gildas_def
  !-------------------------------------------------------------------------
  ! @ private
  !   IMAGER
  !     Support for command MAP_CONTINUUM 
  !
  !   Make sure its logarithm of the Intensity distribution histogram
  !   is suitable for Gaussian fitting  (i.e. of parabolic shape)
  !   Re-adjust range and (optionally) recompute histogram if needed.
  !-------------------------------------------------------------------------
  integer, intent(in) :: nchan  
  !! Number of data points
  integer, intent(in) :: nhist                    
  !! Number of histogram bins
  real, intent(out) :: logv(nhist)                
  !! Log of bin contents
  real, intent(in) :: logwings                    
  !! Truncation threshold
  real, intent(in) :: temp(nchan)                 
  !! Data points
  real, intent(out) :: hist(nhist,2)              
  !! Histogram
  real, intent(out) :: amin, amax                 
  !! Range of selected values
  real, intent(in) :: bval             
  !! Blanking value
  real, intent(in) :: eval                  
  !! Blanking tolerance
  integer, intent(in) :: mcount                   
  !! Maximum number of loops
  integer, intent(inout) :: code                  
  !! Operation code
  !
  ! Local ---
  integer :: jh,lh,kh,nh,mloc(2), jcount
  real :: logbase, val
  !
  ! Code ----
  ! Protect against empty Histogram
  if (sum(hist(:,1)).eq.0) then
    code = -1
    return
  endif
  !TEST!  if (code.eq.0)  Print *,'Histogram ',sum(hist(:,1)),hist(:,1)
  !
  ! Verify Histogram shape - Ignore outliers beyond the main peak
  ! Log of a Gaussian is a parabola
  logv(:) = log(hist(:,1)+1.0)           ! Bias by 1 to avoid Log(0)
  logbase = maxval(logv)-logwings        ! Truncate wings
  where (logv.lt.logbase) logv=0.0
  !
  jcount = 1
  !
  do while (jcount.lt.2)
    mloc = maxloc(logv,1) 
    nh = mloc(1)
    kh = 1
    do jh=nh,1,-1
      if (logv(jh).eq.0) then
        kh = jh+1
        exit
      endif
    enddo
    lh = nhist
    do jh=nh,nhist,1
      if (logv(jh).eq.0) then
        lh = jh-1
        exit
      endif
    enddo
    !
    if (code.eq.0) then
!TEST!      Print *,'LOGV ',jcount,' KH ',kh,' LH ',lh
      if ((kh.gt.1) .or. (lh.lt.nhist)) then
        ! Histogram is too peaked,
        !   Restrict range to avoid outliers
        amin = hist(kh,2)
        amax = hist(lh,2)
!TEST!        Print *,'New Amin ',amin,' Amax ',amax
        call my_histo44(temp,nchan,hist,nhist,2,amin,amax,bval,eval)  
!TEST!        Print *,'Histo New Amin ',amin,' Amax ',amax
        logv(:) = log(hist(:,1)+1.0)           ! Bias by 1 to avoid Log(0)
        logbase = maxval(logv)-logwings        ! Truncate wings
        where (logv.lt.logbase) logv=0.0
        jcount = jcount+1
        if (jcount.eq.mcount) then
          if (any(logv.eq.0)) code = -1
          exit
        endif
      else 
        exit    ! Converged histogram
      endif
    else 
      if ((kh.eq.1).or.(lh.eq.nhist)) then 
        ! Histogram is too flat - Just extend range to a symmetric interval
        val = max(-amin,amax)
        amin = -val
        amax = val
        code = -1
        exit
      endif
      jcount = jcount+1
    endif
  enddo
  !
  if (kh.eq.lh) then
    ! 
    ! Keep 5 bins
    code = -1 
    kh = max(1,kh-2)
    lh = min(kh+5,nhist)
    amin = hist(kh,1)
    amax = hist(lh,1)
    !TEST! Print *,'Histogram ',hist(:,1)
    !TEST! read(5,*) amin,amax
  endif
  !
end subroutine check_logv
!
subroutine debug_plot(ix,jy,nhist,hist,logv,logf,nchan,temp, i, ch)
  use gildas_def
  use gkernel_interfaces
  !-------------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Debug routine for command MAP_CONTINUUM 
  !
  !   Create a graphic display of spectra whose noise distribution
  !   cannot be well fit by a Gaussian.
  !-------------------------------------------------------------------------
  integer, intent(in) :: ix,jy
  integer, intent(in) :: nhist
  integer, intent(in) :: nchan
  real, intent(in) :: temp(nchan)
  real, intent(in) :: hist(nhist,2), logv(nhist), logf(nhist)
  integer, intent(inout) :: i
  character(len=*) :: ch
  !
  character(len=64) :: st
  real(4) :: spec(nchan)
  integer :: j
  !
  do j=1,nchan
    spec(j) = j
  enddo
  call gr_exec('CLEAR')
  !
  call gr4_give('X',nchan,spec)
  call gr4_give('Y',nchan,temp)
  call gr_exec('SET BOX  16 26 4 18')
  call gr_exec('LIMITS '//ch)
  call gr_exec('BOX')
  call gr_exec('HISTO')
  !
  call gr_exec('SET BOX 4 12 4 18')  
  write(st,'(A,I0,A,I0,A)') '"IX ',ix,'  IY ',jy,'"'
  call gr4_give('X',nhist,hist(:,2))
  call gr4_give('Y',nhist,logv)
  call gr_exec('LIMITS')
  call gr_exec('BOX')
  call gr_exec('HISTO')
  call gr4_give('Y',nhist,logf)
  call gr_exec('CONNECT')
  call gr_exec('DRAW TEXT 0 1 '//trim(st)//' /CHAR 8') 
  if (i.eq.0) then
    write(*,*) 'Enter an integer to continue (0 Question, 1 Ignore next, -1 abort'
    read(5,*) i
  endif
end subroutine debug_plot
!
subroutine my_histo44(a,na,b,nb,mb,min,max,bval,eval)
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER -- Build an histogram of values
  !
  !   Perform computations in a temporary integer array since float
  ! values can not be incremented by 1 beyond a given limit (16777216.
  ! for REAL*4). Use INTEGER*8 because number of values per bin can be
  ! larger than 2**31-1.
  !---------------------------------------------------------------------
  integer :: na   
  !! Number of values
  real*4 :: a(na)                   
  !! Values
  integer(kind=4) :: nb  
  !! Number of bins
  integer(kind=4) :: mb  
  !! Number of columns in Histogram 
  real(4) :: b(nb,mb)                
  !! Histogram array: Column 2 bin value, Column 1 number of elements
  real(4) :: min                     
  !! Minimum value
  real(4) :: max                     
  !! Maximum value
  real(4) :: bval                    
  !! Blanking value
  real(4) :: eval                    
  !! Blanking tolerance
  !
  ! Local
  real(4) :: step,v,hmin,hmax
  integer(kind=size_length) :: l,n
  integer(kind=8), allocatable :: ib(:) 
  !
  step=(max-min)/(nb-1)
  if (step.le.0) return ! Avoid big issues
  !
  allocate(ib(nb))
  ib = 0.
  hmin=min-step/2.0
  hmax=max+step/2.0
  !
  if (eval.lt.0.0) then
    do l = 1,na
      if (a(l).eq.a(l)) then
        if (a(l).ge.min .and. a(l).le.max) then
          v = (a(l)-hmin)/step
          n=int(v)+1
          ib(n) = ib(n)+1
        endif
      endif
    enddo
  else
    do l = 1,na
      if (a(l).eq.a(l) .and. (abs(a(l)-bval).gt.eval)) then
        if (a(l).ge.min .and. a(l).le.max) then
          v = (a(l)-hmin)/step
          n=int(v)+1
          ib(n) = ib(n)+1
        endif
      endif
    enddo
  endif
  !
  ! Now fill the histogram: counts and bin definitions
  do l=1,nb
    b(l,1) = ib(l)
    b(l,2) = min+(l-1)*step
  enddo
end subroutine my_histo44
!
subroutine medgauss (temp,nchan,bval,eval,aoff,debug,code,ndata,noise, rms)
  use use_continuum
  use gkernel_interfaces
  use imager_interfaces, except_this => medgauss
  ! @ private
  integer, intent(in) :: nchan        
  !! Number of channels
  real, intent(inout) :: temp(nchan)  
  !! Input spectrum
  real, intent(in) :: bval
  !! Blanking value
  real, intent(in) :: eval      
  !! Blanking tolerance
  real, intent(inout) :: aoff         
  !! Fitted value
  logical, intent(in) :: debug
  !! Debug control
  integer, intent(out) :: code        
  !! Return code
  integer, intent(out) :: ndata       
  !! Number of used data
  real, intent(out) :: noise          
  !! Noise estimate
  real, intent(in) :: rms             
  !! Initial guess of RMS
  !
  integer, parameter :: max_count=3
  !
  ! Local ---
  integer(kind=index_length) :: mchan
  integer :: count, mloc(2)
  real :: peak, sigma, mu
  real :: a,b,c,d
  real :: amed, amin,amax,arms
  logical :: corrected, goon, error
  integer :: i, lcode
  integer :: ix,jy ! Debug
  ! These are small automatic arrays
  real :: hist(nhist,2)
  real :: logv(nhist), logf(nhist)
  !
  ! Code ----
  code = code_ok
  count = 0
  error = .false.
  mchan = nchan
  !
  ! Define the Histogram range around the median
  call median_filter (temp,mchan,bval,eval,aoff,amin,amax,arms,thremu)
  if (debug) print *,'#1 Amin ',amin,', Amax ',amax,', Aoff ',aoff,' RMS ',rms, arms
  goon = (amin.lt.amax)     ! Protect against fully constant data (0 in models...)
  if (.not.goon) then
    aoff = amin
    arms = 0
    code = code_void !
    ndata = 0
    sigma = 0
    return
  endif
  !        
  if (rms.ne.0) then
    ! Protect against High S/N lines with both negative and positive features
    ! and against very inaccurate initial rms...
    if (arms.gt.3*rms) then
      amin = max(-3.0*sqrt(rms*arms),amin)
      amax = -amin
      if (debug) print *,'#2 Corrected amin amax ',amin,amax
    endif
  endif
  !
  amed = (amin+amax)/2.0
  sigma = arms    ! Get some initialization
  !
  ! Compute the histogram of channel values 
  !   Fit this histogram with a Gaussian
  !
  !   another way is to compute the histogram between the true Min and Max,
  ! and eliminate the values that contain less than about a few % of 
  ! the channels to recompute another Min - Max. In other words, ignore
  ! the first N % on one side, the last N % on the other side, by
  ! having the cumulative count, where N = 3-5 or so.
  !
  !   We combine here both the_methods, by ensuring that the histograms has no "holes" 
  ! before fitting. That helps to make the code more robust, and still fast.
  !
  corrected = .false.   ! Assume the the_method will work
  do while (goon) 
    if (debug) print *,'Count ',count
    !
    ! Make the histogram betweeen the current Min Max
    call my_histo44(temp,nchan,hist,nhist,2,amin,amax,bval,eval)  
    !TEST!    if (debug) print *,'#3 Done my_histo44 ',count
    ! Check it has no hole
    lcode = 0
    call check_logv(logv,logwings,temp,nchan,hist,nhist,amin,amax,bval,eval,mcount,lcode)
    if (debug) print *,'Done check_logv ',count
    if (lcode.ne.0) then
      amed = (amin+amax)/2   ! Cannot guess anything else
      if (debug) print *,'#4 Hollow Histogram ',count
      noise = 0
      code = code_hollow
      return
    endif
    !
    ! Apply Caruana algorithm : the Log of a Gaussian is a Parabola
    ! The small bias does not affect the result too much
    call fit_parabola(nhist,hist(1:nhist,2),logv,a,b,c,d)
    !TEST!    if (debug) print *,'#5 Done fit_parabola ',count
    !
    ! Now back to Gaussian characteristics
    if (c.ge.0) then
      if (debug) print *,'#5 A B C D ',a,b,c,d
      ! Means out of bound, either too small (flat histogram) or to broad  (1 pixel histogram)
      ! This should no longer happens, but play safe.
      !TEST!print *,' A B C D ',a,b,c,d,' at ',ix,jy
      !TEST!print *,minval(hist(:1:mhist,2)), maxval(hist(:1:mhist,2)),  amin, amax
      !TEST!print *,hist(1:mhist,2)
      if (d.gt.0) then    ! Histogram is too narrow, restrict range
        mloc = maxloc(hist,1)
        mu = hist(mloc(1),2)
        if (debug) Print *,'#6 Peaky histogram Pixel ',ix,jy,' Solution ',mu,' out of ',amin,amax
        !
        sigma = (amax-amin)/4.0
      else                ! Histogram is flat... Should either extend range of use value
        mu = hist(1,2)
        if (debug) Print *,'#7 Flat histogram  Pixel ',ix,jy,' Solution ',mu,' out of ',amin,amax
        sigma = -(amax-amin)/4.0
      endif
      d = 1.0   ! Force it "not converged"
      peak = 1. ! To have a value
    else
      ! There is a solution
      mu = -b/(2.0*c)             ! Position
      sigma = sqrt(-1.0/(2.0*c))  ! Sigma
      peak = exp(a-b**2/(4.0*c))  ! Intensity (biased)
      if (debug) print *,'#8 Normal mu ',mu,sigma,peak, d
      goon =.false.
    endif
    !
    ! Out of bound fit ...
    corrected = .false.
    if ((mu.gt.amax).or.(mu.lt.amin)) then
      goon = .true.
      corrected = .true.
      code = 1
      if (debug) Print *,'#9 Check LOGV ',mu,' Amin ',amin,' Amax ',amax
      if (debug) call debug_plot(ix,jy,nhist,hist,logv,logf,nchan,temp, i, ' ')
      call check_logv(logv,logwings,temp,nchan,hist,nhist,amin,amax,bval,eval,2,code)
      if (code.ne.1) then
        count = count+1     ! Was iout...
        if (debug) Print *,'#10 Min  Max reset to ',amin,amax,maxval(hist(1:nhist,2)), ' IX JY ',ix,jy
      endif
    endif
    !
    ! Treat the confusion case: the Gaussian  peak should be close to the maximum 
    ! of the Histogram - if not, this must be line contamination
    if (debug) Print *,'#11 Peak ',log(peak),' MaxVal ',maxval(logv),' D ',d
    !
    ! Now get the "continuum" value
    amed = mu                   ! Define the position of maximum 
    if (count.ge.max_count) then
      ! MAX_COUNT iterations, this is too much...
      goon = .false.      
      exit 
    else if (d.gt.0.25 .or. log(peak).lt.maxval(logv)-d) then
      if (debug) Print *,'#11 D ',d,' Logs ',log(peak),' > ', maxval(logv)-d
      ! If not converged, the Maximum can be wrong - iterate
      mloc = maxloc(hist,1)
      amed = hist(mloc(1),2)
      if (.not.corrected) then
        amin = amed-3.0*sigma  
        amax = amed+3.0*sigma
      endif
      if (debug) Print *,'#12 ', count,': Min ',amin,' Median ',aoff,' Max ',amax,' Rms ',sigma
      count = count+1
    else
      ! Converged, fitted...
      goon = .false.
    endif
    if (corrected.and.debug) then
      if (.not.goon) then
        logf(:) = a+b*hist(:,2)+c*hist(:,2)**2
        !TEST!Print *,'Calling DEBUG_PLOT ',ix,jy,nhist
        call debug_plot(ix,jy,nhist,hist,logv,logf,nchan,temp, i, ' ')
        if (i.eq.-1) then
          error = .true.
        endif
      endif
    endif
  enddo   ! GOON
  ! Evaluate the noise
  ndata = sum(hist(1:nhist,1))
  if (ndata.gt.1) then
    noise = sigma/sqrt(ndata-1.0)
    code = code_ok
  else
    noise = 0
    code = code_empty
  endif
  !
end subroutine medgauss


