! @ spectral-clean KEY [File]
!
!   Perform a CLEAN using multiple spectral frequency scales.
!
!   KEY indicates the method, and can be DUAL, FFT or FFT
!
!
if ("&1+".ne."?+") then
  if .not.exist(UV) then
    message E SPECTRAL-CLEAN "No UV data"
    return error
  endif
endif
!
if exist(spclean) then
  @ spclean-spectral &1 &2 &3
  return
endif
!
begin procedure spclean-compact
  ! Compact the header of a 4-D L,M,(Real,Imag),V data set
  ! into a 3-D L,M,V with twice many channels
  define header a &1 write
  define alias b_ndim a%ndim
  define alias b_dim a%dim
  let b_dim /stat writ
  let b_dim[3] 2*a%dim[4]
  let b_dim[4] 1
  let b_ndim /stat writ
  let b_ndim 3
  delete /var b_dim b_ndim
  delete /var a
end procedure spclean-compact
!
begin procedure spclean-expand
  ! Expand the header of a 3-D L,M,V with even channels
  ! into a 4-D L,M,(Real,Imag),V data set with twice less channels
  define header a &1 write
  define alias b_ndim a%ndim
  define alias b_dim a%dim
  let b_dim /stat writ
  ! Order of next two commands matter, as b_dim is an alias of a%dim
  let b_dim[4] a%dim[3]/2
  let b_dim[3] 2  ! Orders matter, as b_dim is an alias of a%dim
  let b_ndim /stat writ
  let b_ndim 4
  delete /var b_dim b_ndim
  let a%unit4 "VELOCITY"
  delete /var a
end procedure spclean-expand
!
begin procedure spclean-ares
  define integer nlow nup
  define integer nchan
  nchan = &2
  !
  if (exist(&1)) delete /var &1
  define real &1[nchan] /global
  define real cnoise
  !
  nup = nchan
  nlow = nup/2+1
  cnoise = &3
  for /while yes
    let &1[nlow:nup] cnoise
    let cnoise cnoise/sqrt(2)
    let nup nup/2
    if (nup.eq.nlow) break
    let nlow int(nup/2)+1
  next
end procedure spclean-ares
!
begin procedure spclean-wave
  define integer nchan
  let nchan dirty%dim[3]  ! Remember the number of channels
  define real threshold
  !
  ! Wavelet Transform on spectral axis
  !
  calibrate\transform WAVE gag_tmp:image.lmv gag_tmp:image.wave  0 ! Direct transform
  clean\read dirty gag_tmp:image.wave
  !
  ! The clean depth depend on Wavelet number:
  ! it decreases by sqrt(2) at each factor 2
  if (clean_ares.eq.0) then
    @ spclean-ares ares_level 'dirty%dim[3]' 'dirty%noise'
  else
    @ spclean-ares ares_level 'dirty%dim[3]' 'clean_ares'
  endif
  !
  let clean_residual -1 ! Just keep point sources
  clean\clean /ares ares_level
  let clean_residual 0  ! Back to normal clean
  clean\write clean gag_tmp:image.wave
  ! Inverse transform with channel limitation
  calibrate\transform WAVE gag_tmp:image.wave gag_tmp:image.wave-clean nchan
  clean\read clean gag_tmp:image.wave-clean
  !
  ! Select Components to minimize their numbers of components.
  let threshold 0
  clean\cct_convert threshold
  clean\write cct gag_tmp:image.cct
  !
end procedure spclean-wave
!
begin procedure spclean-fft
  !
  define integer nchan
  let nchan dirty%dim[3]  ! Remember the number of channels
  define real threshold
  !
  ! Fourier Transform on spectral axis
  !
  calibrate\transform FFT gag_tmp:image.lmv gag_tmp:image.fft  ! Direct transform
  @ spclean-compact gag_tmp:image.fft
  clean\read dirty gag_tmp:image.fft
  !
  let clean_residual -1 ! Just keep point sources
  clean\clean
  let clean_residual 0  ! Back to normal clean
  clean\write clean gag_tmp:image.fft
  @ spclean-expand gag_tmp:image.fft
  !
  ! Inverse transform with channel limitation
  calibrate\transform FFT gag_tmp:image.fft gag_tmp:image.fft-clean nchan
  clean\read clean gag_tmp:image.fft-clean
  !
  ! Select Components above the Noise Level times the sidelobe of a Sin(x)/x
  let threshold dirty%noise/10
  ! Select Components to minimize their numbers of components.
  clean\cct_convert threshold
  clean\write cct gag_tmp:image.cct
  !
end procedure spclean-fft
!
begin procedure spclean-dual
  !
  define real smooth
  let smooth &1
  define character*80 base
  if (pro%narg.ge.2) then
    clean\read uv &2
    let base &2
  else
    let base tmp
  endif
  !
  calibrate\uv_select DATA  ! Make sure we start from a clean state
  !
  ! Dual-Spectral Clean
  !
  if (spclean%memory) then
    if (spclean%hasdirty) then
      define image SAVE_D * REAL /like DIRTY
      let SAVE_D DIRTY
      let SAVE_D% DIRTY%
    endif
    !
    ! Dual-Spectral Clean
    clean\uv_map
    !
    ! Writeable alias to DIRTY
    define alias wdirty DIRTY /global
    let wdirty /status write
    !
    define image FINE_D * REAL /like DIRTY
    define image DIFF_D * REAL /like DIRTY
    let fine_d% dirty%
    let fine_d DIRTY
    let diff_d% dirty%
    !
    !! WRITE dirty 'fine'
    clean\map_smooth DIRTY 'smooth'
    clean\clean
    define image CCT_S * REAL /like CCT
    let CCT_S% CCT%
    let CCT_S CCT
    !
    ! Compute the Dirty difference     FINE - SMOO
    clean\map_combine DIFF_D ADD FINE_D DIRTY /FACTOR 1 -1
    ! no simple equivalent ! head 'diff'.lmv /extrema
    let WDIRTY DIFF_D !read dirty 'diff'.lmv
    clean\clean
    define image CCT_D * REAL /like CCT
    let CCT_D% CCT%
    let CCT_D CCT
    !
    ! Collect all CCTables
    clean\cct_merge gag_tmp:multi-a-'base'.cct CCT_S CCT_D
    !
    ! Use the cumulative Clean Component Table to restore the high resolution data
    clean\read cct gag_tmp:multi-a-'base'.cct
    clean\uv_restore
    if (spclean%hasdirty) then
      let WDIRTY SAVE_D
      let WDIRTY% SAVE_D%
      delete /var WDIRTY
    else
      ! The dirty image has no sense
      delete /var WDIRTY
      clean\discard DIRTY
    ENDIF
    sic delete gag_tmp:multi-a-'base'.cct
    !
  else
    if .not.exist(debug) define logical debug
    !
    ! Temporary File Mode
    define character*80 fine smoo next diff
    !
    let fine gag_tmp:multi-a-f-'base'
    let smoo gag_tmp:multi-a-s-'base'
    let diff gag_tmp:multi-a-d-'base'
    clean\uv_map
    clean\write dirty 'fine'
    clean\map_smooth DIRTY 'smooth'
    clean\clean
    clean\write cct 'smoo'
    if (debug) then
      clean\write clean 'smoo'
      clean\view clean
      clean\view CCT
    endif
    !
    ! Compute the Dirty difference     FINE - SMOO
    clean\map_combine 'diff'".lmv" ADD 'fine'".lmv" DIRTY /FACTOR 1 -1
    vector\header 'diff'.lmv /extrema
    clean\read dirty 'diff'.lmv
    clean\clean
    if (debug) then
      clean\write clean 'diff'
      clean\view clean
      clean\view cct
    endif
    clean\write CCT 'diff'
    !
    ! Collect all CCTables
    let next gag_tmp:multi-a-'base'
    clean\cct_merge 'next'.cct 'smoo' 'diff'
    !
    ! Use the cumulative Clean Component Table to restore the high resolution data
    clean\read cct 'next'
    clean\uv_restore
    !
    clean\discard dirty
  endif
end procedure spclean-dual
!
begin procedure spclean-multi
  !
  define real smooth
  let smooth &1
  if (pro%narg.ge.2) clean\read uv &2
  !
  calibrate\uv_select DATA  ! Make sure we start from a clean state
  !
  ! Multi-Spectral Clean, in Memory only
  if (.not.spclean%hasdirty) clean\uv_map
  !
  define image SAVE_D * REAL /like DIRTY
  let SAVE_D DIRTY
  let SAVE_D% DIRTY%
  !
  ! We must ultimately clean at the natural spectral resolution of the data
  ! so we start by the SMOOTH version.
  !
  clean\map_smooth DIRTY 'smooth'    ! Compute the SMOOTH image
  clean\clean                        ! Clean the SMOOTH image
  !    
  ! Restore initial DIRTY image - Use a writeable alias to DIRTY
  define alias wdirty DIRTY /global
  let wdirty /status write
  let WDIRTY SAVE_D
  let WDIRTY% SAVE_D%
  delete /var WDIRTY
  !
  ! Clean the image after removal of the Smooth CCT
  clean\clean /restart
  RETURN
  !
  ! Use the cumulative Clean Component Table to restore the high resolution data
  clean\uv_restore
end procedure spclean-multi
!
begin procedure spclean-help
  !
  say "@ spectral-clean MODE [Parameter [UVDataFile]]"
  say "   Perform a Clean with different spectral scales"
  say " "
  say "   MODE can be "
  say "     FFT         Clean the Fourier Transform of the spectra"
  say "     WAVE        Clean a Wavelet Transform of the spectra"
  say "     DUAL Ns     Clean a two different spectral resolution"
  say "     MULTI Ns    Clean at 2 or More different spectral resolution"
  say " "
  say " Control parameters"
  if spclean%memory then
    say "   spclean%memory  YES   Use memory instead of intermediare disk files"
  else
    say "   spclean%memory  NO    Use temporary disk files instead of memory"
  endif
end procedure spclean-help
!
begin procedure spclean-spectral
  define logical use_memory
  define character argu*4
  let argu &1 /upper
  !
  ! Basic Check
  if (argu.eq."FFT ") then
    use_memory = no
  else if (argu.eq."WAVE") then
    use_memory = no
  else if (argu.eq."DUAL") then
    use_memory = spclean%memory
    continue
  else if (argu.eq."MULT") then
    @ spclean-multi &2 &3 &4
    return  ! This is self-contained
  else if (argu.eq."?") then
    @ spclean-help
    return
  else
    message E SPECTRAL-CLEAN "Unsupported method &1  -- Use @ clean-spectral ? for help"
    return error
  endif
  !
  define logical save_dirty
  spclean%hasdirty = exist(DIRTY)
  save_dirty = (spclean%hasdirty).and.(.not.use_memory)
  if (save_dirty) write dirty gag_tmp:image.lmv
  !
  clean\discard CCT  ! In case it matches
  let argu &1 /lower
  !
  if (argu.eq."dual") then
    @ spclean-dual &2
  else
    if (.not.spclean%hasdirty) then
      clean\uv_map
      clean\write dirty gag_tmp:image.lmv
    endif
    @ spclean-'argu' &2
    clean\discard DIRTY
  endif
  !
  ! Restore the DIRTY image
  if (save_dirty) read dirty gag_tmp:image.lmv
  !
  ! Use the Clean Component list to restore the proper CLEAN image
  clean\uv_restore
  !
  ! CLEAN and CCT are in memory now as usual.
  !
  RETURN
  ! Free temporary storage
  SAY system "rm "`gag_tmp:`"image.*"   ! Does not work because of lack of recursivity here
end procedure spclean-spectral
!
define structure spclean /global
define logical spclean%memory spclean%hasdirty /global
let spclean%memory yes
!
@ spclean-spectral &1 &2 &3
