!*
! Support for UV_PREVIEW
!
! The algorithm is a bit complex.
!
! 1) For each TAPER and each SMOOTH number, compute the
!     corresponding spectrum  
! 2) Apply a Sigma-Clipping method to clip channels with line emission
!     Caveat: this is based on deviation from a median, no 
!       linear baseline is removed in this process  
! 3) Take the union of all line emitting channels
! 4) Identify contiguous ranges  
!     - guess typical line half-width by mean of initial window widths  
!     - concatenate adjacent windows if their separation is below
!       the typical half-width  
!     - expand each resulting window by its half-width or at 
!       least by the mean half-width. (Ensure at this stage...)
! 5) Build a list of final "line" channels (1 Line, 0 Continuum)
!
!!   
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
  use preview_mod
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER  --  Support for command
  !   UV_PREVIEW  [TAPER Ntaper] [THRESHOLD Threshold] [HISTO Nhisto] [
  !     SMOOTH Nsmooth] [/BROWSE] [/FILE UvData.uvt [Drop]]
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line  !! Command line 
  logical, intent(inout) :: error       !! Error flag
  !
  ! Constans
  character(len=*), parameter :: rname='UV_PREVIEW'
  integer, parameter :: o_file=2
  integer, parameter :: o_browse=1
  !
  ! Local ---
  type(gildas) :: hfile
  integer :: n, ntaper
  character(len=filename_length) :: name
  character(len=16) :: chainbrowse, argum
  logical :: do_insert, do_browse, do_file, an_error
  !
  do_browse = sic_present(o_browse,0) 
  if (do_browse) then
    if (sic_narg(o_browse).ne.0) then  
      call sic_i4(line,o_browse,1,ntaper,.false.,error)
      write(chainbrowse,'(A,I0)') '@ p_browse ',ntaper
    else
      chainbrowse = '@ p_browse'
    endif
  endif
  do_file   = sic_present(o_file,0)
  do_insert = sic_lire().eq.0
  !
  if (do_browse.and.(sic_narg(0).eq.0)) then
    ! UV_PREVIEW /BROWSE
    !   Just replay the existing spectrum if any
    if (number_of_channels.gt.0) then
      if (number_of_channels.lt.64) then      
        call map_message(seve%w,rname,'Too few channels')
        call exec_program('@ uv_preview') 
        if (number_of_channels.ge.1) call exec_program('@ preview_lines')   
      else
        call exec_program(chainbrowse)
      endif
      if (do_insert) call sic_insert_log(line)
      return
    endif
    ! If not, do the full Job
  endif
  !
  if (sic_narg(0).eq.1) then
    call sic_ke(line,0,1,argum,n,.true.,error)
    if (argum.eq.'?') then
      write(*,'(A)') "UV_PREVIEW current control parameters:"
      write(*,'(A,I5,A)')    "     TAPER  ",utaper,  "   (number of UV tapers)"
      write(*,'(A,I5,A)')    "     SMOOTH ",usmooth, "   (number of spectral kernels)"
      write(*,'(A,F5.2,A)')  "     CLIP   ",uclip,   "   (Clipping threshold)"
      if (uhist.eq.0) then
        write(*,'(A,I5,A)')  "     HISTO  ",uhist,   "   (Automatic Histogram Size)"
      else
        write(*,'(A,I5,A)')  "     HISTO  ",uhist,   "   (Histogram Size)"
      endif
      write(*,'(A)') 'Use command "UV_PREVIEW KEY Value" to change any of these'
      return
    endif
  endif
  !
  error = .false.
  call sic_delvariable('PREVIEW',.false.,error)
  error = .false.
  call sic_delvariable('SPECTRUM',.false.,error)
  error = .false.
  call sic_delvariable('CLIPPED',.false.,error)
  error = .false.
  call sic_delvariable('CHANNEL_LIST',.false.,error)
  error = .false.
  !
  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)
    !
    call gdf_close_image(hfile,an_error)
  else
    if (huv_current%loca%size.eq.0) then
      call map_message(seve%e,rname,'No UV data loaded')
      error = .true.
      return
    endif
    huv_current%r2d => duv    ! SG Should already be true
    call uv_preview_sub(huv_current,line,error)
  endif
  !
  if (error) return
  !
  call exec_program('@ uv_preview') 
  if (number_of_channels.ge.1) call exec_program('@ preview_lines') 
  do_browse = do_browse.and.(number_of_channels.ge.64)
  if (do_browse) call exec_program(chainbrowse)   
  !
  if (do_insert) call sic_insert_log(line)
  !
end subroutine uv_preview
!
subroutine uv_preview_sub (huvl,line,error)
  use image_def
  use gkernel_interfaces
  use gkernel_types 
  use imager_interfaces, except_this => uv_preview_sub
  use gbl_message
  use preview_mod
  !$ use omp_lib
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support for command  
  !   UV_PREVIEW  [TAPER Ntaper] [THRESHOLD Threshold] [HISTO Nhisto] 
  !     [SMOOTH Nsmooth] [/BROWSE] [/FILE UvData.uvt [Drop]]
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line  !! Command line
  logical, intent(inout) :: error       !! Error flag
  type(gildas), intent(inout) :: huvl    !! Input UV data set
  !
  ! Constants
  character(len=*), parameter :: rname='UV_PREVIEW'
  integer, parameter :: o_file=2
  integer, parameter :: mtaper=4
  integer, parameter :: mmode=6
  character(len=8) :: smode(mmode), mode, argum
  data smode /'TAPER','CLIP','HISTO','SMOOTH','NOFILTER','ONLY'/
  real, save :: mu=3.0    ! Rejection threshold
  !
  ! Local ---
  character(len=message_length) :: mess
  integer(kind=4) :: ntaper
  integer(kind=index_length) :: nvisi, nchan
  integer(kind=index_length) :: nhist, mhist, lc
  integer :: it,jc,kc,jv,kr,kw,ier,n,narg
  real :: ww, rr, uvmin, uvmax, blank, rms
  real :: tapermin, tapermax, tapercurrent, taperfactor
  integer :: ib,nb,ksum, fchan, lchan
  real :: vtaper(mtaper)
  real, allocatable :: wall(:), wreal(:), wplus(:)
  real, allocatable :: weights(:,:), poids(:,:,:), spec(:,:,:)
  real, pointer :: uvdata(:,:)  ! Pointer to UV data subset
  integer, allocatable :: kplus(:)
  integer, allocatable :: mylines(:), idx(:)
  integer :: mvisi
  integer :: nt
  integer :: ithread, nthread
  real :: clip_value, correlation_factor, rmsdiff, rmstheo 
  real :: amed, amin, amax, arms, noise_ratio, ctaper
  logical :: debug=.false.
  logical :: view_only
  real :: fraction
  !
  ! EDGE_FREQUENCIES
  real(kind=8) :: tmp 
  real :: ldrop
  integer :: i, nlines, inb, iextent
  integer(kind=index_length) :: dim(4)
  !
  ! Channel smmothing factors
  integer :: is, msmooth
  integer :: nsmooth(4)
  real, allocatable :: smarray(:)
  real :: weight
  !
  ! Code ----
  call sic_get_logi('DEBUG_PREVIEW',debug,error)
  error = .false.
  !
  nsmooth(:) = [1,4,16,32] 
  view_only = .false.
  !
  if (associated(htab%r2d)) deallocate(htab%r2d)
  if (associated(hclip%r2d)) deallocate(hclip%r2d)
  if (allocated(final_lines)) deallocate(final_lines)
  if (allocated(edge_freq)) deallocate(edge_freq)
  if (allocated(edge_chan)) deallocate(edge_chan)
  call gildas_null(hclip)
  call gildas_null(htab)
  !
  nvisi = huvl%gil%nvisi
  !
  ! Reload previous control values
  ntaper = utaper
  clip_value = uclip
  uhist = 0
  msmooth = usmooth   
  !
  narg = sic_narg(0)
  do i=1,narg,2
    call sic_ke(line,0,i,argum,n,.true.,error)
    call sic_ambigs (rname,argum,mode,n,smode,mmode,error)
    if (error) return
    select case(mode)
    case ('TAPER')            
      call sic_i4(line,0,i+1,ntaper,.false.,error)
      if (error) return
      if (ntaper.lt.1 .or. ntaper.gt.mtaper) then
        call map_message(seve%e,rname,'Number of tapers out of range 1-4')
        error = .true.
        return
      endif
      utaper = ntaper
    case ('CLIP')
      call sic_r4(line,0,i+1,clip_value,.false.,error)
      if (error) return
      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
      uclip = clip_value
    case ('HISTO')
      call sic_i4(line,0,i+1,uhist,.false.,error)
      if (error) return
      if (uhist.lt.8) then
        call map_message(seve%e,rname,'Histogram size too small')
        error = .true.
        return
      endif
    case ('SMOOTH') 
      call sic_i4(line,0,i+1,msmooth,.false.,error)
      if (error) return
      if (msmooth.lt.1 .or. msmooth.gt.4) then
        call map_message(seve%e,rname,'Number of smoothing kernels not in range [1,4]')
        error = .true.
        return
      endif
      usmooth = msmooth
    case ('NOFILTER','ONLY')
      view_only = .true.
    end select
  enddo 
  !
  fchan = 1
  lchan = huvl%gil%nchan
  if (huvl%loca%size.eq.0 .and. lchan.gt.80) then 
    ldrop = 5
    call sic_r4(line,o_file,2,ldrop,.false.,error)
    if (error) return
    fraction = 0.1
    call sic_r4(line,o_file,3,fraction,.false.,error)
    ldrop = min(100.,max(0.,ldrop))*0.01
    ! Drop 5 % at each edge for files
    fchan = nint(ldrop*huvl%gil%nchan)
    lchan = nint((1.-ldrop)*huvl%gil%nchan)
  endif
  !
  ! If UV_CHECK BEAM has been used, 
  ! restrict the range to the most significant (bad edge recognition)
  call channel_restrict(rname,fchan,lchan,error)
  write(mess,'(A,I0,A,I0,A)') 'Selecting channel range [',fchan,',',lchan,']'
  call map_message(seve%i,rname,mess)
  !
  fchan = fchan-1          ! Offset for channel numbers from here
  nchan = lchan-fchan
  !
  ! Default histogram size (after NCHAN definition)
  mhist = max(8,nint(sqrt(real(nchan))))
  nhist = max(8,mhist)
  !
  if (uhist.ne.0) nhist = uhist
  !
  if (view_only) then
    write(mess,'(A,I0,A)') 'No filtering, Display only'
    call map_message(seve%i,rname,mess,seve%w)
    nhist = 1
    msmooth = 1
  else if (nchan.le.32) then
    write(mess,'(A,I0,A)') 'Too few channels [',nchan,'], display only'
    call map_message(seve%w,rname,mess,seve%w)
    nhist = 1
    msmooth = 1
  else if (nhist.lt.8) then
    write(mess,'(A,I0,A,I0,A)') 'Histogram size ',nhist,' out of recommended range [8-',mhist,']'
    call map_message(seve%e,rname,mess)
    error = .true.
    return
  else if (nhist.gt.mhist)  then
    write(mess,'(A,I0,A,I0,A)') 'Histogram size ',nhist,' out of recommended range [8-',mhist,']'
    call map_message(seve%w,rname,mess,seve%w)
  endif
  if (nchan.lt.64) msmooth = min(3,msmooth) ! Do not smooth too much if few channels.
  ! 
  call gildas_null(htab)
  call gdf_copy_header(huvl,htab,error)
  !
  htab%gil%ndim = 2
  htab%gil%dim(1) = nchan
  htab%gil%dim(2) = ntaper+2
  !
  allocate(htab%r2d(nchan,ntaper+2),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'HTAB Memory allocation error')
    error = .true.
    return
  endif
  allocate(wplus(ntaper),kplus(ntaper),wall(ntaper),wreal(nchan),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Taper Memory allocation error')
    error = .true.
    return
  endif
  !
  ! Define the Tapers here
  if (huvl%loca%size.ne.0) then
    if (huvl%gil%basemax.eq.0 .or. huvl%gil%basemin.eq.0) then
      uvmax = 0.0
      uvmin = 1e36
      do jv=1,huvl%gil%nvisi
        ww = huvl%r2d(1,jv)**2 + huvl%r2d(2,jv)**2 
        if (ww.gt.0.0) then
          uvmax = max(uvmax,ww)
          uvmin = min(uvmin,ww)
        endif
      enddo
      if (uvmin.gt.uvmax) uvmin = uvmax
      huvl%gil%basemax = sqrt(uvmax)
      huvl%gil%basemin = sqrt(uvmin)
    endif
    tapermax = huvl%gil%basemax
    if (huvl%gil%nteles.ge.1) then
      tapermin = 3*max(huvl%gil%teles(1)%diam,huvl%gil%basemin)
    else
      tapermin = 3*huvl%gil%basemin
    endif
  else if (huvl%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 = huvl%gil%basemax
    if (huvl%gil%nteles.ge.1) then
      tapermin = 3*max(huvl%gil%teles(1)%diam,huvl%gil%basemin)
    else
      tapermin = 3*huvl%gil%basemin
    endif
  endif
  !
  ! Full range of Tapers is obtained only with Ntaper = Mtaper
  taperfactor = log(tapermax/tapermin)/(mtaper-1)/log(2.0)
  tapercurrent = tapermax
  mess = 'Taper values: [ None'
  nt = len_trim(mess)+1
  !
  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-huvl%gil%ref(1))*huvl%gil%vres + huvl%gil%voff
  enddo
  !
  ! Compute various spectra
  !
  ! Header is in Memory, but Data may be on file 
  !
  ! Allocate spaces for each array
  if (huvl%loca%size.eq.0) then
    ! Data is on file and and must be read sequentially
    ! Define blocking factor, on data file
    mvisi = space_nitems('SPACE_IMAGER',huvl,1) ! Visibilities at once
    mvisi = min(mvisi,huvl%gil%dim(2))
    allocate(uvdata(huvl%gil%dim(1),mvisi),stat=ier)
    if (ier.ne.0) then
      write(mess,*) 'UVDATA Memory allocation error ',huvl%gil%dim(1), mvisi
      call map_message(seve%e,rname,mess)
      error = .true.
      return
    endif
  else
    mvisi = huvl%gil%nvisi
    uvdata => huvl%r2d
  endif
  allocate(weights(nchan,ntaper),stat=ier)
  if (ier.ne.0) then
    write(mess,*) 'WEIGHTS Memory allocation error ',huvl%gil%dim(1), mvisi
    call map_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  weights = 0.0
  !
  wplus = 0.
  kplus = 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
  !
  ! Shift the reference channel by Fchan
  htab%gil%ref(1) = htab%gil%ref(1)-fchan
  !
  do ib=1,huvl%gil%nvisi,mvisi
    write(mess,*) ib,' / ',huvl%gil%dim(2),mvisi
    call map_message(seve%i,rname,mess)
    !
    ! Read the data
    huvl%blc(2) = ib
    huvl%trc(2) = min(huvl%gil%nvisi,ib-1+mvisi)
    nvisi = huvl%trc(2)-huvl%blc(2)+1
    !
    if (huvl%loca%size.eq.0) then
      call gdf_read_data(huvl,uvdata,error)
      if (error) return
!    else
!      uvdata => huvl%r2d(:,huvl%blc(2):huvl%trc(2))
    endif
    !
    ! On this block, increment the htab array
    !
    spec = 0.
    poids = 0.
    !$OMP PARALLEL DEFAULT(none)  SHARED(uvdata) &
    !$OMP & SHARED (fchan,nchan,nvisi,htab,huvl,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(-(uvdata(1,jv)**2 + uvdata(2,jv)**2)/vtaper(it)**2)
        endif
        !
        do jc = 1,nchan
          kw = 7 + 3*(jc+fchan)   ! Weight            
          ww = uvdata(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 = uvdata(kr,jv) * ww
            ! Move to the Thread-based arrays
            spec(jc,it,ithread) = spec(jc,it,ithread) + rr
          endif
        enddo
      enddo
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
    !
    ! Reduce the Thread-based arrays
    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)
  if (huvl%loca%size.eq.0) then
    deallocate(uvdata)
  else
    nullify(uvdata)
  endif     
  !
  ! 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
  ! Display noise estimate
  wall = 1e-3/sqrt(wall)    ! Units are Jy and MHz
  rmstheo = wall(1)
  call prnoise(rname,'Natural',rmstheo,rms,seve%i)
  !
  ! 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
  htab%gil%blan_words = 2   ! Ensure the Blanking section exists
  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  ! No, this is creating issues
    !
    ! Evaluate the channel correlation factor and/or noise scaling factor
    ! by computing the rms on the difference between adjacent channels
    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
    ! This normally has filtered out wide lines, but 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,arms,mu)
    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(mess,'(A,1PG10.2,A,1PG10.2)') 'Theoretical RMS ',rmstheo, &
      & ' larger than Difference RMS ',rmsdiff
      call map_message(seve%w,rname,mess)
      correlation_factor = rmstheo/rmsdiff
      write(mess,'(A,1PG10.2,A,1PG10.2)') 'Estimated correlation factor ', &
        & rmstheo/rmsdiff
      call map_message(seve%i,rname,mess)
    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,arms,mu)
        call comp_r4_rms_blank (wreal,lc,rmsdiff,htab%gil%bval,htab%gil%eval)
        rmsdiff = rmsdiff / sqrt(2.0)
        noise_ratio = rmsdiff/rmstheo
      endif
      write(mess,'(A,1PG10.2,A,1PG10.2)') 'Theoretical RMS ',rmstheo, &
        & ' smaller than Difference RMS ',rmsdiff
      call map_message(seve%w,rname,mess)
      noise_ratio = rmsdiff/rmstheo
      write(mess,'(A,1PG10.2,A,1PG10.2)') 'Noise should be rescaled by ', & 
        & noise_ratio
      call map_message(seve%i,rname,mess,seve%w)
      noise_ratio = min(2.,noise_ratio)
    endif
    ! 
    ! Why is this done using the NOISE ratio. It should be SQUARED, hum ?
    wall = noise_ratio*wall
    !
    ! Separate Line from Continuum level, and identify regions...
    call gdf_copy_header(htab,hclip,error)
    allocate(hclip%r2d(nchan,ntaper+2),mylines(nchan),smarray(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
      !
      ! Here we 
      !   1) Smooth by some N channels
      !   2) Apply the Clip / Guess on the Smoothed array
      ! and this for the M possible smoothing
      do is=1,msmooth
        !
        if (nsmooth(is).gt.1) then
          call smooth_array(nchan,hclip%r2d(:,it),smarray,nsmooth(is), &
          & hclip%gil%bval,hclip%gil%eval)
        else
          smarray(:) = hclip%r2d(:,it)
        endif
        !
        weight = wall(it-1)/sqrt(float(nsmooth(is)))
        !
        call clip_lineregions(rname,smarray,nchan,nhist,  &
          & hclip%gil%bval,hclip%gil%eval,clip_value, &
          & debug,weight,noise_ratio) 
        call guess_lineregions(smarray,nchan,       &
          & hclip%gil%bval,hclip%gil%eval,            &
          & mylines,nb)
      enddo
    enddo
    !
    if (nb.gt.0) then
      !
      inb = nb
      allocate (final_lines(huvl%gil%nchan),stat=ier)
      iextent = 32
      call clip_expand(nchan,mylines,inb,final_lines,nb,iextent)
      do while ((nchan-nb).lt.fraction*nchan)
        iextent=iextent/2
        if (iextent.lt.2) then
          call map_message(seve%w,rname,'Complete spectral confusion at this level',seve%w)
          exit
        endif
        call clip_expand(nchan,mylines,inb,final_lines,nb,iextent)
      end do
      !
      hclip%r2d(:,1) = 0.0
      do ib=1,nb
        hclip%r2d(final_lines(ib),1) = 1.0
      enddo
      call sic_mapgildas('CLIPPED',hclip,error,hclip%r2d)
      !
      ! After SPECTRUM and CLIPPED are defined,
      !   Add the channel offset
      final_lines = final_lines + fchan
      ! and
      !   Add the edge channels [1,fchan] and [lchan+1,nchan]
      if (fchan.gt.0) then
        do ib=1,fchan
          nb = nb+1
          final_lines(nb) = ib
        enddo
      endif
      if (lchan.lt.huvl%gil%nchan) then
        do ib=lchan+1,huvl%gil%nchan
          nb = nb+1
          final_lines(nb) = ib
        enddo
      endif
      ! Sort if needed
      if ((fchan.gt.1).or.(lchan.lt.nchan)) then
        allocate(idx(nb),stat=ier)
        call gi4_trie (final_lines,idx,nb,error) 
        error = .false. 
      endif
      ! and define the result
      call sic_def_inte('PREVIEW%CHANNELS',final_lines,1,nb,.false.,error)
      !
      ! Find edges of contiguous regions over the whole channel range [1,nchan]
      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(final_lines,nb,edge_chan,nlines)
      !
      ! Convert to Rest Frequencies
      edge_freq(:,:) = (edge_chan - huvl%gil%ref(1))*huvl%gil%fres + huvl%gil%freq
      if (huvl%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)
    else
      ! Just one non existent channel
      allocate (final_lines(1),stat=ier)
      final_lines = 0
      call sic_def_inte('PREVIEW%CHANNELS',final_lines,1,1,.false.,error)
    endif
  endif
  !
  number_of_channels = nchan
end subroutine uv_preview_sub
!
subroutine fit_parabola(n,x,y,a,b,c,d)
  !---------------------------------------------------------------------
  ! @ public
  !*
  !   IMAGER -- generic tool
  !
  ! Find the characteristics of a parabola.
  ! Parabola definition y = 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
  !*
  !   IMAGER -  Support for command UV_PREVIEW
  !
  !   Clip the possible "spectral line" regions, i.e. those
  ! that deviate from the median by a sufficient amount
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname             !! Caller name
  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
  !
  ! Local ---
  real, allocatable :: hist(:,:), logv(:), temp(:)  ! Small automatic array
  real :: amed, amin,amax,arms,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=128) :: chain
  real :: thremu=3.0
  !
  ! Code ----
  error = .false.
  mhist = nhist   ! Integer(4) version
  ! Arrays 
  allocate(hist(mhist,2), logv(mhist), temp(nchan), stat=ier)
  if (ier.ne.0) then
    Print *,'clip_lineregions allocation error ',ier
    return
  endif
  !
  ! Define the Histogram range around the median
  temp(:) = data
  call median_filter (temp,nchan,bval,eval,aoff,amin,amax,arms,thremu)
  if (debug) print *,' Amin ',amin,', Amax ',amax,', Aoff ',aoff,' RMS ',rms
  goon = (amin.lt.amax)     ! Protect against fully constant data (0 in models...)
  !
  if (goon .and. rms.ne.0) then
    ! Protect against High S/N lines with both negative and positive features
    if (arms.gt.3*rms) then
      amin = max(-5.0*rms,amin)
      amax = -amin
    endif
  endif
  !
  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
      ! 8 iterations, this is too much...
      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')
      write(*,*) 'Enter an integer to continue '
      read(*,*) 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 map_message(seve%w,rname,chain,seve%w)
  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
  !*
  !     IMAGER  -- Support for UV_PREVIEW
  !
  !   Identify the edges of regions which consecutive channels
  ! that have been clipped (i.e. Blanked)
  !!
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: nchan   !! Data size
  real, intent(in) :: 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
  !
  ! Local ---
  integer :: jc,jb,lb
  !
  ! Code ----
  do jc=1,nchan
    if (abs(data(jc)-bval).le.eval) 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)
  !*
  ! IMAGER -- Utility routine
  !
  ! 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.
  !
  !   (Duplicated from Kernel code because symbol is private there)
  !!
  !---------------------------------------------------------------------
  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 !! Blanking
  !
  ! Local ---
  integer(kind=size_length) :: i,count
  real*4 :: s0,s1
  !
  ! Code ----
  !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(nc,inlines,inb,oulines,onb,iextent)
  use gildas_def
  use gkernel_interfaces
  !---------------------------------------------------------------------  
  ! @ private
  !*
  !   IMAGE -- Support for UV_PREVIEW
  !
  !   Expand the list of "bad" channels by continuity to account for 
  ! possible line wings
  !!
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: nc !! Number of channels
  integer, intent(inout) :: inlines(nc)  !! List of bad channels
  integer, intent(in) :: inb             !! Number of bad channels
  integer, intent(out) :: oulines(nc)    !! List of bad channels
  integer, intent(out) :: onb            !! Number of bad channels
  integer, intent(in) :: iextent         !! Side channel Extension 
  !
  ! Local ---
  integer :: ier, nrange, iwide, ib, lb, jend, jwide
  integer, allocatable :: istart(:), iend(:)
  real :: rwide
  logical :: error
  !
  ! Code ----
  error = .false.
  onb = inb
  allocate(istart(inb),iend(inb),stat=ier)
  if (ier.ne.0) return
  oulines(1:nc) = inlines(1:nc)
  call gi4_trie (oulines,istart,inb,error)
  inlines(1:nc) = oulines(1:nc)
  if (error) return
  !
  ! Define the number of ranges
  nrange = 1
  istart(1) = oulines(1)
  iend(1) = oulines(1)
  !
  ! 1) Find out the ranges
  iwide = 1
  do ib=1,inb
    if ((oulines(ib)-iend(nrange)).gt.iwide) then  
      ! A gap wider than the current range
      nrange = nrange+1
      istart(nrange) = oulines(ib)
      iend(nrange) = oulines(ib)
    else
      iend(nrange) = oulines(ib)
    endif
  enddo
  !
  ! 2) compute the Mean Line Width 
  !- Assume it is not too different from the Median
  rwide = 0.
  do ib=1,nrange
    rwide = rwide +(iend(ib)-istart(ib)+1)
  enddo
  rwide = rwide/(2.*nrange)
  iwide = max(1,nint(rwide))
  !
  ! 3) Figure out continuity at this level
  nrange = 1
  do ib = 2,inb
    if ((oulines(ib)-iend(nrange)).gt.iwide) then  
      ! A gap wider than the current half-width
      nrange = nrange+1
      istart(nrange) = oulines(ib)
      iend(nrange) = oulines(ib)
    else
      iend(nrange) = oulines(ib)
    endif
  enddo
  !
  ! Extend the ranges by doubling or adding +/- iextent channels to
  ! their width to account for typical line widths, but 
  ! ignore single channels in this process
  onb = 0
  oulines = 0
  jend = 1
  do ib=1,nrange
    jwide = min((iend(ib)-istart(ib))/2,iextent)  ! At least iextent
    jwide = max(iwide,jwide)  ! At least iwide
    istart(ib) = max(jend,istart(ib)-jwide)
    iend(ib) = min(nc,iend(ib)+jwide)
    jend = iend(ib)+1 ! To avoid overlap with previous end
    !
    do lb=istart(ib),iend(ib) 
      onb = onb+1
      If (onb.gt.nc) then
        Print *,'Serious programming error ',onb,nc
        Print *,'at ',lb,istart(lb),iend(lb)
      else
        oulines(onb) = lb
      endif
    enddo
  enddo
end subroutine clip_expand
!
subroutine median_filter(temp,nchan,bval,eval,amed,amin,amax,arms,mu)
  use gildas_def
  use gkernel_interfaces
  use imager_interfaces, only : comp_r4_rms_blank 
  !---------------------------------------------------------------------
  ! @ public
  !*
  !     IMAGER  -- Utility routine
  !
  !   Median filtering, returning Median, symmetric Min, Max and Rms 
  !!
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: nchan !! Array size
  real, intent(inout) :: temp(nchan)    !! Data array  
  real, intent(in) :: bval              !! Blanking value
  real, intent(in) :: eval              !! Blanking tolerance
  real, intent(out) :: amed             !! Median
  real, intent(out) :: amin             !! Min
  real, intent(out) :: amax             !! Max
  real, intent(out) :: arms             !! Rms
  real, intent(in) :: mu                !! Rejection threshold
  !
  ! Local ---
  integer(kind=index_length) :: nmin,nmax
  logical :: error
  !
  ! Code ----
  arms = 0.
  amin = 0.
  amax = 0.
  amed = 0.
  !
  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)
  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.mu*arms) temp = bval
end subroutine median_filter
!
subroutine channel_to_edges(clist,nc,edges,nl)
  use image_def
  !---------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Utility routine
  !
  !   Convert a list of channels into a list of edges of the
  ! independent (continuous) ranges.
  !!
  !---------------------------------------------------------------------
  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
  !
  ! Local ---
  integer :: i,istart,iend
  !
  ! Code ----
  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
!
subroutine channel_restrict(rname,fchan,lchan,error)
  use gkernel_interfaces
  use gkernel_types
  use gbl_message
  use clean_beams
  !---------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Utility routine
  !
  !   If UV_CHECK BEAM has been used, restrict the range to the 
  ! most significant (to avoid issues with bad edge recognition)
  !
  !   Also used in SELFCAL
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname !! Caller name
  integer, intent(inout) :: fchan       !! First channel
  integer, intent(inout) :: lchan       !! Last channel
  logical, intent(inout) :: error       !! Error flag
  !
  integer :: icode, nbr
  integer, allocatable :: branges(:,:)
  !
  icode = 0
  allocate(branges(2,max(1,nbeam_ranges)))
  call channel_range(rname,fchan,lchan,icode,nbr,branges)
  error = icode.ne.0
  !
end subroutine channel_restrict
!
subroutine smooth_array(nchan,raw,smooth,ksmoo,bval,eval)
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Utility routine
  ! 
  ! Smooth an array by K channels, accounting for Blanking
  !!
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: nchan  !! Number of channels
  real, intent(in) :: raw(nchan)      !! Input array
  real, intent(out) :: smooth(nchan)  !! Smoothed array 
  integer, intent(in):: ksmoo         !! Smoothing length
  real, intent(in) :: bval, eval      !! Blanking value
  !
  ! Local ---
  integer :: ic, im, ip, k, nc
  real :: w
  !
  ! Code ----
  nc = (ksmoo-1)/2
  do ic=1,nchan
    smooth(ic) = 0
    im = max(1,ic-nc)
    ip = min(nchan,ic+ksmoo-nc-1)
    w = 0.0
    do k=im,ip
      if (abs(raw(k)-bval).gt.eval) then
        smooth(ic) = smooth(ic) + raw(k)
        w = w+1.0
      endif
    enddo
    if (w.gt.0) then
      smooth(ic) = smooth(ic)/w
    else
      smooth(ic) = bval
    endif
  enddo
end subroutine smooth_array
