subroutine uv_preview(line,error)
  use image_def
  use gkernel_interfaces
  use gkernel_types
  use imager_interfaces, except_this => uv_preview
  use gbl_message
  use clean_arrays
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Support for command
  !   UV_PREVIEW   [/FILE UvData.uvt]
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  ! Global
  character(len=*), parameter :: rname='UV_PREVIEW'
  integer, parameter :: o_file=1
  !
  ! Local
  type(gildas) :: hfile
  integer :: n
  character(len=filename_length) :: name
  logical :: do_insert
  !
  do_insert = sic_lire().eq.0
  error = .false.
  call sic_delvariable('SPECTRUM',.false.,error)
  call sic_delvariable('CLIPPED',.false.,error)
  call sic_delvariable('CHANNEL_LIST',.false.,error)
  call sic_delvariable('PREVIEW',.false.,error)
  !
  if (sic_present(o_file,0)) then
    ! /FILE option
    call gildas_null(hfile,type='UVT')
    call sic_ch(line,o_file,1,name,n,.true.,error)
    if (error) return
    call sic_parse_file(name,' ','.uvt',hfile%file)
    !
    call gdf_read_header(hfile,error)
    if (error) return
    hfile%loca%size = 0
    !
    call uv_preview_sub(hfile,line,error)
    !
  else
    if (huv%loca%size.eq.0) then
      call map_message(seve%e,rname,'No UV data loaded')
      error = .true.
      return
    endif
    huv%r2d => duv
    call uv_preview_sub(huv,line,error)
  endif
  !
  if (error) return
  if (do_insert) call sic_insert_log(line)
  !
end subroutine uv_preview
!
subroutine uv_preview_sub (huv,line,error)
  use image_def
  use gkernel_interfaces
  use gkernel_types 
  use imager_interfaces, except_this => uv_preview_sub
  use gbl_message
  !$ use omp_lib
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Support for command
  !   UV_PREVIEW   [/FILE UvData.uvt]
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  type(gildas), intent(inout) :: huv
  !
  ! Global
  include 'gbl_memory.inc'
  character(len=*), parameter :: rname='UV_PREVIEW'
  ! Local
  character(len=80) :: chain
  character(len=message_length) :: mess
  integer(kind=4) :: ntaper
  integer(kind=index_length) :: nvisi, nchan
  type (gildas), save :: htab, hclip 
  integer(kind=index_length) :: nhist, mhist, lc
  integer :: it,jc,kc,jv,kr,kw,ier
  real :: wtot, rtot, ww, rr, uvmin, uvmax, blank, wsum, rms
  real :: tapermin, tapermax, tapercurrent, tapersquare, taperfactor
  integer :: ib,nb,ksum, fchan, lchan
  real, allocatable :: uv(:), taper(:), wall(:), wreal(:), wplus(:), vtaper(:)
  real, allocatable :: weights(:,:), poids(:,:,:), spec(:,:,:)
  real, pointer :: clip_data(:)
  integer, allocatable, save :: mylines(:)
  integer, allocatable :: kplus(:)
  integer :: mvisi,nt, ithread, nthread
  real :: clip_value, correlation_factor, rmsdiff, rmstheo 
  real :: amed, amin, amax, noise_ratio, ctaper
  logical :: debug=.false.
  !
  ! Common beam identification if any
  integer :: irange(2),krange,mrange,i
  integer, allocatable :: ranges(:)
  integer(kind=address_length) :: jpr
  type(sic_descriptor_t) :: desc
  logical found
  !
  ! EDGE_FREQUENCIES
  real(kind=8) :: tmp 
  real(kind=8), allocatable, save :: edge_freq(:,:) 
  integer, allocatable, save :: edge_chan(:,:) 
  integer :: nlines
  integer(kind=index_length) :: dim(4)
  !
  call sic_get_logi('DEBUG',debug,error)
  !
  if (associated(htab%r2d)) deallocate(htab%r2d)
  if (associated(hclip%r2d)) deallocate(hclip%r2d)
  if (allocated(mylines)) deallocate(mylines)
  if (allocated(edge_freq)) deallocate(edge_freq,edge_chan)
  !
  nvisi = huv%gil%nvisi
  !
  ntaper = 4
  call sic_i4(line,0,1,ntaper,.false.,error)
  if (ntaper.lt.1 .or. ntaper.gt.10) then
    call map_message(seve%e,rname,'Number of tapers out of range 1-10')
    error = .true.
    return
  endif
  !
  clip_value = 3.5
  call sic_r4(line,0,2,clip_value,.false.,error)
  if (clip_value.lt.1.0 .or. clip_value.gt.7.0) then
    call map_message(seve%e,rname,'Clipping value outside of recommended [1-7] range')
    error = .true.
    return
  endif
  !
  fchan = 0 ! Offset for channel numbers
  lchan = huv%gil%nchan
  if (huv%loca%size.eq.0 .and. lchan.gt.40) then    
    ! Drop 5 % at each edge
    fchan = huv%gil%nchan/20
    lchan = 19*fchan
  endif
  write(mess,'(A,I0,A,I0,A)') 'Selecting channel range [',fchan+1,',',lchan,']'
  call map_message(seve%i,rname,mess)
  !
  ! If UV_CHECK BEAM has been used, 
  ! restrict the range to the most significant (bad edge recognition)
  call sic_descriptor('BEAM_RANGES',desc,found)
  if (found) then
    jpr = gag_pointer(desc%addr,memory)
    allocate(ranges(desc%dims(2)),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation error')
      error = .true.
      return
    endif
    do i=1,desc%dims(2)
      call i4toi4(memory(jpr+2*(i-1)),irange,2)
      ranges(i) = irange(2)-irange(1)
    enddo
    mrange = 0
    do i=1,desc%dims(2)  
      if (ranges(i).gt.mrange) then
        mrange = ranges(i)
        krange = i
      endif
    enddo
    !
    ranges(krange) = 0 ! hide the largest range
    if (any(ranges.gt.mrange/2)) then
      call map_message(seve%w,rname,'More than 2 significant beam regions')
    else
      call i4toi4(memory(jpr+2*(krange-1)),irange,2)
      fchan = irange(1)
      lchan = irange(2)
      write(chain,'(A,I0,A,I0,A,I0,A)') 'Channel range restricted to [',fchan,',',lchan, &
        & '] from BEAM_RANGES[',krange,']'
      call map_message(seve%i,rname,chain)
    endif  
  endif
  !
  nchan = lchan-fchan
  ! Default histogram size (after NCHAN definition)
  mhist = max(8,nint(sqrt(real(nchan))))
  nhist = max(8,mhist)
  call sic_i8(line,0,3,nhist,.false.,error) 
  !
  if (nchan.eq.1) then
    write(chain,'(A,I0,A)') 'Single channel, no possible preview'
    call message_colour(1)
    call map_message(seve%w,rname,chain)
    call message_colour(-1)
    return
  else if (nchan.le.32) then
    write(chain,'(A,I0,A)') 'Too few channels [',nchan,'], display only'
    call message_colour(1)
    call map_message(seve%w,rname,chain)
    call message_colour(-1)
    nhist = 1
  else if (nhist.lt.8) then
    write(chain,'(A,I0,A,I0,A)') 'Histogram size ',nhist,' out of recommended range [8-',mhist,']'
    call map_message(seve%e,rname,chain)
    error = .true.
    return
  else if (nhist.gt.mhist)  then
    write(chain,'(A,I0,A,I0,A)') 'Histogram size ',nhist,' out of recommended range [8-',mhist,']'
    call map_message(seve%w,rname,chain)
  endif
  ! 
  call gildas_null(htab)
  call gdf_copy_header(huv,htab,error)
  !
  htab%gil%ndim = 2
  htab%gil%dim(1) = nchan
  htab%gil%dim(2) = ntaper+2
  !
  allocate(htab%r2d(nchan,ntaper+2),wplus(ntaper),kplus(ntaper), &
    & wall(ntaper),wreal(nchan),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  !
  ! Define the Tapers here
  if (huv%loca%size.ne.0) then
    allocate(uv(nvisi),taper(nvisi),stat=ier)
    uv(:) = huv%r2d(1,1:nvisi)**2 + huv%r2d(2,1:nvisi)**2
    if (huv%gil%basemax.eq.0 .or. huv%gil%basemin.eq.0) then
      uvmax = 0.0
      uvmin = 1e36
      do jv=1,huv%gil%nvisi
        ww = uv(jv) 
        if (ww.gt.0.0) then
          uvmax = max(uvmax,ww)
          uvmin = min(uvmin,ww)
        endif
      enddo
      if (uvmin.gt.uvmax) uvmin = uvmax
      huv%gil%basemax = sqrt(uvmax)
      huv%gil%basemin = sqrt(uvmin)
    endif
    tapermax = huv%gil%basemax
    if (huv%gil%nteles.ge.1) then
      tapermin = 3*max(huv%gil%teles(1)%diam,huv%gil%basemin)
    else
      tapermin = 3*huv%gil%basemin
    endif
  else if (huv%gil%basemax.eq.0) then
    call map_message(seve%w,rname,'No Baseline extrema, can only guess tapers')
    tapermax = 1000.0
    tapermin = 45.0
  else
    tapermax = huv%gil%basemax
    if (huv%gil%nteles.ge.1) then
      tapermin = 3*max(huv%gil%teles(1)%diam,huv%gil%basemin)
    else
      tapermin = 3*huv%gil%basemin
    endif
  endif
  taperfactor = log(tapermax/tapermin)/(ntaper-1)/log(2.0)
  tapercurrent = tapermax
  mess = 'Taper values: [ None'
  nt = len_trim(mess)+1
  !
  allocate(vtaper(ntaper),stat=ier)
  !
  vtaper(1) = 0.
  do it=2,ntaper
    tapercurrent = tapercurrent/2.0**taperfactor
    vtaper(it) = tapercurrent
    write(mess(nt:),'(A,F8.1)') ',',tapercurrent
    nt = nt+9
  enddo
  mess(nt:nt)=']'
  call map_message(seve%i,rname,mess(1:nt))
  ! 
  ! Initialize X Axis
  htab%r2d = 0.0
  do jc=1,nchan
    htab%r2d(jc,1) = (jc+fchan-huv%gil%ref(1))*huv%gil%vres + huv%gil%voff
  enddo
  !
  ! Compute various spectra
  !
  if (huv%loca%size.ne.0) then
    tapercurrent = tapermax
    !
    do it = 1, ntaper
      if (it.eq.1) then
        taper = 1.0
      else
        tapercurrent = tapercurrent/2.0**taperfactor
        tapersquare = tapercurrent**2        
        taper(:) = exp(-uv(:)/tapersquare)
      endif
      ksum = 0
      wsum = 0
      !$OMP PARALLEL DEFAULT(none)  &
      !$OMP & SHARED (fchan,nchan,nvisi,htab,huv,taper,it,ntaper) &
      !$OMP & PRIVATE (kr,kw,wtot,rtot,rr,ww,jc,jv) &
      !$OMP & REDUCTION(+:wsum,ksum) 
      !$OMP DO
      do jc = 1,nchan
        kr = 5 + 3*(jc+fchan)
        kw = 7 + 3*(jc+fchan) 
        wtot = 0
        rtot = 0
        do jv = 1,nvisi
          ww = huv%r2d(kw,jv) * taper(jv)
          if (ww.gt.0.0) then
            rr = huv%r2d(kr,jv) * ww
            wtot = wtot+ww
            rtot = rtot+rr
          endif
        enddo
        !
        ! This is a channel average - Ksum counts the number of channels
        if (wtot.gt.0) then
          htab%r2d(jc,it+1) = rtot/wtot
          if (it.eq.1) then
            htab%r2d(jc,ntaper+2) = wtot
          endif
          ksum = ksum+1
          wsum = wsum+wtot
        endif 
        !
      enddo
      !$OMP END DO
      !$OMP END PARALLEL
      wplus(it) = wsum
      !
      ! Estimate the RMS noise for each taper
      wall(it) = wsum/ksum
    enddo
  else
    ! Shift the reference channel by Fchan
    htab%gil%ref(1) = htab%gil%ref(1)-fchan
    !
    ! Define blocking factor, on largest data file
    mvisi = imager_nitems(huv,1) ! Visibilities at once
    mvisi = min(mvisi,huv%gil%dim(2))
    ! Allocate spaces for each array
    allocate(huv%r2d(huv%gil%dim(1),mvisi),weights(nchan,ntaper),stat=ier)
    if (ier.ne.0) then
      write(mess,*) 'Memory allocation error ',huv%gil%dim(1), mvisi
      call map_message(seve%e,rname,mess)
      error = .true.
      return
    endif
    !
    wplus = 0.
    kplus = 0
    weights = 0.0
    !
    ! Loop on blocks
    nthread = 1
    !$ nthread = omp_get_max_threads()
    allocate(spec(nchan,ntaper,nthread),poids(nchan,ntaper,nthread),stat=ier)
    if (ier.ne.0) then
      write(mess,*) 'Memory allocation error ',nchan,ntaper,nthread
      call map_message(seve%e,rname,mess)
      error = .true.
      return
    endif
    !
    do ib=1,huv%gil%nvisi,mvisi
      !
      ! Read the data
      write(mess,*) ib,' / ',huv%gil%dim(2),mvisi
      call map_message(seve%i,rname,mess)
      huv%blc(2) = ib
      huv%trc(2) = min(huv%gil%nvisi,ib-1+mvisi)
      nvisi = huv%trc(2)-huv%blc(2)+1
      call gdf_read_data(huv,huv%r2d,error)
      if (error) return
      !
      ! On this block, increment the htab array
      !
      spec = 0.
      poids = 0.
      !$OMP PARALLEL DEFAULT(none)  &
      !$OMP & SHARED (fchan,nchan,nvisi,htab,huv,vtaper,ntaper,poids,spec) &
      !$OMP & PRIVATE (kr,kw,rr,ww,jc,jv,it,ctaper,ithread) 
      ithread = 1
      !$ ithread = omp_get_thread_num()+1      
      !$OMP DO
      do jv = 1,nvisi
        do it = 1,ntaper
          if (it.eq.1) then
            ctaper = 1.0
          else
            ctaper = exp(-(huv%r2d(1,jv)**2 + huv%r2d(2,jv)**2)/vtaper(it)**2)
          endif
          !
          do jc = 1,nchan
            kw = 7 + 3*(jc+fchan)   ! Weight            
            ww = huv%r2d(kw,jv) * ctaper
            if (ww.gt.0.0) then
              poids(jc,it,ithread) = poids(jc,it,ithread) + ww
              kr = 5 + 3*(jc+fchan)   ! Real part
              rr = huv%r2d(kr,jv) * ww
              ! I need to fix that in Parallel mode with Temporary arrays...
              spec(jc,it,ithread) = spec(jc,it,ithread) + rr
            endif
          enddo
        enddo
      enddo
      !$OMP END DO
      !$OMP END PARALLEL
      !
      do ithread=1,nthread
        do it=1,ntaper
          do jc=1,nchan
            htab%r2d(jc,it+1) = htab%r2d(jc,it+1) + spec(jc,it,ithread)
          enddo
          do jc=1,nchan
            weights(jc,it) = weights(jc,it) + poids(jc,it,ithread)
          enddo
        enddo
      enddo
      !
      ! next block
    enddo
    !
    deallocate(spec,poids,stat=ier)
    !
    ! Final reduction of Weights and Spectrum
    wplus = 0.0
    ksum = 0
    do jc = 1,nchan
      if (weights(jc,1).ne.0) then
        ksum = ksum+1
        wplus(1) = wplus(1) + weights(jc,1)
      endif
    enddo
    do it = 2,ntaper
      do jc = 1,nchan
        wplus(it) = wplus(it) + weights(jc,it)
      enddo
    enddo
    !
    ! Normalize to get the correct spectrum
    htab%r2d(:,ntaper+2) = weights(:,1)  ! Natural weights
    do it=1,ntaper
      do jc=1,nchan
        htab%r2d(jc,it+1) = htab%r2d(jc,it+1) / weights(jc,it) 
      enddo
    enddo
    !
    ! Estimate the RMS noise for each taper
    do it=1,ntaper
      wall(it) = wplus(it)/ksum
    enddo
  endif
  ! Print noise estimate
  wall = 1e-3/sqrt(wall)    ! Units are Jy and MHz
  rmstheo = wall(1)
  call prnoise(rname,'Natural',rmstheo,rms)
  !
  ! We need to define a Blanking value outside of the range
  blank = minval(htab%r2d)
  if (blank.gt.0) then
    htab%gil%bval = -2.0*blank
    htab%gil%eval = blank
  else if (blank.lt.0) then
    htab%gil%bval = 3.0*blank
    htab%gil%eval = -blank
  else
    htab%gil%bval = -1.0
    htab%gil%eval = 0.0
  endif
  do it=2,ntaper+1
    where (htab%r2d(:,ntaper+2).eq.0) htab%r2d(:,it) = htab%gil%bval
  enddo
  !
  call sic_mapgildas('SPECTRUM',htab,error,htab%r2d)
  call sic_defstructure('PREVIEW',.true.,error)
  !
  ! Clip them to compute the histograms
  if (nhist.gt.1) then
    wall(2:ntaper) = 0.0
    !
    ! Evaluate the channel correlation factor and/or noise scaling factor
    it = 2
    lc = 0
    do jc=1,nchan-1
      kc = jc+1
      if (htab%r2d(jc,ntaper+2).ne.0 .and. htab%r2d(kc,ntaper+2).ne.0) then
        lc = lc+1
        wreal(lc) = htab%r2d(jc,it)-htab%r2d(kc,it)
      endif
    enddo
    ! A one pass median filtering is required to estimate the noise,
    ! because lines can be narrow.
    call median_filter (wreal,lc,htab%gil%bval,htab%gil%eval,amed,amin,amax)
    call comp_r4_rms_blank (wreal,lc,rmsdiff,htab%gil%bval,htab%gil%eval)
    rmsdiff =  rmsdiff / sqrt(2.0) 
    noise_ratio = 1.0
    if (rmsdiff.lt.0.9*rmstheo) then
      write(chain,'(A,1PG10.2,A,1PG10.2)') 'Theoretical RMS ',rmstheo, &
      & ' larger than Difference RMS ',rmsdiff
      call message_colour(4)
      call map_message(seve%w,rname,chain)
      correlation_factor = rmstheo/rmsdiff
      write(chain,'(A,1PG10.2,A,1PG10.2)') 'Estimated correlation factor ', &
        & rmstheo/rmsdiff
      call map_message(seve%i,rname,chain)
      call message_colour(-1)
    else if (rmsdiff.gt.1.1*rmstheo) then
      noise_ratio = rmsdiff/rmstheo
      if (noise_ratio.gt.3.0) then
        call median_filter (wreal,lc,htab%gil%bval,htab%gil%eval,amed,amin,amax)
        call comp_r4_rms_blank (wreal,lc,rmsdiff,htab%gil%bval,htab%gil%eval)
        rmsdiff = rmsdiff / sqrt(2.0)
        noise_ratio = rmsdiff/rmstheo
      endif
      call message_colour(4)
      write(chain,'(A,1PG10.2,A,1PG10.2)') 'Theoretical RMS ',rmstheo, &
        & ' smaller than Difference RMS ',rmsdiff
      call map_message(seve%w,rname,chain)
      noise_ratio = rmsdiff/rmstheo
      call message_colour(1)
      write(chain,'(A,1PG10.2,A,1PG10.2)') 'Noise should be rescaled by ', & 
        & noise_ratio
      call map_message(seve%i,rname,chain)
      call message_colour(-1)
      noise_ratio = min(2.,noise_ratio)
    endif
    wall = noise_ratio*wall
    !
    !
    !
    call gildas_null(hclip)
    call gdf_copy_header(htab,hclip,error)
    allocate(hclip%r2d(nchan,ntaper+2),mylines(nchan),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'CLIP allocation error')
      error = .true.
      return
    endif
    !
    nb = 0    ! Empty channel list
    !
    hclip%r2d = htab%r2d
    !
    correlation_factor = 1.0
    do it=2,ntaper+1
      clip_data => hclip%r2d(:,it)
      call clip_lineregions(rname,clip_data,nchan,nhist,  &
        & hclip%gil%bval,hclip%gil%eval,clip_value, &
        & debug,wall(it-1),noise_ratio) 
      call guess_lineregions(clip_data,nchan,       &
        & hclip%gil%bval,hclip%gil%eval,            &
        & mylines,nb)
    enddo
    !
    call sic_mapgildas('CLIPPED',hclip,error,hclip%r2d)
    if (nb.gt.0) then
      call clip_expand(mylines,nchan,nb)
      hclip%r2d(:,1) = 0.0
      do ib=1,nb
        hclip%r2d(mylines(ib),1) = 1.0
      enddo
      !
      ! Add channel offset
      mylines = mylines + fchan
      call sic_def_inte('PREVIEW%CHANNELS',mylines,1,nb,.false.,error)
      !
      ! Find edges of contiguous regions
      allocate(edge_freq(2,nb), edge_chan(2,nb) ,stat=ier)
      if (ier.ne.0) then
        call map_message(seve%e,rname,'PREVIEW allocation error')
        error = .true.
        return
      endif
      call channel_to_edges(mylines,nb,edge_chan,nlines)
      !
      ! Convert to Rest Frequencies
      edge_freq = (edge_chan - huv%gil%ref(1))*huv%gil%fres + huv%gil%freq
      if (huv%gil%fres.lt.0) then
        do i = 1,nlines
          tmp = edge_freq(1,i)
          edge_freq(1,i) = edge_freq(2,i)
          edge_freq(1,i) = tmp
        enddo
      endif
      dim(1:2) = [2,nlines]
      call sic_def_dble('PREVIEW%FREQUENCIES',edge_freq,2,dim,.false.,error)
      call sic_def_inte('PREVIEW%EDGES',edge_chan,2,dim,.false.,error)
    endif
  endif
  !
  call exec_program('@ uv_preview') 
  call exec_program('@ preview_lines')  
  !
end subroutine uv_preview_sub
!
subroutine fit_parabola(n,x,y,a,b,c,d)
  !---------------------------------------------------------------------
  ! @ public
  !
  ! Find the characteristics of a parabola
  ! Parabola definition a + b.x + c.x^2
  !---------------------------------------------------------------------
  integer, intent(in) :: n  ! Number of values
  real, intent(in) :: x(n)  ! X coordinates
  real, intent(in) :: y(n)  ! Y values
  real, intent(inout) :: a    ! Constant term
  real, intent(inout) :: b    ! Linear term
  real, intent(inout) :: c    ! Second order term
  real, intent(inout) :: d    ! rms of fit
  !
  real :: a0, a1, a2, a3, a4
  real :: b0, b1, b2, d1
  integer :: m, k
  !
  a0 = 1; a1 = 0; a2 = 0; a3 = 0; a4 = 0
  b0 = 0; b1 = 0; b2 = 0
  k = 0
  do m = 1, n
    if (y(m).gt.0) then
      a1 = a1 + x(m)
      a2 = a2 + x(m) * x(m)
      a3 = a3 + x(m) * x(m) * x(m)
      a4 = a4 + x(m) * x(m) * x(m) * x(m)
      b0 = b0 + y(m)
      b1 = b1 + y(m) * x(m)
      b2 = b2 + y(m) * x(m) * x(m)
      k = k+1
    endif
  enddo
  !
  ! Protect against severe clipping: do not change values, and set RMS 0
  if (k.le.3) then
    d = 0.0
    return
  endif
  a1 = a1 / k; a2 = a2 / k; a3 = a3 / k; a4 = a4 / k
  b0 = b0 / k; b1 = b1 / k; b2 = b2 / k
  d = a0 * (a2 * a4 - a3 * a3) - a1 * (a1 * a4 - a2 * a3) + a2 * (a1 * a3 - a2 * a2)
  a = b0 * (a2 * a4 - a3 * a3) + b1 * (a2 * a3 - a1 * a4) + b2 * (a1 * a3 - a2 * a2)
  a = a / d
  b = b0 * (a2 * a3 - a1 * a4) + b1 * (a0 * a4 - a2 * a2) + b2 * (a1 * a2 - a0 * a3)
  b = b / d
  c = b0 * (a1 * a3 - a2 * a2) + b1 * (a2 * a1 - a0 * a3) + b2 * (a0 * a2 - a1 * a1)
  c = c / d
  !
  ! Evaluation of standard deviation d
  d = 0.
  do m = 1, n
    if (y(m).gt.0) then
      d1 = y(m) - a - b * x(m) - c * x(m) * x(m)
      d = d + d1 * d1
    endif
  enddo
  d = SQRT(d / (k - 3))
end subroutine fit_parabola
!
subroutine clip_lineregions(rname,data,nchan,nhist,bval,eval,clip,debug,rms, &
  & noise_ratio)
  use gildas_def
  use gbl_message
  use gkernel_interfaces
  use imager_interfaces, except_this => clip_lineregions
  !
  ! @ public
  !
  character(len=*), intent(in) :: rname
  integer(kind=index_length), intent(in) :: nchan   ! Data size
  integer(kind=index_length), intent(in) :: nhist   ! Histogram size
  real, intent(inout) :: data(nchan)                ! Data to be clipped
  real, intent(in) :: bval, eval                    ! Blanking values to be used
  real, intent(in) :: clip                          ! Clipping level in Sigma
  logical, intent(in) :: debug                      ! Debug printout
  real, intent(in) :: rms                           ! Expected rms noise
  real, intent(in) :: noise_ratio                   ! Noise scaling factor
  !
  real, allocatable :: hist(:,:), logv(:), temp(:)  ! Small automatic array
  real :: amed, amin,amax,aoff
  real :: a,b,c,d,mu,sigma,peak,logbase
  logical :: error, goon
  integer :: jc,ier, count
  integer(kind=index_length) :: mloc(1)
  integer(kind=4) :: mhist
  character(len=80) :: chain
  !
  error = .false.
  mhist = nhist   ! Integer(4) version
  ! Arrays 
  allocate(hist(mhist,2), logv(mhist), temp(nchan), stat=ier)
  if (ier.ne.0) return
  !
  ! Define the Histogram range around the median
  temp = data
  call median_filter (temp,nchan,bval,eval,aoff,amin,amax)
  !
  goon = (amin.lt.amax)     ! Protect against fully constant data (0 in models...)
  amed = (amin+amax)/2.0
  count = 0
  do while (goon) 
    ! Use NHIST here
    call histo44(temp,nchan,hist,nhist,2,amin,amax,bval,eval)
    !
    ! Apply Caruana algorithm : the Log of a Gaussian is a Parabola
    logv(:) = log(hist(:,1)+1.0)       ! Bias by 1 to avoid Log(0)
    logbase = maxval(logv)-4.0         ! Truncate wings
    where (logv.lt.logbase) logv=0.0
    ! Use MHIST there
    call fit_parabola(mhist,hist(1:mhist,2),logv,a,b,c,d)
    if (debug) print *,' A B C D ',a,b,c,d
    !
    ! Now back to Gaussian characteristics
    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) then
      count= count+10
      do jc=1,mhist
        write(count,*) hist(jc,2), logv(jc), a+b*hist(jc,2)+c*hist(jc,2)**2, d
      enddo
      close(unit=count)
      count = count-10
    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 *,'Peak ',log(peak),' MaxVal ',maxval(logv),' D ',d
    amed = mu                   ! Define the position of maximum 
    if (count.eq.8) then
      goon = .false.
    else if (d.gt.0.25 .or. log(peak).lt.maxval(logv)-d) then
      ! If not converged, the Maximum can be wrong - iterate
      mloc = maxloc(hist,1)
      amed = hist(mloc(1),2)
      amin = amed-2.0*sigma
      amax = amed+2.0*sigma
      if (debug) Print *,count,': Min ',amin,' Median ',aoff,' Max ',amax,' Rms ',sigma
      count = count+1
    else
      goon = .false.
    endif
    if (debug) then
      call gr4_give('X',nhist,hist(:,2))
      call gr4_give('Y',nhist,logv)
      call gr_exec('CLEAR')
      call gr_exec('LIMITS')
      call gr_exec('BOX')
      call gr_exec('HISTO')
      logv = a+b*hist(:,2)+c*hist(:,2)**2
      call gr4_give('Y',nhist,logv)
      call gr_exec('CONNECT')
      read(5,*) mloc
    endif
  enddo
  !
  ! Correct for the Offset
  amed = amed+aoff
  if (rms.ne.0.0 .and. sigma.gt.rms) then
    write(chain,'(A,1PG10.2,A,1PG10.2)')  'Expected noise ',rms, &
      & ' is smaller than measured noise ',sigma
    call message_colour(4)
    call map_message(seve%w,rname,chain)
    call message_colour(-1)
  endif
  !
  ! If there is a noise correction, apply it
  sigma = sigma*noise_ratio
  !
  ! Now clip the Spectrum where it deviates by more than 
  ! CLIP_VALUE sigma
  if (debug) Print *,'Clipping around median ',amed,' by ',clip*sigma
  do jc=1,nchan
    if (abs(data(jc)-bval).le.eval) then
      data(jc) = bval
    else if (abs(data(jc)-amed).gt.clip*sigma) then
      data(jc) = bval
    endif
  enddo
  !
end subroutine clip_lineregions
!
subroutine guess_lineregions(data,nchan,bval,eval,mylines,nb)
  use gildas_def
  ! @ public
  integer(kind=index_length), intent(in) :: nchan   ! Data size
  real, intent(inout) :: data(nchan)                ! Blanked data 
  real, intent(in) :: bval, eval                    ! Blanking values to be used
  integer, intent(inout) :: mylines(nchan)          ! Line channel list
  integer, intent(inout) :: nb                      ! Number of line channels
  !
  integer :: jc,jb,lb
  !
  do jc=1,nchan
    if (data(jc).eq.bval) then
      jb = 0
      do lb=1,nb
        if (mylines(lb).eq.jc) then
          jb = lb
          exit
        endif
      enddo
      if (jb.eq.0) then
        nb = nb+1
        mylines(nb) = jc
      endif
    endif
  enddo
end subroutine guess_lineregions
!
subroutine comp_r4_rms_blank (x,n,out,vblank4,eblank4)
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  ! Support routine for command
  !   COMPUTE OutVar RMS InVar  (single precision)
  ! Protected against NaNs and Using Blanking Values. If Blanking
  ! 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(*)  ! Data values to compute
  integer(kind=size_length), intent(in)  :: n     ! Number of data values
  real*4,                    intent(out) :: out   ! Output scalar value
  real*4,                    intent(in) :: vblank4, eblank4
  ! Local
  integer(kind=size_length) :: i,count
  real*4 :: s0,s1
  !
  !!Print *,'N ',n,' Bval ',vblank4,eblank4
  out = vblank4
  if (n.lt.1) return
  out = 0.0
  !
  s0 = 0.
  s1 = 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
    out = vblank4 ! lastchanceretval
    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
        s1 = s1 + (x(i)-s0)**2
      else
        if (abs(x(i)-vblank4).gt.eblank4) then
          s1 = s1 + (x(i)-s0)**2
        endif
      endif
    endif
  enddo
  s1 = s1/dble(count)
  out = sqrt (s1)
end subroutine comp_r4_rms_blank
!
subroutine clip_expand(mylines,nc,nb)
  use gildas_def
  use gkernel_interfaces
  !
  ! @ private
  !   Expand the list of bad channels by continuity 
  !   to account for line widths
  integer(kind=index_length), intent(in) :: nc ! Number of channels
  integer, intent(inout) :: nb          ! Number of bad channels
  integer, intent(inout) :: mylines(nc) ! List of bad channels
  !
  integer :: ier, nrange, iwide, ib, lb
  integer, allocatable :: istart(:), iend(:)
  logical :: error
  !
  error = .false.
  allocate(istart(nb),iend(nb),stat=ier)
  if (ier.ne.0) return
  call gi4_trie (mylines,istart,nb,error)
  if (error) return
  !
  ! Define the number of ranges
  nrange = 1
  istart(1) = mylines(1)
  iend(1) = mylines(1)
  iwide = 1
  do ib = 2,nb
    if ((mylines(ib)-iend(nrange)).gt.iwide) then  
      ! A gap wider than the current range
      nrange = nrange+1
      istart(nrange) = mylines(ib)
      iend(nrange) = mylines(ib)
      iwide = 1
    else
      iend(nrange) = mylines(ib)
      iwide = max(1,(iend(nrange)-istart(nrange)+1)/2)
    endif
  enddo
  !
  ! Extend the ranges by doubling or adding 16 channels to
  ! their width to account for typical line widths, but 
  ! ignore single channels in this process
  nb = 0
  do ib=1,nrange
    iwide = min((iend(ib)-istart(ib))/2,8)
    istart(ib) = max(1,istart(ib)-iwide)
    iend(ib) = min(nc,iend(ib)+iwide)
    !
    do lb=istart(ib),iend(ib) 
      nb = nb+1
      mylines(nb) = lb
    enddo
  enddo
end subroutine clip_expand
!
subroutine median_filter(temp,nchan,bval,eval,amed,amin,amax)
  use gildas_def
  use gkernel_interfaces
  use imager_interfaces, only : comp_r4_rms_blank 
  ! @ public
  integer(kind=index_length), intent(in) :: nchan
  real, intent(inout) :: temp(nchan)
  real, intent(in) :: bval
  real, intent(in) :: eval
  real, intent(out) :: amed
  real, intent(out) :: amin
  real, intent(out) :: amax
  !
  integer(kind=index_length) :: nmin,nmax
  real :: arms
  logical :: error
  !
  error = .false.
  call gr4_median(temp,nchan,bval,eval,amed,error)
  if (error) return  ! No valid data
  temp = temp-amed   ! Remove the median
  call gr4_extrema (nchan,temp,bval,eval,amin,amax,nmin,nmax)
  !!call gr4_minmax (nchan,temp,bval,eval,amin,amax,nmin,nmax)
  if (amin.eq.amax) return ! 
  amax = min(-amin,amax)
  amin = -amax 
  where(temp.lt.amin .or. temp.gt.amax) temp = bval
  call comp_r4_rms_blank (temp,nchan,arms,bval,eval)
  ! 
  where(abs(temp).gt.3*arms) temp = bval
end subroutine median_filter
!
!
subroutine channel_to_edges(clist,nc,edges,nl)
  use image_def
  ! @ private
  integer, intent(in) :: nc         ! Number of selected channels
  integer, intent(in) :: clist(nc)          ! Channel numbers
  integer, intent(out) :: edges(2,nc)  ! Start and End channels 
  integer, intent(out) :: nl        ! Number of ranges found
  !
  integer i,istart,iend
  !
  if (nc.lt.2) then
    nl = 1
    edges(1,1) = clist(1)
    edges(2,1) = clist(1) 
  else 
    istart = clist(1)
    iend = clist(1)
    nl = 1
    do i=2,nc
      if (clist(i)-iend.gt.1) then
        edges(1,nl) = istart
        edges(2,nl) = iend
        nl = nl+1
        istart = clist(i)
        iend = istart
      else
        iend = clist(i)
      endif
    enddo
    iend = clist(nc)
    edges(1,nl) = istart
    edges(2,nl) = iend
  endif
end subroutine channel_to_edges
