subroutine spectral_comm(line,comm,error)
  use image_def
  use gkernel_interfaces
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !   IMAGER
  !
  ! Support routine for 
  !   SPECTRAL_CLEAN Method Control
  ! Drive a multi-spectral Clean deconvolution on a Data Cube
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  character(len=*), intent(in) :: comm  
  logical, intent(inout) :: error
  !
  integer :: iarg
  iarg = sic_start(0,1)
  !
  if (iarg.le.0) then
    call exec_program('@ spectral-clean ?')
  else
    call exec_program('@ spectral-clean '//line(iarg:))
  endif 
end subroutine spectral_comm
!
subroutine transform_comm(line,error)
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !   IMAGER
  !
  ! Support routine for 
  !   TRANSFORM Operation In Out [Key]
  ! Transform a data cube along the Frequency axis, by several methods
  !   - Wavelet
  !   - Fourier
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(out) :: error
  !
  character(len=*), parameter :: rname='TRANSFORM'
  character(len=12) :: ckey
  integer :: n
  !
  call sic_ke(line,0,1,ckey,n,.true.,error)
  !
  select case(ckey)
  case ('WAVE')
    call wavelet_compute(line,error)
  case ('FFT')
    call fft_compute(line,error) 
  case default
    call map_message(seve%e,rname,'Unknown case '//ckey)
    error = .true.
  end select
  !
contains
!
subroutine wavelet_compute(line,error)
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! @ private
  !   IMAGER
  !
  ! Support routine for 
  !   TRANSFORM WAVE In Out Direction
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(out) :: error
  !
  character*256 name1,name2
  integer :: direction, n
  !
  error = .false.
  call sic_ch(line,0,2,name1,n,.true.,error)
  if (error) return
  call sic_ch(line,0,3,name2,n,.true.,error)
  if (error) return
  call sic_i4(line,0,4,direction,.true.,error)
  if (error) return
  !
  call t_wavelet(name1,name2,direction,error)
  if (error) return
  !
end subroutine wavelet_compute
!
subroutine t_wavelet(name1,name2,direction,error)
  use image_def
  use gkernel_interfaces
  use gbl_message
  !$ use omp_lib
  !---------------------------------------------------------------------
  ! @ private
  !   IMAGER
  !
  ! Support routine for 
  !   TRANSFORM WAVE In Out Direction
  !---------------------------------------------------------------------
  character(len=*), intent(inout) :: name1,name2
  integer, intent(in) ::  direction
  logical, intent(out) :: error            ! Error flag
  !
  character(len=*), parameter :: rname='WAVELET'
  type(gildas) :: hdata
  integer :: nf, faxi
  real :: tolerance
  integer :: lf, mf, ier
  character(len=80) :: chain
  real(8) :: elapsed_s, elapsed_e, elapsed
  !
  ! Read Header 
  call gildas_null(hdata)
  elapsed_e = 0.
  elapsed_s = 0.
  elapsed = 0.
  !$ elapsed_s = omp_get_wtime()
  !
  error = .false.
  if (direction.eq.0) then
    call sic_parse_file (name1,' ','.lmv,',hdata%file)
  else if (direction.gt.0) then
    call sic_parse_file (name1,' ','.wave,',hdata%file)
  else
    call map_message(seve%e,rname,'Invalid direction')
    error = .true.
    return
  endif
  call gdf_read_header (hdata,error)
  if (error) return
  !
  faxi = hdata%gil%faxi
  nf = hdata%gil%dim(faxi)
  if (direction.gt.nf) then
    write(chain,'(A,I0,A,I0,A,I0)') 'Direction ',direction,' exceeds Frequency axis size ',nf
    call map_message(seve%e,rname,chain)
    error = .true.
    return
  else if (direction.ne.0) then
    write(chain,'(A,I0,A,I0,A,I0)') 'Extracting ',direction,' channels out of ',nf
    call map_message(seve%i,rname,chain,3)  
  endif
  tolerance = 0.5/float(nf-1)
  call gi4_round_forfft(nf,mf,error,tolerance,0) 
  !
  if (nf.ne.mf) then
    call gi4_round_forfft(nf,lf,error,0.3,0)
    write(chain,'(A,I0,A,I0,A,I0)') 'Frequency axis size ',nf,' is not 2^n; Nearest values ',lf,' - ',mf
    error = .true.
  else
    write(chain,'(A,I0,A,I0,A,I0)') 'Frequency axis size ',nf,' is 2^n'
  endif
  if (error) then
    call map_message(seve%w,rname,chain,3)
    write(chain,'(A,I0,1X,I0)') 'Extending axis size to ',mf, faxi
    call map_message(seve%w,rname,chain,3)
    if (faxi.ne.3) return
    !
    error = .false.
  else
    call map_message(seve%i,rname,chain)    
  endif
  if (error) return
  !
  ! Could be done by block on the Transposed (VLM) order, not 
  ! simply on the LMV one...
  if (faxi.eq.3) then
    allocate(hdata%r3d(hdata%gil%dim(1),hdata%gil%dim(2),mf),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation error')
      error = .true.
      return
    endif
    call gdf_read_data (hdata,hdata%r3d,error)
    if (error) return
    if (nf.ne.mf) hdata%r3d(:,:,nf+1:mf) = 0
    hdata%gil%dim(3) = mf
  else if (faxi.eq.1) then
    if (mf.ne.nf) return ! See comment below 
    !
    allocate(hdata%r3d(mf,hdata%gil%dim(2),hdata%gil%dim(3)),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation error')
      error = .true.
      return
    endif
    !
    ! Reading by block would be needed to do the job if NF # MF
    call gdf_read_data (hdata,hdata%r3d,error)
    if (error) return
  endif
  !$  elapsed_e = omp_get_wtime()
  !$  elapsed = elapsed_e - elapsed_s
  !$  elapsed_s = elapsed_e
  write(chain,'(a,a,f9.2,a)') 'Finished reading data','  - Elapsed time ',elapsed,' sec'
  call map_message(seve%i,rname,chain)
  !
  call s_wavelet(hdata,direction,error)
  !$  elapsed_e = omp_get_wtime()
  !$  elapsed = elapsed_e - elapsed_s
  !$  elapsed_s = elapsed_e
  write(chain,'(a,a,f9.2,a)') 'Finished Wavelet transform','  - Elapsed time ',elapsed,' sec'
  call map_message(seve%i,rname,chain)
  !
  if (direction.le.0) then
    call sic_parse_file (name2,' ','.lmv,',hdata%file)
  else
    call sic_parse_file (name2,' ','.wave',hdata%file)
  endif
  !
  ! Truncate output result if needed (Could be done inside s_wavelet)
  if (direction.ne.0) then
    if (faxi.eq.3) hdata%gil%dim(3) = direction
  endif
  !
  call gdf_write_image(hdata,hdata%r3d,error)
  !$  elapsed_e = omp_get_wtime()
  !$  elapsed = elapsed_e - elapsed_s
  !$  elapsed_s = elapsed_e
  write(chain,'(a,a,f9.2,a)') 'Finished writing data','  - Elapsed time ',elapsed,' sec'
  call map_message(seve%i,rname,chain)
  !
end subroutine t_wavelet
!
subroutine s_wavelet(hdata,direction,error)
  !$ use omp_lib
  use image_def
  use gkernel_interfaces
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !   IMAGER
  !
  ! Support routine for 
  !   TRANSFORM WAVE In Out Direction
  !
  ! Simple in-place wavelet transform for 3-D data cubes
  !---------------------------------------------------------------------
  !
  integer, intent(in) ::  direction
  type(gildas), intent(inout) :: hdata
  logical, intent(out) :: error            ! Error flag
  !
  character(len=*), parameter :: rname='WAVELET'
  integer :: nf, i, j, faxi
  real, allocatable :: array(:)
  !
  error = .false.
  faxi = hdata%gil%faxi
  nf = hdata%gil%dim(faxi)
  !
  !
  if (faxi.eq.1) then
    ! VLM order is simple
    !$OMP PARALLEL DEFAULT(NONE) &
    !$OMP &  SHARED(hdata, nf, direction) &
    !$OMP &  PRIVATE(i,j) 
    !$OMP DO COLLAPSE (2)
    do j=1,hdata%gil%dim(3)
      do i=1,hdata%gil%dim(2)
        call wavelet(hdata%r3d(:,i,j),nf,direction)
      enddo
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
  else if (faxi.eq.3) then
    ! LMV order requires an intermediate array and implicit transposition
    allocate (array(nf))
    !$OMP PARALLEL DEFAULT(NONE) &
    !$OMP &  SHARED(hdata, nf, direction) &
    !$OMP &  PRIVATE(i,j, array) 
    !$OMP DO COLLAPSE (2)
    do j=1,hdata%gil%dim(1)
      do i=1,hdata%gil%dim(2)
        array(:) = hdata%r3d(i,j,:)
        call wavelet(array,nf,direction)
        hdata%r3d(i,j,:) = array(:)
      enddo
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
  endif
  !
end subroutine s_wavelet
!
subroutine wavelet (x,n,direction)
  integer, intent(in) :: n          ! n is length of x, power of two
  integer, intent(in) :: direction  !  = 0 Direct, > 0 Inverse
  real, intent(inout) :: x(n)              
  !---------------------------------------------------------------------
  ! @ private
  !   IMAGER
  !
  ! Support routine for 
  !   TRANSFORM WAVE In Out Direction
  !
  ! Simple in-plave wavelet transform on a 1-D array
  !---------------------------------------------------------------------
  real, allocatable :: y(:)         ! y() is permutation buffer
  integer m, i
  !
  allocate (y(n))
  !
  if (direction .eq. 0) then
    ! DIRECT
    ! POWER OF 2 PASSES, EACH HALF AS LONG
    m = n
    do
      do i=1,m,2
        y(i) = (x(i) + x(i+1)) / 2
        y(i+1) = (x(i) - x(i+1)) / 2
      enddo
      ! Permutation 
      m = m / 2
      do i=1,m
        x(i) = y(i+i-1)
        x(m+i) = y(i+i)
      enddo
      if (m .eq. 1) exit
    enddo
    !
  else
    ! INVERSE
    ! POWER OF 2 PASSES, EACH TWICE AS LONG
    m = 1
    do
      do i=1,m
        y(i+i-1) = x(i)
        y(i+i) = x(m+i)
      enddo
      m = m + m
      !                BUTTERFLY
      do i=1,m,2
        x(i) = (y(i) + y(i+1))
        x(i+1) = (y(i) - y(i+1))
      enddo
      if (m .eq. n) exit
    enddo
  endif
end subroutine wavelet
!
subroutine fft_compute(line,error)
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! @ private
  !   IMAGER
  !
  ! Support routine for 
  !   TRANSFORM FFT In Out 
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(out) :: error
  !
  character*256 name1,name2
  integer :: direction, n
  !
  error = .false.
  call sic_ch(line,0,2,name1,n,.true.,error)
  if (error) return
  call sic_ch(line,0,3,name2,n,.true.,error)
  if (error) return
  direction = 0
  call sic_i4 (line,0,4,direction,.false.,error)
  !
  call t_fft(name1,name2,direction,error)
  if (error) return
  !
end subroutine fft_compute
!
subroutine t_fft(name1,name2,direction,error)
  use image_def
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !   IMAGER
  !
  ! Support routine for 
  !   TRANSFORM FFT In Out 
  ! The shape of In decides in which direction the FFT must be
  ! done. 
  !---------------------------------------------------------------------
  character(len=*), intent(inout) :: name1,name2
  integer, intent(in) ::  direction
  logical, intent(out) :: error            ! Error flag
  !
  character(len=*), parameter :: rname='FFT'
  type(gildas) :: hin, hout, htmp
  integer :: nf, faxi, ier
  complex, allocatable :: cdata(:)
  integer :: lf,mf
  real :: tolerance
  integer, parameter :: exponent=2
  character(len=80) :: chain
  logical :: err
  !
  ! Read Header 
  call gildas_null(hin)
  call gildas_null(hout)
  !
  call sic_parse_file (name1,' ','.lmv,',hin%file)
  call gdf_read_header (hin,error)
  if (error) return
  !
  faxi = hin%gil%faxi
  nf = hin%gil%dim(faxi)
  !
  tolerance = 1.0/float(nf-1)
  call gi4_round_forfft(nf,mf,error,tolerance,exponent)
  !
  if (nf.ne.mf) then
    call gi4_round_forfft(nf,lf,error,0.3,exponent)
    write(chain,'(A,I0,A,I0,A,I0)') 'Frequency axis size ',nf,' is not 2^n 3^p 5^q; Nearest values ',lf,' - ',mf
    error = .true.
  else
    write(chain,'(A,I0,A,I0,A,I0)') 'Frequency axis size ',nf,' is 2^n 3^p 5^q'
  endif
  !
  if (hin%gil%ndim.eq.3) then
    !
    ! Input is Real - it must be a Data Cube
    if (error) then
      call map_message(seve%w,rname,chain,3)
      write(chain,'(A,I0,1X,I0)') 'Rounding axis size to ',mf, faxi
      call map_message(seve%w,rname,chain,3)
      if (faxi.ne.3) return
      !
      error = .false.
    else
      call map_message(seve%i,rname,chain,3)    
    endif
    !
    !     call gdf_allocate (hin,error)
    allocate(hin%r3d(hin%gil%dim(1),hin%gil%dim(2),mf),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation error')
      error =.true.
    endif
    !
    if (error) return
    call gdf_read_data (hin,hin%r3d,error)
    if (error) return
    !
    ! Zero fill the possible extension of the data, and resize it
    if (mf.gt.nf) then
      if (faxi.eq.3) then
        hin%r3d(:,:,nf+1:mf) = 0.
        hin%gil%dim(faxi) = mf
      else  
        error = .true.
        return
      endif
    endif
    !
    call gildas_null(htmp)
    call gdf_copy_header(hin,htmp,error)
    if (error) return
    !
    htmp%gil%dim(faxi) = mf !
    !
    htmp%gil%ndim = 4
    htmp%gil%dim(4) = 2
    htmp%gil%convert(:,4) = 1
    htmp%char%code(4) = 'COMPLEX'
    !
    if (faxi.eq.1) then
      call gdf_transpose_header(htmp,hout,'2341',error)
    else
      call gdf_transpose_header(htmp,hout,'1243',error)
    endif
    !
    allocate ( cdata(hout%gil%dim(4)) &
      & ,hout%r4d(hout%gil%dim(1),hout%gil%dim(2),hout%gil%dim(3),hout%gil%dim(4)) &
      & ,stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation error')
      error = .true.
      return
    endif
    call wave_fft_direct(hin,hout%r4d,cdata,error)
    !
    call sic_parse_file (name2,' ','.wave',hout%file)
    call gdf_write_image(hout,hout%r4d,error)
    !
  else if (hin%gil%ndim.eq.4) then  
    ! 
    ! Input is complex - It must be a Fourier Transform
    !
    ! In this direction, it must have been already of appropriate size
    if (error) then
      call map_message(seve%e,rname,chain,3)
      return
    else
      call map_message(seve%i,rname,chain,3)    
    endif    
    !
    if (error) return
    call gdf_allocate(hin,error)
    if (error) return
    call gdf_read_data (hin,hin%r4d,error)
    if (error) return
    !
    call gildas_null(htmp)
    call gdf_copy_header(hin,htmp,error)
    if (error) return
    call gdf_transpose_header(htmp,hout,'1243',error)
    hout%gil%ndim = 3
    hout%gil%dim(4) = 1
    !
    allocate ( cdata(hin%gil%dim(4)) &
      & ,hout%r3d(hout%gil%dim(1),hout%gil%dim(2),hout%gil%dim(3)) &
      & ,stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation error')
      error = .true.
      return
    endif
    call wave_fft_inverse(hout,hin%r4d,cdata,error)
    call sic_parse_file (name2,' ','.lmv',hout%file)
    !
    ! Truncate output result if needed (Could be done inside wave_fft_inverse)
    if (direction.ne.0) then
      if (hout%gil%faxi.eq.3) hout%gil%dim(3) = direction
    endif  
    call gdf_write_image(hout,hout%r3d,error)
    !
  endif
  call gdf_close_image(hin,err)
  !    
end subroutine t_fft
!
subroutine wave_fft_direct(hreal,cresult,cdata,error)
  use image_def
  !---------------------------------------------------------------------
  ! @ private
  ! Compute Spectral Fourier Transform of a Data Cube
  !   Input data cube can be in VLM or LMV order
  !   Output SFT is always in LMCV order with C=(real,imag)
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: hreal             ! Header of Data cube
  real(kind=4), intent(out) :: cresult(:,:,:,:) ! 4-D result
  complex(kind=4), intent(inout) :: cdata(:)    ! Intermediate array
  logical,         intent(inout) :: error       ! Error flag
  ! Local
  integer(kind=4) :: i,j,k,kk,dims(1),nchan,faxi,ndim
  real(kind=4), allocatable :: work(:,:) 
  real :: scale
  !
  integer, parameter :: direction=-1  ! Direct
  logical, parameter :: simple=.true.
  !
  if (hreal%gil%form.ne.fmt_r4) then
    error = .true.
    return
  endif
  !
  ! Compute Direct Fourier transform
  faxi  = hreal%gil%faxi
  nchan = hreal%gil%dim(faxi)
  dims(1) = nchan
  ndim = 1
  allocate(work(nchan,2))
  work = 0
  scale =1.0/sqrt(real(nchan))
  !
  call fourt_plan(cdata,dims,ndim,direction,1)
  !
  if (faxi.eq.1) then
    ! VLM order, no transposition of input data
    do j=1,hreal%gil%dim(3)
      do i=1,hreal%gil%dim(2)
        if (simple) then
          cdata = cmplx(hreal%r3d(:,i,j),0.0)
        else
          do k=1,nchan
            kk = mod(k+nchan/2-1,nchan)+1
            cdata(kk) = cmplx(hreal%r3d(k,i,j),0.0)
          enddo
        endif
        call fourt(cdata,dims,ndim,direction,1,work)
        cresult(i,j,1,:) = real(cdata)*scale
        cresult(i,j,2,:) = imag(cdata)*scale
      enddo
    enddo
  else if (faxi.eq.3) then
    do j=1,hreal%gil%dim(2)
      do i=1,hreal%gil%dim(1)
        if (simple) then
          cdata = cmplx(hreal%r3d(i,j,:),0.0)
        else
          do k=1,nchan
            kk = mod(k+nchan/2-1,nchan)+1
            cdata(kk) = cmplx(hreal%r3d(i,j,k),0.0)
          enddo
        endif
        call fourt(cdata,dims,ndim,direction,1,work)
        cresult(i,j,1,:) = real(cdata)*scale
        cresult(i,j,2,:) = imag(cdata)*scale
      enddo
    enddo
  endif
  !
end subroutine wave_fft_direct
!
subroutine wave_fft_inverse(hout,cresult,cdata,error)
  use image_def
  !---------------------------------------------------------------------
  ! @ private
  ! Compute Data Cube from its Spectral Fourier Transform 
  !   Input SFT is always in LMCV order with C=(real,imag)
  !   Output data cube can be in VLM or LMV order
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: hout          ! Header of Data Cube
  real(kind=4), intent(in) :: cresult(:,:,:,:) ! Input 4-D array
  complex(kind=4), intent(inout) :: cdata(:)   ! Intermediate array
  logical,         intent(inout) :: error      !
  ! Local
  integer(kind=4) :: i,j,k,mx,dims(1),nchan,faxi,ndim
  real(kind=4), allocatable :: work(:,:) 
  real :: scale
  !
  integer, parameter :: direction=1
  logical, parameter :: simple=.true.
  !
  ! Compute Direct Fourier transform
  faxi = hout%gil%faxi
  nchan = hout%gil%dim(faxi)
  dims(1) = nchan
  ndim = 1
  allocate(work(nchan,2))
  work = 0
  scale =1.0/sqrt(real(nchan))
  !
  error = .false.
  mx = nchan/2
  call fourt_plan(cdata,dims,ndim,direction,1)
  !
  if (faxi.eq.1) then
    do j=1,hout%gil%dim(3)
      do i=1,hout%gil%dim(2)
        do k=1,nchan
          cdata(k) = cmplx(cresult(i,j,1,k),cresult(i,j,2,k))
        enddo
        call fourt(cdata,dims,ndim,direction,1,work)
        if (simple) then
          hout%r3d(:,i,j) = real(cdata)*scale
        else
          do k=1,mx
            hout%r3d(k+mx,i,j) = real(cdata(k))*scale 
          enddo
          do k=1,mx
            hout%r3d(k,i,j) = real(cdata(k+mx))*scale
          enddo
        endif
      enddo
    enddo
  else if (faxi.eq.3) then
    do j=1,hout%gil%dim(2)
      do i=1,hout%gil%dim(1)
        do k=1,nchan
          cdata(k) = cmplx(cresult(i,j,1,k),cresult(i,j,2,k))
        enddo
        call fourt(cdata,dims,ndim,direction,1,work)
        if (simple) then
          hout%r3d(i,j,:) = real(cdata)*scale
        else
          do k=1,mx
            hout%r3d(i,j,k+mx) = real(cdata(k))*scale 
          enddo
          do k=1,mx
            hout%r3d(i,j,k) = real(cdata(k+mx))*scale
          enddo
        endif
      enddo
    enddo
  else
    error = .true.
  endif
  !
end subroutine wave_fft_inverse
!
end subroutine transform_comm
