program uv_circle
  use gkernel_interfaces
  use image_def
  !---------------------------------------------------------------------
  ! Updated by R.Neri 09/09/93
  !       - Compute maximum uv_radius when QMAX = 0
  !       - Skip over empty regions
  !---------------------------------------------------------------------
  ! Global
  type (gildas) :: huvd
  type (gildas) :: huvo
  !
  ! Local
  character(len=80) :: name, resu
  integer :: n, i, eff_dim, ier, mq, nq
  integer :: nvs, nvi, kvi
  integer, allocatable :: array(:),flag(:)
  real, allocatable :: q(:), meter(:)
  logical :: error
  real :: qstep, qmax, qmin
  !
  call gildas_open
  call gildas_char('UVTABLE$',name)
  call gildas_char('OUTABLE$',resu)
  call gildas_real('QMIN$',qmin,1)
  call gildas_real('QMAX$',qmax,1)
  call gildas_real('QSTEP$',qstep,1)
  call gildas_close
  !
  Print *,'UV_CIRCLE Fortran 90 version'
  n = len_trim(name)
  if (n.eq.0) goto 999
  n = len_trim(resu)
  if (n.eq.0) goto 999
  !
  ! Input file
  call gildas_null(huvd, type = 'UVT')
  error = .false.
  call gdf_read_gildas(huvd,name,'.uvt', error)
  if (error) then
    call gagout ('F-UV_CIRCLE,  Cannot read input table')
    goto 999
  endif
  !
  ! Create New Table   (Y common)
  call gildas_null(huvo, type = 'UVT')
  call gdf_copy_header(huvd,huvo,error)
  call sic_parsef(resu,huvo%file,' ','.uvt')
  call gagout('I-UV_CIRCLE,  Creating  UV table '//   &
     &    trim(huvo%file))
  nvs = huvd%gil%dim(1)
  nvi = huvd%gil%dim(2)
  !
  if (qmax.eq.0) qmax = uv_max (huvd%r2d,nvs,nvi)
  huvo%gil%dim(2) = (qmax-qmin)/qstep
  kvi = huvo%gil%dim(2)
  mq = huvo%gil%dim(2)+1
  allocate (q(mq), meter(mq), flag(mq), array(mq), stat=ier)
  !
  do i=1, mq 
    q(i) = qmin+(i-1)*qstep
  enddo
  write(6,*) mq,q(1:mq)  
  !
  ! Find actual size
  call uv_steps (huvd%r2d,nvs,nvi, &
     &    q,kvi,eff_dim, array,meter,flag,mq)
  huvo%gil%ndim = 2
  huvo%gil%dim(2) = eff_dim
  huvo%gil%dim(3) = 1
  huvo%gil%dim(4) = 1
  allocate (huvo%r2d(huvo%gil%dim(1),huvo%gil%dim(2)),stat=ier)
  !
  nq = int((qmax-qmin)/qstep)
  call circle (nvs,nvi,huvd%gil%nchan,huvd%r2d,   &
     &    nq,huvo%r2d,q,eff_dim,   &
     &    array,meter,mq)
  !
  ! Cleaning
  deallocate(q,meter,flag,array)
  !
  ! Don't forget to reset the number of visibilities
  huvo%gil%nvisi = huvo%gil%dim(2)
  call gdf_create_image(huvo,error)
  call gdf_write_uvall(huvo,huvo%r2d,error)
  !
  call gagout('S-UV_CIRCLE,  Successful completion')
  call sysexi(1)
  !
  999   call sysexi(fatale)
  !
  contains
!<FF>
function uv_max(visx, n1, nvx)
  real :: uv_max                    ! Output result
  integer, intent(in) :: n1         ! Size of a visibility
  integer, intent(in) :: nvx        ! Number of visibilities
  real, intent(in) :: visx(n1,nvx)  ! Visibilities
  ! Local
  integer :: i
  !
  uv_max = 0.0
  do i=1, nvx
    uv_max = max (uv_max,visx(1,i)**2+visx(2,i)**2)
  enddo
  uv_max = sqrt(uv_max)
end function uv_max
!
subroutine uv_steps(visx, n1, nvx, q, nq, eff_dim,   &
     &    array,meter,flag,nsize)
  integer, intent(in) :: n1              ! Size of a visibility
  integer, intent(in) :: nvx             ! Number of a visibilities
  real, intent(in) :: visx(n1,nvx)       ! Visibilities
  integer, intent(in) :: nq              ! Number of radii
  real, intent(in) :: q(nq+1)            ! Radii
  integer, intent(out) :: eff_dim        ! Actual size of radial array
  integer, intent(in) :: nsize           ! Size of radial array
  integer, intent(out) :: array(nsize)   ! Cell value
  real, intent(inout) :: meter(nsize)    ! Cell position
  integer, intent(out) :: flag(nsize)    ! Is there any data ?

  ! Local
  integer :: iq, iv, i
  real :: qq
  !
  flag = 0
  !
  do iv=1, nvx
    qq = sqrt(visx(1,iv)**2+visx(2,iv)**2)
    iq = int( (qq-q(1))/(q(2)-q(1))+1. )
    if (iq.gt.0 .and. iq.le.nq+1) then
      flag(iq) = 1
    endif
  enddo
  !
  eff_dim = 0
  do i=1,nsize
    if (flag(i).ne.0) then
      eff_dim = eff_dim+1
      meter(eff_dim) = (3*q(1)-q(2))/2+(q(2)-q(1))*i
    endif
    array(i) = eff_dim
  enddo
end subroutine uv_steps
!
subroutine circle(n1, nvx, nc, visx, nq, visy, q, eff_dim,   &
     &    array, meter, nsize)
  integer, intent(in) :: n1              ! Size of a visibility
  integer, intent(in) :: nvx             ! Number of a visibilities
  integer, intent(in) :: nc              ! Number of channels 
  real, intent(in) :: visx(n1,nvx)       ! Visibilities
  integer, intent(in) :: nq              ! Number of radii
  real, intent(in) :: q(nq+1)            ! Radii
  integer, intent(in) :: eff_dim         ! Actual size of radial array
  real, intent(out) :: visy(n1, eff_dim) ! Output visibilities        !
  integer, intent(in) :: nsize           ! Size of radial array
  integer, intent(in) :: array(nsize)    ! Cell value
  real, intent(inout) :: meter(nsize)       ! Cell position
  ! Local
  integer :: iq, iv, ic, i, ip, ier
  real :: w, qq
  real, allocatable :: true(:)
  !
  visy = 0.0
  allocate (true(nsize),stat=ier)
  if (ier.ne.0) stop
  !
  true = 0
  ic = (nc+1)/2
  !
  do iv=1, nvx
    qq = sqrt(visx(1,iv)**2+visx(2,iv)**2)
    iq = int( (qq-q(1))/(q(2)-q(1))+1. )
    if (iq.gt.0 .and. iq.le.nq+1) then
      ip = array(iq)
      w = visx(3*ic+7,iv)
      ! Compute true uv distance for the bin (weighted average, using the weight of the central channel)
      if (w.gt.0) then
        true(ip) = true(ip)+w*qq
      endif
      do i=1, nc
        w = visx(3*i+7,iv)
        if (w.gt.0) then
          visy(3*i+5,ip)=visy(3*i+5,ip)+visx(3*i+5,iv)*w
          visy(3*i+6,ip)=visy(3*i+6,ip)+visx(3*i+6,iv)*w
          visy(3*i+7,ip)=visy(3*i+7,ip)+w
        endif 
      enddo
    endif
  enddo
  !
  do iq=1, eff_dim
    w = visy(3*ic+7,iq) ! sum of non flagged weights
    if (w.ne.0) then
      ! at least one non flagged visibility, use true averaged uv distance
      visy(1,iq) = true(iq)/w
    else
      ! no valid visibility in the bin, use nominal uv distance
      visy(1,iq) = meter(iq)
    endif
    do i=1, nc
      w = visy(3*i+7,iq)
      if (w.gt.0) then
        visy(3*i+5,iq)=visy(3*i+5,iq)/w
        visy(3*i+6,iq)=visy(3*i+6,iq)/w
      endif
    enddo
  enddo
  deallocate (true)
end subroutine circle
!
end program uv_circle
