program dft
  use gkernel_interfaces
  use mapping_interfaces
  use image_def
  use phys_const
  use uvmap_def_task
  use clean_mx, only:domima
  !---------------------------------------------------------------------
  ! TASK  Compute a map from a CLIC UV Table
  !	by Direct Fourier Transform
  !---------------------------------------------------------------------
  ! Global
  type (gildas) :: uv
  type (gildas) :: beam
  type (gildas) :: lmv
  type (gildas) :: vlm
  type (par_uvmap) :: map
  ! Local
  logical :: error
  real, allocatable :: pox(:), poy(:), dw(:), uu(:), vv(:)
  real, allocatable :: dbeam(:,:)
  real, allocatable, target :: dvlm(:,:,:)
  real, pointer :: duv(:,:), dlmv(:,:,:)
  !
  integer :: n, ier
  integer :: lcol,fcol,wcol
  integer :: np,nv,nc,nx,ny
  real :: rmi, rma
  integer :: imi, ima, nd
  integer(kind=8) :: ilong
  real(kind=8) :: freq
  real :: cpu1,cpu0, wall
  character(len=80) :: uv_table, map_name, chain
  !
  !------------------------------------------------------------------------
  ! Code:
  call gag_cpu(cpu0)
  call gildas_open
  call gildas_char('UV_TABLE$',uv_table)
  call gildas_char('MAP_NAME$',map_name)
  call gildas_real('UV_TAPER$',map%taper,4)
  call gildas_char('WEIGHT_MODE$',map%mode)
  call gildas_real('MAP_FIELD$',map%field,2)
  if (map%field(1).ne.0.0 .or. map%field(2).ne.0.0) then
     call gagout('W-UV_DFT, MAP_FIELD not supported in this version')
  endif
  call gildas_inte('MAP_SIZE$',map%size,2)
  call gildas_real('MAP_CELL$',map%xycell,2)
  if (map%xycell(1).eq.0.0 .or. map%xycell(2).eq.0.0) then
     call gagout('E-UV_DFT, MAP_CELL shoult be defined in this version')
     goto 999
  endif
  call gildas_real('UV_CELL$',map%uniform,2)
  call gildas_inte('WCOL$',map%channels(3),1)
  call gildas_inte('MCOL$',map%channels,2)
  call gildas_close
  !
  call get_weightmode('UV_DFT',map%mode,error)
  if (error) goto 999
  !
  if (map%mode.eq.'NATU') map%uniform(1) = -1.0
  map%xycell = map%xycell*pi/180.0/3600.0 ! in radians
  !
  ! Input file
  n = len_trim(uv_table)
  if (n.le.0) goto 999
  call gildas_null(uv, type = 'UVT')
  call gdf_read_gildas (uv, uv_table, '.uvt', error)
  if (error) then
    call gagout('F-DFT, Cannot read input UV table '   &
     &      //trim(uv%file) )
    goto 999
  endif
  !
  ier = gdf_range(map%channels,uv%gil%nchan)
  fcol = min(map%channels(1),map%channels(2))
  lcol = max(map%channels(1),map%channels(2))
  map%channels(1) = fcol
  map%channels(2) = lcol
  if (map%channels(3).eq.0) then
    map%channels(3) = (lcol+fcol)/2
  else
    map%channels(3) = max(0,min(map%channels(3),nc))
  endif
  nc = lcol-fcol+1
  wcol = map%channels(3)
  wcol = uv%gil%nlead+3*wcol  ! Weight column now
  !
  ! Prepare weights
  call gagout('I-DFT, preparing weights')
  np = uv%gil%dim(1)                ! Size of one visibility
  nv = uv%gil%dim(2)                ! number of visibility points
  duv => uv%r2d                     ! Point towards UV data values
  allocate (dw(nv),vv(nv),uu(nv),stat=ier)
  if (ier.ne.0) goto 999
  uu(:) = duv(1,:)
  vv(:) = duv(2,:)
  dw(:) = duv(wcol,:)
  !
  ! Compute weights
  call t_doweig (nv,uu,vv,dw,map%uniform(1),map%uniform(2),error)
  if (error) goto 999
  !
  ! Compute taper and normalize weights
  call dotape (np,nv,   &
     &    duv,   &             ! Visibilities
     &    1,2,   &             ! U, V pointers
     &    map%taper,   &       ! UV Taper
     &    dw)                  ! Weight
  wall = sump(nv,dw)
  dw(:) = dw/wall              ! Normalize
  wall = 1e-3/sqrt(wall)       ! Convert to noise prediction
  !
  nx = map%size(1)
  ny = map%size(2)
  !
  ! Compute observing frequency for U,V cell size (with Doppler correction)
  freq = uv%gil%val(1)+uv%gil%fres*(uv%gil%val(1)/uv%gil%freq)*(lcol+fcol)*0.5
  !
  ! Now create beam image
  call gildas_null(beam)
  call t_setbeam(uv,beam,map,2)
  call sic_parse_file(map_name,' ','.beam',beam%file)
  call gagout('I-DFT, Creating beam file '//beam%file)
  !
  allocate(dbeam(nx,ny),stat=ier)
  if (ier.ne.0) then
    call gagout('F-DFT, cannot create output beam image')
    goto 999
  endif
  !
  ! Create image (in order v l m )
  call gildas_null(vlm)
  call gildas_null(lmv)
  call t_setdirty(uv,lmv,map,wall)
  call gdf_transpose_header(lmv,vlm,'312',error)
  if (error)  goto 999
  !
  call sic_parse_file(map_name,' ','.vlm',vlm%file)
  call sic_parse_file(map_name,' ','.lmv',lmv%file)
  !
  allocate (dvlm(nc,nx,ny),stat=ier)
  !
  ! Compute distance coefficients
  allocate( pox(nx), poy(ny), stat=ier)
  call init_axis(pox,nx,vlm%gil%ref(2),vlm%gil%val(2),vlm%gil%inc(2))
  call init_axis(poy,ny,vlm%gil%ref(3),vlm%gil%val(3),vlm%gil%inc(3))
  !
  ! Compute map and beam
  call gag_cpu(cpu1)
  write(chain,'(A,1X,1PG10.3)') 'I-DFT,  Starting image ',cpu1-cpu0
  call gagout(chain)
  call do_map(np,nv,duv,dw,uv%gil%nlead,fcol,   &
     &    freq,nc,nx,ny,   &
     &    dvlm,dbeam,pox,poy)
  !
  call gdf_write_image(beam,dbeam,error)
  deallocate (dbeam,duv)
  !
  ! Transpose
  !
  call gag_cpu(cpu1)
  write(chain,'(A,1X,1PG10.3)') 'I-DFT,  Transposing ',cpu1-cpu0
  call gagout(chain)
  !
  call gagout('I-DFT, Creating map file '//lmv%file)
  if (nc.gt.1) then
     allocate (dlmv(nx,ny,nc),stat=ier)
     call trnpos (nx*ny,nc, dvlm, dlmv)
     nd = nx*ny*nc
     call domima (dlmv,rmi,rma,imi,ima,nd)
  else
     dlmv => dvlm
  endif
  !
  lmv%gil%extr_words = def_extr_words          ! extrema computed
  lmv%gil%rmax = rma
  lmv%gil%rmin = rmi
  ilong = imi
  call gdf_index_to_where (ilong,lmv%gil%ndim,lmv%gil%dim,lmv%gil%minloc)  
  ilong = ima
  call gdf_index_to_where (ilong,lmv%gil%ndim,lmv%gil%dim,lmv%gil%maxloc)  
  call gdf_write_image(lmv, dlmv, error)
  !
  write(chain,'(A,1X,1PG10.3)') 'I-DFT,  Finished ',cpu1-cpu0
  call gagout(chain)
  call sysexi(1)
  !
  999   call sysexi (fatale)
end program dft
!
subroutine do_map(np,nv,visi,we,nlead,lc,   &
     &    freq,nc,nx,ny,map,beam,mapcox,mapcoy)
  integer, intent(in) :: np         ! Size of  visibility
  integer, intent(in) :: nv         ! Number of visibilities
  real, intent(in) :: visi(np,nv)   ! Visibilities
  real, intent(in) :: we(nv)        ! Weights
  integer, intent(in) :: nlead      ! Leading information
  integer, intent(in) :: lc         ! First channel
  real(kind=8), intent(in) :: freq  ! Observatory frequency
  integer, intent(in) :: nc         ! Number of channels
  integer, intent(in) :: nx         ! Size of map
  integer, intent(in) :: ny         ! Size of map
  real, intent(out) :: map(nc,nx,ny)! Map
  real, intent(out) :: beam(nx,ny)  ! Beam
  real, intent(in) :: mapcox(nx)    ! Coordinates in X
  real, intent(in) :: mapcoy(ny)    ! Coordinates in Y
  ! Global
  real(8), parameter :: pi=3.141592653589793d0
  ! Local
  real(kind=8) :: sinu, cosi
  real(kind=8) :: f_to_k                ! (2*pi/clight)*1d6
  parameter (f_to_k = 2.d0*pi/299792458.d-6)
  real(kind=8) :: z
  real(kind=8), allocatable :: kwx(:), kwy(:)
  integer :: ix, iy, ic, iic, irc, iv, ier
  !------------------------------------------------------------------------
  ! Code:
  beam = 0.
  map = 0.
  !
  allocate (kwx(nv),kwy(nv),stat=ier)
  do iv = 1, nv                 ! loop on visibility points
    kwx(iv) = freq * f_to_k * visi(1,iv)    ! Prepare exponential coefficients
    kwy(iv) = freq * f_to_k * visi(2,iv)
  enddo
  !
  ! Take into account conjugate points
  !$OMP PARALLEL DEFAULT(none) &
  !$OMP & SHARED(nx,ny,nv,nc,nlead,lc) &
  !$OMP & SHARED(visi,kwy,kwx,mapcox,mapcoy,we,map,beam) &
  !$OMP & PRIVATE(ix,iy,iv,z,cosi,sinu,irc,iic,ic)
  !$OMP DO
  do iy = 1,ny              ! Loop on pixels
     do ix = 1,nx
        do iv=1,nv
           z = kwy(iv)*mapcoy(iy) + kwx(iv)*mapcox(ix) 
           cosi = cos(z)*we(iv)
           sinu = sin(z)*we(iv)
           beam(ix,iy) = beam(ix,iy)+cosi
           irc = nlead+3*(lc-1)+1
           do ic = 1, nc
              iic = irc+1
              map(ic,ix,iy) = map(ic,ix,iy)   &
     &              + visi(irc,iv)*cosi   &
     &              + visi(iic,iv)*sinu
              irc = irc+3  ! Increment 
           enddo
        enddo
     enddo
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  deallocate(kwx, kwy)
end subroutine do_map
!
subroutine trnpos(nxy,nz,in,out)
  integer :: nxy                  !
  integer :: nz                   !
  real :: in(nz,nxy)              !
  real :: out(nxy,nz)             !
  ! Local
  integer :: i,j
  do j=1,nxy
    do i=1,nz
      out(j,i) = in(i,j)
    enddo
  enddo
end subroutine trnpos
!
subroutine init_axis(axis,n,ref,val,inc) 
  integer :: n                      !
  real :: axis(n)                   !
  real(kind=8) :: ref                     !
  real(kind=8) :: inc                     !
  real(kind=8) :: val                     !
  ! Local
  integer :: k
  do k=1, n
    axis(k) = (k-ref)*inc + val
  enddo
end subroutine init_axis
