!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_fft
  use cubetools_structure
  use cube_types
  use cubeadm_cubeid_types
  use cubemain_messaging
  use cubemain_sperange_types
  !
  public :: fft
  public :: cubemain_fft_command
  private
  !
  type :: fft_comm_t
     type(option_t), pointer :: comm  
     type(option_t), pointer :: spectral
     type(sperange_opt_t)    :: range
   contains
     procedure, public  :: register => cubemain_fft_register
     procedure, private :: parse    => cubemain_fft_parse
     procedure, private :: main     => cubemain_fft_main
  end type fft_comm_t
  type(fft_comm_t) :: fft
  !
  integer(kind=4), parameter :: icube = 1
  type fft_user_t
     type(cubeid_user_t)   :: cubeids
     type(sperange_user_t) :: range             ! Range to be FFTed
     logical               :: dospectral        ! FFT is to be performed in the spectral axis
   contains
     procedure, private :: toprog => cubemain_fft_user_toprog
  end type fft_user_t
  type fft_prog_t
     type(sperange_prog_t):: range              ! window to be FFTed
     type(cube_t),pointer :: cube               ! Input cube
     type(cube_t),pointer :: fft                ! FFTed cube
     integer(kind=pixe_k) :: nx                 ! [---] Number of pixels in the x direction   
     integer(kind=pixe_k) :: ny                 ! [---] Number of pixels in the y direction
     integer(kind=chan_k) :: nc                 ! [---] Number of channels
     integer(kind=chan_k) :: fc,lc              ! [---] First and last channels
     logical              :: dospectral         ! FFT is to be performed in the spectral axis
     ! VVV Dim is kind=4 because of previous interfaces
     integer(kind=4)      :: dim(2)             ! [pix,pix] Dimensions for the FFT
     procedure(cubemain_fft_prog_image_loop), pointer :: loop => null()
   contains
     procedure, private :: header          => cubemain_fft_prog_header
     procedure, private :: header_spatial  => cubemain_fft_prog_header_spatial
     procedure, private :: header_spectral => cubemain_fft_prog_header_spectral
     procedure, private :: data            => cubemain_fft_prog_data
     procedure, private :: image           => cubemain_fft_prog_image
     procedure, private :: spectrum        => cubemain_fft_prog_spectrum
  end type fft_prog_t
  !
contains
  !
  subroutine cubemain_fft_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(fft_user_t) :: user
    character(len=*), parameter :: rname='FFT>COMMAND'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    call fft%parse(line,user,error)
    if (error) return
    call fft%main(user,error)
    if (error) continue
  end subroutine cubemain_fft_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_fft_register(fft,error)
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(fft_comm_t), intent(inout) :: fft
    logical,           intent(inout) :: error
    !
    type(cubeid_arg_t) :: cubearg
    character(len=*), parameter :: comm_abstract = &
         'Fourier transform a cube onto visibility space'
    character(len=*), parameter :: comm_help = &
         'The output is a complex cube. WARNING: Currently the header&
         & of the output cube does not contain coherent information&
         & about the Fourier transformed axes'
    character(len=*), parameter :: rname='FFT>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'FFT','[cube]',&
         comm_abstract,&
         comm_help,&
         cubemain_fft_command,&
         fft%comm,error)
    if (error) return
    call cubearg%register( &
         'CUBE', &
         'Input data',  &
         strg_id,&
         code_arg_optional,  &
         [flag_any], &
         error)
    if (error) return
    !
    call fft%range%register('RANGE',&
         'Define velocity range over which to compute the FT',&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'SPECTRAL','',&
         'Do FFT over the spectral axis',&
         strg_id,&
         fft%spectral,&
         error)
    if (error) return
  end subroutine cubemain_fft_register
  !
  subroutine cubemain_fft_parse(fft,line,user,error)
    use cubetools_parse
    !----------------------------------------------------------------------
    ! FFT cubname
    ! /RANGE vfirst vlast
    !----------------------------------------------------------------------
    class(fft_comm_t), intent(in)    :: fft
    character(len=*),  intent(in)    :: line
    type(fft_user_t),  intent(out)   :: user
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='FFT>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,fft%comm,user%cubeids,error)
    if (error) return
    call fft%range%parse(line,user%range,error)
    if (error) return
    call fft%spectral%present(line,user%dospectral,error)
    if (error) return
  end subroutine cubemain_fft_parse
  !
  subroutine cubemain_fft_main(fft,user,error)
    use cubeadm_timing
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(fft_comm_t), intent(in)    :: fft
    type(fft_user_t),  intent(in)    :: user
    logical,           intent(inout) :: error
    !
    type(fft_prog_t) :: prog
    character(len=*), parameter :: rname='FFT>MAIN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call user%toprog(prog,error)
    if (error) return
    call prog%header(error)
    if (error) return
    call cubeadm_timing_prepro2process()
    call prog%data(error)
    if (error) return
    call cubeadm_timing_process2postpro()
  end subroutine cubemain_fft_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_fft_user_toprog(user,prog,error)
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(fft_user_t), intent(in)    :: user
    type(fft_prog_t),  intent(out)   :: prog
    logical,           intent(inout) :: error
    !
    integer(kind=code_k) :: access
    character(len=*), parameter :: rname='FFT>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    prog%dospectral = user%dospectral
    !
    if (prog%dospectral) then
       access = code_access_speset
    else
       if (user%range%do) then
          call cubemain_message(seve%e,rname,'Option /RANGE is not compatible with a spatial FFT')
          error = .true.
          return
       endif
       access = code_access_imaset
    endif
    !
    call cubeadm_cubeid_get_header(fft%comm,icube,user%cubeids,access,code_read,prog%cube,error)
    if (error) return
    call user%range%toprog(prog%cube,prog%range,error)
    if (error) return
    !
    prog%nx = prog%cube%head%arr%n%l
    prog%ny = prog%cube%head%arr%n%m
    prog%dim = (/prog%nx,prog%ny/)
    !
  end subroutine cubemain_fft_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_fft_prog_header(prog,error)
    use gkernel_types, except_this => axis_t
    use cubetools_axis_types
    use cubetools_header_methods
    use cubedag_allflags
    use cubeadm_clone
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(fft_prog_t), intent(inout) :: prog
    logical,           intent(inout) :: error
    !
    type(axis_t) :: axis
    integer(kind=chan_k) :: stride
    character(len=*), parameter :: rname='FFT>PROG>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_clone_header(prog%cube,flag_fft,prog%fft,error)
    if (error) return
    prog%fft%head%arr%type = fmt_c4
    !
    ! Apply range selection to header
    call cubetools_header_get_axis_head_f(prog%cube%head,axis,error)
    if (error) return
    call prog%range%to_chan_k(prog%fc,prog%lc,stride,error)
    if (error) return
    axis%n = prog%lc-prog%fc+1
    axis%ref = axis%ref-prog%fc+1
    call cubetools_header_update_frequency_from_axis(axis,prog%fft%head,error)
    if (error) return
    !
    prog%nc = axis%n
    !
    if (prog%dospectral) then
       call prog%header_spectral(error)
       if (error) return
       prog%loop => cubemain_fft_prog_spectrum_loop
    else
       call prog%header_spatial(error)
       if (error) return
       prog%loop => cubemain_fft_prog_image_loop
    endif
  end subroutine cubemain_fft_prog_header
  !
  subroutine cubemain_fft_prog_header_spatial(prog,error)
    !----------------------------------------------------------------------
    ! Routine to properly fill the header of a spatial FFT
    !----------------------------------------------------------------------
    class(fft_prog_t), intent(inout) :: prog
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='FFT>HEADER>PROG>SPATIAL'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
  end subroutine cubemain_fft_prog_header_spatial
  !
  subroutine cubemain_fft_prog_header_spectral(prog,error)
    !----------------------------------------------------------------------
    ! Routine to properly fill the header of a spectral FFT
    !----------------------------------------------------------------------
    class(fft_prog_t), intent(inout) :: prog
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='FFT>PROG>HEADER>SPECTRAL'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
  end subroutine cubemain_fft_prog_header_spectral
  !
  subroutine cubemain_fft_prog_data(prog,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(fft_prog_t), intent(inout) :: prog
    logical,           intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='FFT>PROG>DATA'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_datainit_all(iter,error)
    if (error) return
    !
    !$OMP PARALLEL DEFAULT(none) SHARED(prog,error) FIRSTPRIVATE(iter)
    !$OMP SINGLE
    do while (cubeadm_dataiterate_all(iter,error))
       if (error)  exit
       !$OMP TASK SHARED(prog) FIRSTPRIVATE(iter,error)
       if (.not.error) call prog%loop(iter%first,iter%last,error)
       !$OMP END TASK
    enddo ! ie
    !$OMP END SINGLE
    !$OMP END PARALLEL
    !
  end subroutine cubemain_fft_prog_data
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_fft_prog_image_loop(prog,first,last,error)
    use gkernel_interfaces
    use cubemain_image_real
    use cubemain_image_cplx
    use cubeadm_entryloop
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(fft_prog_t),    intent(inout) :: prog
    integer(kind=entr_k), intent(in)    :: first
    integer(kind=entr_k), intent(in)    :: last    
    logical,              intent(inout) :: error
    !
    character(len=*),parameter :: rname='FFT>PROG>IMAGE>LOOP'
    type(image_cplx_t) :: fft
    type(image_t) :: image
    real(kind=sign_k), allocatable :: work(:)
    integer(kind=entr_k) :: ie
    integer(kind=4) :: ier
    !
    call image%init(prog%cube,error)
    if (error) return
    call fft%reallocate('result',prog%nx,prog%ny,error)
    if (error) return
    allocate(work(2*max(prog%nx,prog%ny)),stat=ier)
    if (failed_allocate(rname,'work array',ier,error)) then
       error = .true.
       return
    endif
    !
    do ie=first,last
      call cubeadm_entryloop_iterate(ie,error)
      if (error)  return
      call prog%image(ie,image,fft,work,error)
      if (error)  return
    enddo
  end subroutine cubemain_fft_prog_image_loop
  !
  subroutine cubemain_fft_prog_image(prog,ie,image,fft,work,error)
    use cubemain_image_real
    use cubemain_image_cplx
    use cubemain_fft_utils
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(fft_prog_t),    intent(inout) :: prog
    integer(kind=entr_k), intent(in)    :: ie
    type(image_t),        intent(inout) :: image   ! Working buffer
    type(image_cplx_t),   intent(inout) :: fft     ! Working buffer
    real(kind=sign_k),    intent(inout) :: work(:) ! Working buffer
    logical,              intent(inout) :: error
    !
    integer(kind=entr_k) :: oe
    character(len=*), parameter :: rname='FFT>PROG>IMAGE'
    !
    if (ie.gt.prog%fc.or.ie.le.prog%lc) then
       call image%get(prog%cube,ie,error)
       if (error) return
       !
       call cubemain_fft_nan2zero(prog%nx,prog%ny,image,error)
       if (error) return
       !
       fft%z(:,:) = cmplx(image%z(:,:),0.0)
       !
       call fourt(fft%z,prog%dim,2,code_dire,code_rdata,work)
       !
       fft%z(:,:) = fft%z(:,:)/(prog%nx*prog%ny)
       !
       oe = ie-prog%fc+1
       call fft%put(prog%fft,oe,error)
       if (error) return
    else
       ! Nothing to be done
    endif
  end subroutine cubemain_fft_prog_image
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_fft_prog_spectrum_loop(prog,first,last,error)
    use gkernel_interfaces
    use cubemain_spectrum_real
    use cubemain_spectrum_cplx
    use cubeadm_entryloop
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(fft_prog_t),    intent(inout) :: prog
    integer(kind=entr_k), intent(in)    :: first
    integer(kind=entr_k), intent(in)    :: last    
    logical,              intent(inout) :: error
    !
    character(len=*),parameter :: rname='FFT>PROG>SPECTRUM>LOOP'
    type(spectrum_cplx_t) :: fft
    type(spectrum_t) :: spectrum
    real(kind=sign_k), allocatable :: work(:)
    integer(kind=entr_k) :: ie
    integer(kind=4) :: ier
    !
    call spectrum%reassociate_and_init(prog%cube,error)
    if (error) return
    call fft%reallocate('result',prog%nc,error)
    if (error) return
    allocate(work(2*prog%nc),stat=ier)
    if (failed_allocate(rname,'work array',ier,error)) then
       error = .true.
       return
    endif
    !
    do ie=first,last
      call cubeadm_entryloop_iterate(ie,error)
      if (error)  return
      call prog%spectrum(ie,spectrum,fft,work,error)
      if (error)  return
    enddo
  end subroutine cubemain_fft_prog_spectrum_loop
  !
  subroutine cubemain_fft_prog_spectrum(prog,ie,spectrum,fft,work,error)
    use cubemain_spectrum_real
    use cubemain_spectrum_cplx
    use cubemain_fft_utils
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(fft_prog_t),     intent(inout) :: prog
    integer(kind=entr_k),  intent(in)    :: ie
    type(spectrum_t),      intent(inout) :: spectrum   ! Working buffer
    type(spectrum_cplx_t), intent(inout) :: fft     ! Working buffer
    real(kind=sign_k),     intent(inout) :: work(:) ! Working buffer
    logical,               intent(inout) :: error
    !
    integer(kind=4) :: dime(1)
    character(len=*), parameter :: rname='FFT>PROG>SPECTRUM'
    !
    dime(1) = int(prog%nc,kind=4)
    call spectrum%get(prog%cube,ie,error)
    if (error) return
    !
    call cubemain_fft_nan2zero(prog%nc,spectrum,error)
    if (error) return
    !
    fft%t(:) = cmplx(spectrum%t(prog%fc:prog%lc),0.0)
    !
    call fourt(fft%t,dime,1,code_dire,code_rdata,work)
    !
    fft%t(:) = fft%t(:)/prog%nc
    !
    call fft%put(prog%fft,ie,error)
    if (error) return
  end subroutine cubemain_fft_prog_spectrum
end module cubemain_fft
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
