!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubecompute_fft_visi_tool
  use cubetools_parameters
  use cubetools_array_types
  use cubetools_structure
  use cubecompute_messaging
  use cubeadm_visi_types
  use cubeadm_image_types
  !
  public :: code_fft_direct,code_fft_inverse
  public :: fft_visi_opt_t,fft_visi_user_t,fft_visi_prog_t
  public :: cubecompute_fft_visi_prog_header_image2visi,cubecompute_fft_visi_prog_header_visi2image
  private
  !
  integer(kind=code_k), parameter :: mspace = 2
  character(len=2),     parameter :: known_space(mspace)= ['UV','LM']
  integer(kind=code_k), parameter :: code_space_uv = 1
  integer(kind=code_k), parameter :: code_space_lm = 2
  !
  integer(kind=code_k), parameter :: code_type_real    = 0 ! To be compatible with fourt
  integer(kind=code_k), parameter :: code_type_complex = 1 ! To be compatible with fourt
  integer(kind=code_k), parameter :: code_fft_direct  = +1 ! To be compatible with fourt
  integer(kind=code_k), parameter :: code_fft_inverse = -1 ! To be compatible with fourt
  integer(kind=code_k), parameter :: code_fft_star    =  0 ! Results will depend on input cube kind (real or complex)
  !
!!$  type action_t
!!$     integer(kind=code_k) :: cube  = code_null
!!$     integer(kind=code_k) :: dire  = code_null
!!$     integer(kind=code_k) :: space = code_null
!!$  end type action_t
  !
  type fft_visi_opt_t
     type(option_t), pointer :: direct
     type(option_t), pointer :: inverse
   contains
     procedure :: register => cubecompute_fft_visi_register
     procedure :: parse    => cubecompute_fft_visi_parse
  end type fft_visi_opt_t
  !
  type fft_visi_user_t
     integer(kind=code_k) :: direction = code_fft_star
   contains
     procedure :: toprog => cubecompute_fft_visi_user_toprog
!     procedure :: list   => cubecompute_fft_visi_user_list
  end type fft_visi_user_t
  !
  type fft_visi_prog_t
     integer(kind=code_k) :: direction      ! 
     type(image_t), pointer :: image        ! [nx x ny] 
     type(visi_t),  pointer :: visi         ! [nx x ny] 
     type(cplx_2d_t) :: plane               ! [nx x ny] 
     type(cplx_1d_t) :: work                ! [nw = max(nx,ny)]
   contains
     procedure, public :: init       => cubecompute_fft_visi_prog_init
     procedure, public :: compute    => cubecompute_fft_visi_prog_compute
     procedure, public :: normalize  => cubecompute_fft_visi_prog_normalize
     procedure, public :: visi2plane => cubecompute_fft_visi_prog_visi2plane
     procedure, public :: plane2visi => cubecompute_fft_visi_prog_plane2visi
     procedure, public :: visi2image => cubecompute_fft_visi_prog_visi2image
     procedure, public :: image2visi => cubecompute_fft_visi_prog_image2visi
     procedure, public :: list       => cubecompute_fft_visi_prog_list
     final :: cubecompute_fft_visi_prog_free
  end type fft_visi_prog_t
  !
contains
  !
  subroutine cubecompute_fft_visi_register(option,error)
    !----------------------------------------------------------------------
    ! Register [ /DIRECT | / INVERSE ]
    !----------------------------------------------------------------------
    class(fft_visi_opt_t), intent(out)   :: option
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='FFT>VISI>REGISTER'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         'DIRECT','',&
         'Compute the direct FFT (Default for real input cube)',&
         strg_id,&
         option%direct,&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'INVERSE','',&
         'Compute the inverse FFT (Default for complex input cube)',&
         strg_id,&
         option%inverse,&
         error)
    if (error) return    
  end subroutine cubecompute_fft_visi_register
  !
  subroutine cubecompute_fft_visi_parse(option,line,user,error)
    use cubetools_parse
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(fft_visi_opt_t), intent(in)    :: option
    character(len=*),      intent(in)    :: line
    type(fft_visi_user_t), intent(out)   :: user
    logical,               intent(inout) :: error
    !
    logical :: direct,inverse
    character(len=*), parameter :: rname='FFT>VISI>PARSE'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    call option%direct%present(line,direct,error)
    if (error) return
    call option%inverse%present(line,inverse,error)
    if (error) return
    if (direct.and.inverse) then
       call cubecompute_message(seve%e,rname,'DIRECT and INVERSE options are exclusive')
       error = .true.
       return
    else if (direct) then
       user%direction = code_fft_direct
    else if (inverse) then
       user%direction = code_fft_inverse
    else
       user%direction = code_fft_star
    endif
  end subroutine cubecompute_fft_visi_parse
  !
  !---------------------------------------------------------------------
  !
  subroutine cubecompute_fft_visi_user_toprog(user,cube,prog,error)
    use cube_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(fft_visi_user_t), intent(in)    :: user
    type(cube_t),           intent(in)    :: cube
    integer(kind=code_k),   intent(inout) :: prog
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='FFT>VISI>USER>TOPROG'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    select case(user%direction)
    case (code_fft_star)
       if (cube%iscplx()) then
          prog = code_fft_inverse
       else
          prog = code_fft_direct
       endif
    case (code_fft_direct)
       prog = user%direction
    case (code_fft_inverse)
       prog = user%direction
    case default
       call cubecompute_message(seve%e,rname,'Unknown FFT direction code')       
       error = .true.
       return
    end select
  end subroutine cubecompute_fft_visi_user_toprog
  !
  !---------------------------------------------------------------------
  !
  subroutine cubecompute_fft_visi_prog_header_image2visi(inhead,ouhead,error)
    use cubetools_unit
    use cubetools_axis_types
    use cubetools_header_types
    use cubetools_header_methods
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(cube_header_t), intent(in)    :: inhead
    type(cube_header_t), intent(inout) :: ouhead
    logical,             intent(inout) :: error
    !
    real(kind=coor_k) :: wave
    type(axis_t) :: axis
    character(len=*), parameter :: rname='FFT>VISI>PROG>HEADER>IMAGE2VISI'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    call cubetools_header_make_array_cplx(ouhead,error)
    if (error) return
    call cubetools_header_get_rest_wavelength(ouhead,wave,error)
    if (error) return
    wave = wave*1e-6 ! From um to m
    !
    call cubetools_header_get_axis_head_l(ouhead,axis,error)
    if (error) return
    if (axis%kind.eq.code_unit_fov) then
       axis%kind = code_unit_uv
       axis%name = 'U'
       axis%inc = wave/(axis%n*axis%inc)
    else
       ! *** JP This can not be easily inverted!
       axis%kind = code_unit_unk
       axis%unit = 'FT('//trim(axis%unit)//')'
       axis%inc = 1/(axis%n*axis%inc)
    endif
    axis%val = 0d0
    axis%ref = axis%n/2+1
    call cubetools_header_update_axset_l(axis,ouhead,error)
    if (error) return
    !
    call cubetools_header_get_axis_head_m(ouhead,axis,error)
    if (error) return
    if (axis%kind.eq.code_unit_fov) then
       axis%kind = code_unit_uv
       axis%name = 'V'
       axis%inc = wave/(axis%n*axis%inc)
    else
       ! *** JP This can not be easily inverted!
       axis%kind = code_unit_unk
       axis%unit = 'FT('//trim(axis%unit)//')'
       axis%inc = 1/(axis%n*axis%inc)
    endif
    axis%val = 0d0
    axis%ref = axis%n/2+1 ! *** JP: This assumes that the projection center is at the image center
    call cubetools_header_update_axset_m(axis,ouhead,error)
    if (error) return
  end subroutine cubecompute_fft_visi_prog_header_image2visi
  !
  subroutine cubecompute_fft_visi_prog_header_visi2image(inhead,ouhead,error)
    use cubetools_unit
    use cubetools_axis_types
    use cubetools_header_types
    use cubetools_header_methods
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(cube_header_t), intent(in)    :: inhead
    type(cube_header_t), intent(inout) :: ouhead
    logical,             intent(inout) :: error
    !
    real(kind=coor_k) :: wave
    type(axis_t) :: axis
    character(len=*), parameter :: rname='FFT>VISI>PROG>HEADER>VISI2IMAGE'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    call cubetools_header_make_array_real(ouhead,error)
    if (error) return
    call cubetools_header_get_rest_wavelength(ouhead,wave,error)
    if (error) return
    wave = wave*1e-6 ! From um to m
    !
    call cubetools_header_get_axis_head_l(ouhead,axis,error)
    if (error) return
    if (axis%kind.eq.code_unit_uv) then
       axis%kind = code_unit_fov
       axis%name = 'RA' ! *** JP Not generic!
       axis%inc = wave/(axis%n*axis%inc)
    else
       ! *** JP This can not be easily inverted!
       axis%kind = code_unit_unk
       !axis%unit = 'FT('//trim(axis%unit)//')' ! *** JP Howto remove FT()?
       axis%inc = 1/(axis%n*axis%inc)
    endif
    axis%val = 0d0
    axis%ref = axis%n/2+1
    call cubetools_header_update_axset_l(axis,ouhead,error)
    if (error) return
    !
    call cubetools_header_get_axis_head_m(ouhead,axis,error)
    if (error) return
    if (axis%kind.eq.code_unit_uv) then
       axis%kind = code_unit_fov
       axis%name = 'DEC' ! *** JP Not generic!
       axis%inc = wave/(axis%n*axis%inc)
    else
       ! *** JP This can not be easily inverted!
       axis%kind = code_unit_unk
       !axis%unit = 'FT('//trim(axis%unit)//')' ! *** JP Howto remove FT()? 
       axis%inc = 1/(axis%n*axis%inc)
    endif
    axis%val = 0d0
    axis%ref = axis%n/2+1 ! *** JP: This assumes that the projection center is at the image center
    call cubetools_header_update_axset_m(axis,ouhead,error)
    if (error) return
  end subroutine cubecompute_fft_visi_prog_header_visi2image
  !
  !---------------------------------------------------------------------
  !
  subroutine cubecompute_fft_visi_prog_init(fft,direction,image,visi,error)
    use cubecompute_primepower_tool
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(fft_visi_prog_t), intent(inout) :: fft
    integer(kind=code_k),   intent(in)    :: direction
    type(image_t), target,  intent(in)    :: image
    type(visi_t),  target,  intent(in)    :: visi
    logical,                intent(inout) :: error
    !
    integer(kind=pixe_k), pointer :: nx,ny
    character(len=*), parameter :: rname='FFT>VISI>PROG>INIT'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    ! *** JP The next lines will stop the processing when the pointer is prepared
    ! *** JP for association but not yet associated. What we want is not to check
    ! *** JP the status of the pointer but the status of the structure: has the
    ! *** JP array been initialized?
!    if (image%unallocated(error)) return
!    if (visi%unallocated(error)) return
    ! *** JP
    if (cubetools_array_2d_have_different_size(image,visi,error)) return
    fft%direction = direction
    fft%image => image
    fft%visi  => visi
    nx => visi%nx
    ny => visi%ny    
    call fft%plane%reallocate("fft plane",nx,ny,error)
    if (error) return
    call fft%work%reallocate("fft work space",max(nx,ny),error)
    if (error) return
!!$    call primepower%init(15,error)
!!$    if (error) return
!!$    call primepower%list(error)
!!$    if (error) return
  end subroutine cubecompute_fft_visi_prog_init
  !
  subroutine cubecompute_fft_visi_prog_free(fft)
    !-------------------------------------------------------------------
    ! *** JP: Should I explicitely unallocate fft%plane and fft%work?
    !-------------------------------------------------------------------
    type(fft_visi_prog_t), intent(inout) :: fft
    !
    character(len=*), parameter :: rname='FFT>VISI>PROG>FREE'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    nullify(fft%visi)
  end subroutine cubecompute_fft_visi_prog_free
  !
  !-----------------------------------------------------------------------
  !
  subroutine cubecompute_fft_visi_prog_image2visi(fft,error)
    use cubetools_nan
    !---------------------------------------------------------------------
    ! Transfer the real image array into the real part of the complex visi
    ! array
    !---------------------------------------------------------------------
    class(fft_visi_prog_t), intent(inout) :: fft
    logical,                intent(inout) :: error
    !
    integer(kind=indx_k) :: ix,nx
    integer(kind=indx_k) :: iy,ny
    character(len=*), parameter :: rname='FFT>VISI>PROG>IMAGE2VISI'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    nx = fft%visi%nx
    ny = fft%visi%ny
    do iy=1,ny
       do ix=1,nx
          if (ieee_is_nan(fft%image%val(ix,iy))) then
             fft%visi%val(ix,iy) = cmplx(0.0,0.0)
          else
             fft%visi%val(ix,iy) = cmplx(fft%image%val(ix,iy),0.0)
          endif
       enddo ! ix
    enddo ! iy
    fft%visi%uvkind = .false.
  end subroutine cubecompute_fft_visi_prog_image2visi
  !
  subroutine cubecompute_fft_visi_prog_visi2image(fft,error)
    !---------------------------------------------------------------------
    ! Transfer the real part of the complex visi array into the real image
    ! array
    !---------------------------------------------------------------------
    class(fft_visi_prog_t), intent(inout) :: fft
    logical,                intent(inout) :: error
    !
    integer(kind=indx_k) :: ix,nx
    integer(kind=indx_k) :: iy,ny
    character(len=*), parameter :: rname='FFT>VISI>PROG>IMAGE2VISI'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    if (fft%visi%uvkind) then
       call cubecompute_message(seve%e,rname,&
            'Trying to convert a complex with a non-zero imaginary part into a real')
       error = .true.
       return
    endif
    !
    nx = fft%visi%nx
    ny = fft%visi%ny
    do iy=1,ny
       do ix=1,nx
          fft%image%val(ix,iy) = real(fft%visi%val(ix,iy))
       enddo ! ix
    enddo ! iy
  end subroutine cubecompute_fft_visi_prog_visi2image
  !
  !-----------------------------------------------------------------------
  !
  subroutine cubecompute_fft_visi_prog_compute(fft,error)
    use gkernel_interfaces, nointerface=>fourt
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    class(fft_visi_prog_t), intent(inout) :: fft
    logical,                intent(inout) :: error
    !
    integer(kind=ndim_k) :: dim(2)
    character(len=*), parameter :: rname='FFT>VISI>PROG>UV'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    dim = [fft%plane%nx,fft%plane%ny]
    call fft%visi2plane()
    call fourt(fft%plane%val,dim,2,&
         fft%direction,&
         code_type_complex,&
         fft%work%val)
    call fft%plane2visi()
    fft%visi%uvkind = .not.fft%visi%uvkind
  end subroutine cubecompute_fft_visi_prog_compute
  !
  subroutine cubecompute_fft_visi_prog_normalize(fft,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(fft_visi_prog_t), intent(inout) :: fft
    logical,                intent(inout) :: error
    !
    integer(kind=indx_k) :: ix,nx
    integer(kind=indx_k) :: iy,ny
    real(kind=sign_k) :: factor
    character(len=*), parameter :: rname='FFT>VISI>PROG>NORMALIZE'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    nx = fft%visi%nx
    ny = fft%visi%ny
    factor = 1.0/(nx*ny)
    do iy=1,ny
       do ix=1,nx
          fft%visi%val(ix,iy) = fft%visi%val(ix,iy)*factor
       enddo ! ix
    enddo ! iy
  end subroutine cubecompute_fft_visi_prog_normalize
  !
  !-----------------------------------------------------------------------
  !
  subroutine cubecompute_fft_visi_prog_visi2plane(fft)
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    class(fft_visi_prog_t), intent(inout) :: fft
    !
    integer(kind=pixe_k) :: ix,mx
    integer(kind=pixe_k) :: iy,my
    character(len=*), parameter :: rname='FFT>VISI>PROG>VISI2PLANE'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    mx = fft%plane%nx/2
    my = fft%plane%ny/2
    do iy=1,my
       ! Plane bottom, left quarter
       do ix=1,mx
          fft%plane%val(ix,iy) = fft%visi%val(ix+mx,iy+my)
       enddo
       ! Plane bottom, right quarter
       do ix=1,mx
          fft%plane%val(ix+mx,iy) = fft%visi%val(ix,iy+my)
       enddo
    enddo
    do iy=1,my
       ! Plane top, left quarter
       do ix=1,mx
          fft%plane%val(ix,iy+my) = fft%visi%val(ix+mx,iy)
       enddo ! ix
       ! Plane top, right quarter
       do ix=1,mx
          fft%plane%val(ix+mx,iy+my) = fft%visi%val(ix,iy)
       enddo ! ix
    enddo ! iy
  end subroutine cubecompute_fft_visi_prog_visi2plane
  !
  subroutine cubecompute_fft_visi_prog_plane2visi(fft)
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    class(fft_visi_prog_t), intent(inout) :: fft
    !
    integer(kind=pixe_k) :: ix,mx
    integer(kind=pixe_k) :: iy,my
    character(len=*), parameter :: rname='FFT>VISI>PROG>PLANE2VISI'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    mx = fft%plane%nx/2
    my = fft%plane%ny/2
    do iy=1,my
       ! Plane bottom, left quarter
       do ix=1,mx
          fft%visi%val(ix+mx,iy+my) = fft%plane%val(ix,iy)
       enddo ! ix
       ! Plane bottom, right quarter
       do ix=1,mx
          fft%visi%val(ix,iy+my) = fft%plane%val(ix+mx,iy)
       enddo ! ix
    enddo ! iy
    do iy=1,my
       ! Plane top, left quarter
       do ix=1,mx
          fft%visi%val(ix+mx,iy) = fft%plane%val(ix,iy+my)
       enddo ! ix 
       ! Plane top, right quarter
       do ix=1,mx
          fft%visi%val(ix,iy) = fft%plane%val(ix+mx,iy+my)
       enddo ! ix
    enddo ! iy
  end subroutine cubecompute_fft_visi_prog_plane2visi
  !
  !-----------------------------------------------------------------------
  !
  subroutine cubecompute_fft_visi_prog_list(fft)
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    class(fft_visi_prog_t), intent(inout) :: fft
    !
    character(len=*), parameter :: rname='FFT>VISI>PROG>LIST'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    if (fft%direction.eq.code_fft_direct) then
       call cubecompute_message(computeseve%trace,rname,'VISI direct FFT')
    else
       call cubecompute_message(computeseve%trace,rname,'VISI inverse FFT')
    endif
  end subroutine cubecompute_fft_visi_prog_list
end module cubecompute_fft_visi_tool
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
