program p_uv_fidelity
  use gildas_def
  use image_def
  use gkernel_interfaces
!
! Compute the radial average fidelity distribution in the UV plane
!
  character(len=filename_length) name1,name2,name3
  logical error
!
  call gildas_open
  call gildas_char('MODEL$',name1)
  call gildas_char('IMAGE$',name2)
  call gildas_char('RESULT$',name3)
  call gildas_close
!
  error = .false.
  call s_uv_fidelity(name1,name2,name3,error)
  if (error) call sysexi (fatale)
end program p_uv_fidelity

subroutine s_uv_fidelity(name1,name2,name3,error)
  use image_def
  use gkernel_interfaces, no_interface=>fourt
  character*(*) name1,name2,name3
  logical error
  !
  type (gildas) :: model,image,result
  real, allocatable :: dmod(:,:),dima(:,:),dres(:,:,:)
  complex, allocatable :: cmod(:,:),cima(:,:), wfft(:), work(:,:)
  integer nx,ny,nn,dim(2),ier,mx,my,i,j, ifact
  real*8 lambda
  character*60 chain
  logical equal
  !
  ! Initialize headers
  call gildas_null(model)
  call gildas_null(image)
  call gildas_null(result)
  !
  ! Read Headers Model & Image 
  call sic_parsef (name1,model%file,' ','.gdf')
  call gdf_read_header (model,error)
  if (error) return
  call sic_parsef (name2,image%file,' ','.lmv-clean')
  call gdf_read_header (image,error)
  if (error) return
  call gdf_compare_shape (model,image,equal)
  if (.not.equal) then
     call gagout('E-UV_FIDELITY,  Model and Simulation do not match')
     error = .true.
     return
  endif
  nx = model%gil%dim(1)
  ny = model%gil%dim(2)
  if (model%gil%ndim .ne. 2) then
     call gagout('E-UV_FIDELITY,  Data cubes not supported')
     error = .true.
     return
  endif
  !
  ifact = 8
  do while (nx*ny*ifact**2.gt.1024*1024)
     ifact = ifact/2
  enddo
  if (ifact.lt.2) then
     ifact = 2
     do while (nx*ny*ifact**2.gt.2048*2048)
        ifact = ifact/2
     enddo
  endif
  ifact = max(ifact,1)
  Print *,'Oversampling factor ',ifact
  !
  ! Read Data Model & Image
  allocate (dmod(nx,ny),stat=ier)
  call gdf_read_data (model,dmod,error)
  if (error) return
  allocate (dima(nx,ny),stat=ier)
  call gdf_read_data (image,dima,error)
  if (error) return
  mx = nx
  my = ny
  nx=ifact*nx
  ny=ifact*ny
  !
  ! Allocate Fourier space
  allocate(cmod(nx,ny),cima(nx,ny),wfft(max(nx,ny)),stat=ier)
  nn = 2
  dim = (/nx,ny/)
  call plunge_real(dmod,mx,my,cmod,nx,ny)
  call fourt (cmod,dim,2,1,1,wfft)
  call plunge_real(dima,mx,my,cima,nx,ny)
  call fourt (cima,dim,2,1,1,wfft)
  !
  ! Define output image
  call gdf_copy_header (image,result,error)
  mx = nx/2
  my = ny/2
  result%gil%ndim = 3
  result%gil%dim(1) = mx
  result%gil%dim(2) = my
  result%gil%dim(3) = 3
  call sic_parsef (name3,result%file,' ','.power')
  allocate(work(nx,ny),stat=ier)
  allocate(dres(mx,my,3),stat=ier)
  work = abs(cima-cmod)
  do j=1,my/2
     do i=1,mx/2
        dres(i+mx/2,j+my/2,1) = work(i,j)
     enddo
     do i=1,mx/2
        dres(i,j+my/2,1) = work(nx-mx/2+i,j)
     enddo
     do i=1,mx/2
        dres(i+mx/2,j,1) = work(i,ny-my/2+j)
     enddo
     do i=1,mx/2
        dres(i,j,1) = work(nx-mx/2+i,ny-my/2+j)
     enddo
  enddo
  work = abs(cmod)
  do j=1,my/2
     do i=1,mx/2
        dres(i+mx/2,j+my/2,2) = work(i,j)
     enddo
     do i=1,mx/2
        dres(i,j+my/2,2) = work(nx-mx/2+i,j)
     enddo
     do i=1,mx/2
        dres(i+mx/2,j,2) = work(i,ny-my/2+j)
     enddo
     do i=1,mx/2
        dres(i,j,2) = work(nx-mx/2+i,ny-my/2+j)
     enddo
  enddo
!
! Get the user units in "m"...
! Oops, quite a difficult problem, isn't it ?
  lambda = 299792458.d-6/result%gil%freq
  Print *,'Lambda ',lambda
  result%gil%inc(1) = lambda / (model%gil%inc(1) * model%gil%dim(1)) / ifact
  result%gil%inc(2) = lambda / (model%gil%inc(2) * model%gil%dim(2)) / ifact
  result%gil%ref(1) = mx/2+1
  result%gil%ref(2) = my/2+1
!
! Compute the fidelity image
  dres(:,:,3) = dres(:,:,2) / dres(:,:,1)
  call gdf_write_image(result,dres,error)
  deallocate (cmod,cima,wfft)
  deallocate (dres,dmod,dima)
end subroutine s_uv_fidelity
!
subroutine plunge_real (r,nx,ny,c,mx,my)
  !-----------------------------------------------------------------
  !     Plunge a Real array into a larger Complex array
  !-----------------------------------------------------------------
  integer nx,ny                      ! size of input array
  real r(nx,ny)                      ! input real array
  integer mx,my                      ! size of output array
  complex c(mx,my)                   ! output complex array
  !
  integer kx,ky,lx,ly
  integer i,j
  !
  kx = nx/2+1
  lx = mx/2+1
  ky = ny/2+1
  ly = my/2+1
  !
  c = 0.0
  do j=1,ny
     do i=1,nx
        c(i-kx+lx,j-ky+ly) = cmplx(r(i,j),0.0)
     enddo
  enddo
end subroutine plunge_real
