!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
program fourier
  use image_def
  use gildas_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! Make the complex fourier transform of a real spectra cube
  ! Return (real,imag) if direct fourier transform
  !---------------------------------------------------------------------
  ! Local
  character(len=*), parameter :: rname="FOURIER"
  character(len=filename_length) :: name_in,name_out
  character(len=80) :: message
  logical :: error,do_reorder
  integer(kind=4) :: ndim,iaxis,iplane,n,sign,ier
  integer(kind=4) :: dim1,dim2,dim3,maxdims,dims(2)
  type(gildas) :: head_in                              ! Input  GILDAS cube
  type(gildas) :: head_out                             ! Output GILDAS cube
  real(kind=4), dimension(:,:,:,:), allocatable :: data_in  ! Input  data
  real(kind=4), dimension(:,:,:,:), allocatable :: data_out ! Output data
  real(kind=4), dimension(:)      , allocatable :: wfft     ! Working space for FFT
  complex(kind=4), dimension(:,:),  allocatable :: work     ! Working complex array
  !
  ! Read input parameters
  call gildas_open
  call gildas_char('NAME_IN$',name_in)
  call gildas_char('NAME_OUT$',name_out)
  call gildas_inte('SIGN$',sign,1)
  call gildas_logi('REORDER$',do_reorder,1)
  call gildas_close
  if (abs(sign).ne.1) then
    call gagout('F-'//rname//',  Sign must be: +/- 1 (direct or inverse)')
    call sysexi(fatale)
  endif
  !
  ! Check input file
  call gildas_null(head_in)
  call sic_parse_file(name_in,' ','.gdf',head_in%file)
  n = lenc(head_in%file)
  if (n.eq.0) call sysexi(fatale)
  ier = gag_inquire(head_in%file(1:n),n)
  if (ier.ne.0) then
    message = 'Input cube '//' '//head_in%file(1:n)//' not found'
    call gagout('F-'//rname//',  '//message)
    call sysexi(fatale)
  endif
  !
  ! Read input file HEADER
  call gdf_read_header(head_in,error)
  if (head_in%gil%ndim.le.1) then
    message = 'Input cube is not an image (at least 2 dimensions)'
    call gagout('F-'//rname//',  '//message)
    call sysexi(fatale)
  endif
  !
  ! Initialize output header
  call gildas_null(head_out)
  call gdf_copy_header(head_in,head_out,error)
  if (error) call sysexi(fatale)
  call sic_parse_file(name_out,' ','.gdf',head_out%file)
  n = lenc(head_out%file)
  if (n.eq.0) call sysexi(fatale)
  !
  ! Set output header according to sign
  if (sign.gt.0) then
    ! Direct transform
    if (head_in%char%code(1).eq.'FFT') then
      call gagout('F-'//rname//',  First axis must not be of FFT type')
      call sysexi(fatale)
    endif
    if (head_in%gil%ndim.gt.3) then
      message = 'Input cube has more than 3 dimensions'
      call gagout('F-'//rname//',  '//message)
      call sysexi(fatale)
    endif
    ! Dimensions
    dim1 = head_in%gil%dim(1)
    dim2 = head_in%gil%dim(2)
    dim3 = head_in%gil%dim(3)
    head_out%gil%dim(1:4) = (/2,dim1,dim2,dim3/)
    where(head_out%gil%dim(1:4).eq.0) head_out%gil%dim(1:4)=1
    if (head_in%gil%ndim.lt.5) head_out%gil%ndim = head_in%gil%ndim+1
    ! Shift transformation formula
    head_out%gil%ref(1) = 1
    head_out%gil%val(1) = 0
    head_out%gil%inc(1) = 1
    do iaxis=2,4
      head_out%gil%ref(iaxis) = head_in%gil%ref(iaxis-1)
      head_out%gil%val(iaxis) = head_in%gil%val(iaxis-1)
      head_out%gil%inc(iaxis) = head_in%gil%inc(iaxis-1)
    enddo ! iaxis
    ! Axis content
    head_out%char%code(1) = 'FFT'
    head_out%char%code(2:4) = head_in%char%code(1:3)
  else
    ! Inverse transform
    if (head_in%char%code(1).ne.'FFT') then
      call gagout('F-'//rname//',  First axis must be of FFT type')
      call sysexi(fatale)
    endif
    if (head_in%gil%ndim.gt.4) then
      message = 'Input cube has more than 4 dimensions'
      call gagout('F-'//rname//',  '//message)
      call sysexi(fatale)
    endif
    ! Dimensions
    dim1 = head_in%gil%dim(2)
    dim2 = head_in%gil%dim(3)
    dim3 = head_in%gil%dim(4)
    head_out%gil%dim(1:4) = (/dim1,dim2,dim3,1/)
    where(head_out%gil%dim(1:4).eq.0) head_out%gil%dim(1:4)=1
    head_out%gil%ndim = head_in%gil%ndim-1
    ! Shift transformation formula
    do iaxis=1,3
      head_out%gil%ref(iaxis) = head_in%gil%ref(iaxis+1)
      head_out%gil%val(iaxis) = head_in%gil%val(iaxis+1)
      head_out%gil%inc(iaxis) = head_in%gil%inc(iaxis+1)
    enddo ! iaxis
    head_out%gil%ref(4) = 1
    head_out%gil%val(4) = 0
    head_out%gil%inc(4) = 1
    ! Axis content
    head_out%char%code(4) = 'UNKNOWN'
    head_out%char%code(1:3) = head_in%char%code(2:4)
  endif
  ndim = 2
  !
  ! Allocate memory
  ! Work space for FFT
  maxdims = 2*max(dim1,dim2)
  allocate( &
    data_in(head_in%gil%dim(1),head_in%gil%dim(2),head_in%gil%dim(3),head_in%gil%dim(4)), &
    data_out(head_out%gil%dim(1),head_out%gil%dim(2),head_out%gil%dim(3),head_out%gil%dim(4)), &
    work(dim1,dim2),wfft(maxdims),stat=ier)
  if (ier.ne.0) then
    call gagout('F-'//rname//',  Could not allocate memory')
    call sysexi(fatale)
  endif
  !
  ! Read input data
  call gdf_read_data(head_in,data_in,error)
  if (error) call sysexi(fatale)
  !
  ! Perform the Fourier transform
  if (sign.eq.1) then
    ! Direct transform
    dims = head_out%gil%dim(2:3)
    call fourt_plan(work,dims,ndim,1,1)
    ! Initialize output data
    data_out = 0.
    ! Do the Fourier transform plane by plane
    do iplane=1,dim3
      work(:,:) = cmplx(data_in(:,:,iplane,1),0.,kind(0.))
      call fourt(work,dims,ndim,1,1,wfft)
      if (do_reorder) call reorder(dim1,dim2,work)
      ! Fill in Gildas data array
      data_out(1,:,:,iplane) = real(work)
      data_out(2,:,:,iplane) = aimag(work)
    enddo
  else
    ! Inverse transform
    dims = head_out%gil%dim(1:2)
    call fourt_plan(work,dims,ndim,-1,1)
    ! Initialize output data
    data_out = 0.
    ! Do the Fourier transform plane by plane
    do iplane=1,dim3
      work(:,:) = cmplx(data_in(1,:,:,iplane),data_in(2,:,:,iplane),kind(0.))
      if (do_reorder) call reorder(dim1,dim2,work)
      call fourt(work,dims,ndim,-1,1,wfft)
      ! Normalize
      work(:,:) = work/real(dim1*dim2)
      ! Fill in Gildas data array
      data_out(:,:,iplane,1) = real(work)
    enddo
  endif
  !
  ! Fill in data of output Gildas cube
  call gdf_write_image(head_out,data_out,error)
  if (error) then
    call gagout('F-'//rname//',  Could not write output image')
    call sysexi(fatale)
  endif
  !
  ! Deallocate memory
  deallocate(data_in,data_out,wfft,work,stat=ier)
  if (ier.ne.0) then
    call gagout('F-'//rname//',  Deallocation error')
    call sysexi(fatale)
  endif
  ! Normal output
  call gagout('I-'//rname//',  Successful completion')
  !
end program fourier
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine reorder(nx,ny,data)
  !---------------------------------------------------------------------
  ! Reorders the Fourier Transform, for easier display. The present version
  ! will only work for even dimensions.
  !---------------------------------------------------------------------
  integer, intent(in)    :: nx           ! 1st Dimension
  integer, intent(in)    :: ny           ! 2nd Dimension
  complex, intent(inout) :: data(nx,ny)  ! Array to reorder
  ! Local
  integer :: i,j
  complex :: tmp
  !
  do j=1,ny/2
    do i=1,nx/2
      tmp                 = data(i+nx/2,j+ny/2)
      data(i+nx/2,j+ny/2) = data(i,j)
      data(i,j)           = tmp
    enddo
  enddo
  !
  do j=1,ny/2
    do i=1,nx/2
      tmp            = data(i,j+ny/2)
      data(i,j+ny/2) = data(i+nx/2,j)
      data(i+nx/2,j) = tmp
    enddo
  enddo
  !
end subroutine reorder
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
