!-----------------------------------------------------------------------
! The use of UV buffers in Mapping
!
! Mapping has three virtual UV buffers, named
! "UVI" (Initial), "UVS" (Sorted) and "UVR" (Resampled).
! UVR and UVS are used indifferently, depending on which one is
! available, rather than using UVS only for sorting and UVR only
! for Resampling. Only one of those two is allocated at any time
! (except temporarily when using one as input and the other as output).
!
! UVR and UVS may point to UVI, as sorting is not always needed.
!
! Command READ uses UVI, and nullifies or deallocate UVR and UVS.
!
! Commands UV_MAP, UV_CONT, UV_TIME, UV_RESIDUAL, UV_COMPRESS
! and UV_RESAMPLE use the UVR and UVS buffers.
!   A little tricky logic allows to select UVS or UVR
! for the output, depending on which one is busy as input,
! allocating on demand as needed.
!
! Through the use of a pointer, "UV" (actually a header
! HUV and a pointer to the data DUV), the so-called "current UV data"
! points towards one of them, depending on the last issued commands.
!
! Other commands like UV_BASELINE, UV_FILTER, UV_REWEIGHT or UV_FLAG
! work on the "current UV data". UV_FLAG is partially reversible.
!
! Finally, UV_SORT does not affect the "current UV data", but produces
! a transposed copy of it (which thus cannot be written by WRITE UV),
! called UVT.
!
! The whole thing is a little complex and perhaps should be changed.
!
! In addition to the buffer use, the code must account for the
! weight computation optimization.
!
! NOTE: In an earlier version, commands UV_COMPRESS and UV_RESAMPLE 
! only worked with UVI as input. This makes little sense, as a 
! combination of UV_TIME - UV_COMPRESS did not give the same as 
! UV_COMPRESS - UV_TIME for example. The only "nice" feature of 
! this behaviour was to allow the spectral resampling to start 
! from the full resolution data.
!
! The original data can always be recovered through a READ, which
! is optimized by proper caching if no modification has been done
! to the data.
!-----------------------------------------------------------------------
subroutine uv_select_buffer(rname,nu,nv,error)
  use clean_def
  use clean_arrays
  use clean_types
  use gbl_message
  use mapping_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !
  !   Select the next available UV buffer (UVR or UVS) for
  ! commands using them.
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname  ! Caller's name
  integer, intent(in) :: nu              ! Visibility size
  integer, intent(in) :: nv              ! Number of visibilities
  logical, intent(out) :: error          ! Error flag
  !
  integer :: ier
  !
  if (associated(duvr)) then
    allocate (duvs(nu,nv),stat=ier)
    if (ier.ne.0) then
      error = .true.
      call map_message(seve%f,rname,'Memory allocation failure on UVS')
      return
    endif
    if (associated(duvr,duvi)) then
      nullify(duvr)
    else if (associated(duvr)) then
      deallocate (duvr)     ! Free the old one
    endif
    duv => duvs             ! Point to new one
  else
    allocate (duvr(nu,nv),stat=ier)
    if (ier.ne.0) then
      error = .true.
      call map_message(seve%f,rname,'Memory allocation failure on UVR')
      return
    endif
    if (associated(duvs,duvi)) then
      nullify(duvs)
    else if (associated(duvs)) then
      deallocate (duvs)      ! Free the old one
    endif
    duv => duvr               ! Point to new one
  endif
  optimize(code_save_uv)%change = optimize(code_save_uv)%change+1
  error = .false.
end subroutine uv_select_buffer
!
subroutine uv_reset_buffer(rname)
  use gkernel_interfaces
  use clean_def
  use clean_arrays
  use clean_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Reset pointers to UV datasets (back to UVI). Deallocate
  ! UVR or UVS if needed, as well as the "transposed" buffer UVT
  !---------------------------------------------------------------------
  character(len=*) :: rname
  !
  logical error
  !
  ! What happens no compressed data is defined ?
  ! well we have to set the same pointers DUV and DUVR as in READ...
  !
  if (allocated(duvt)) deallocate (duvt)        ! UV data not plotted
  uv_plotted = .false.
  !
  if (.not.allocated(duvi)) then
    call map_message(seve%w,rname,'No UV data (DUVI not allocated)')
    return
  endif
  !
  ! Find out which one DUVI is pointing about
  if (associated(duvr,duvi)) then
    !!Print *,'DUVR was pointing towards DUVI'
    nullify(duvr)
  else if (associated(duvr)) then
    !!Print *,'DUVR was allocated '
    deallocate (duvr)     ! Free the old one
  else
    !!Print *,'DUVR not allocated '
  endif
  if (associated(duvs,duvi)) then
    !!Print *,'DUVS was pointing towards DUVI'
    nullify(duvs)
  else if (associated(duvs)) then
    !!Print *,'DUVS was allocated '
    deallocate (duvs)     ! Free the old one
  else
    !!Print *,'DUVS not allocated '
  endif
  !
  call gdf_copy_header(huvi,huv, error)
  !
  duvr => duvi     ! As in READ
  !
  ! This means we were already pointing to the previous UV data set
  if (associated(duv,duvi)) return
  !
  ! Here we point back...
  if (optimize(code_save_uv)%change.gt.1) then
    optimize(code_save_uv)%change = optimize(code_save_uv)%change - 1
    call map_message(seve%i,rname,'Returning to previous UV data set')
  else
    optimize(code_save_uv)%change = 0
    call map_message(seve%i,rname,'Returning to original UV data set')
  endif
  duv => duvi
  do_weig = .true. ! Recompute weight
  call sic_delvariable ('UV',.false.,error)
  call sic_delvariable ('UVS',.false.,error)
  !
end subroutine uv_reset_buffer
!
subroutine uv_dump_buffers(rname)
  use clean_def
  use clean_arrays
  use gbl_message
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Dump the allocation status of the UV buffers. (Debugging only)
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname  ! Caller's name
  !
  integer(kind=index_length) :: udim(2)
  logical :: error
  !
  if (associated(duvr)) then
    if (associated(duvr,duvi)) then
      call map_message(seve%w,rname,'DUVR associated to DUVI')
    else
      call map_message(seve%w,rname,'DUVR allocated')
    endif
    !
    ! Redefine SIC variables
    udim(1) = ubound(duvr,1)
    udim(2) = ubound(duvr,2)
    call sic_delvariable ('UVR',.false.,error)
    call sic_def_real ('UVR',duvr,2,udim,.false.,error)
  else
    call map_message(seve%w,rname,'no DUVR ...')
  endif
  !
  if (associated(duvs)) then
    if (associated(duvs,duvi)) then
      call map_message(seve%w,rname,'DUVS associated to DUVI')
    else
      call map_message(seve%w,rname,'DUVS allocated')
    endif
    ! Redefine SIC variables
    udim(1) = ubound(duvs,1)
    udim(2) = ubound(duvs,2)
    call sic_delvariable ('UVS',.false.,error)
    call sic_def_real ('UVS',duvs,2,udim,.false.,error)
  else
    call map_message(seve%w,rname,'no DUVS ...')
  endif
  !
  if (allocated(duvt)) call map_message(seve%w,rname,'Transposed buffer allocated.')
  !
  if (associated(duv,duvi)) then
    call map_message(seve%w,rname,'DUV associated to DUVI')
  else if (associated(duv,duvr)) then
    call map_message(seve%w,rname,'DUV associated to DUVR')
  else if (associated(duv,duvs)) then
    call map_message(seve%w,rname,'DUV associated to DUVS')
  else if (associated(duv)) then
    call map_message(seve%w,rname,'DUV is not associated to ???')
  else
    call map_message(seve%w,rname,'DUV is undefined')
  endif

end subroutine uv_dump_buffers
!
subroutine uv_free_buffers
  use clean_def
  use clean_arrays
  !---------------------------------------------------------------------
  ! MAPPING
  !   Deallocate all UV buffers.
  !---------------------------------------------------------------------
  integer ier
  !
  ! Free the previous zone
  !!Print *,'Into free_uvdata '
  if (associated(duvr)) then
    if (associated(duvr,duvi)) then
      nullify(duvr)
      !!print *,'Nullify duvr'
    else
      !!print *,'Deallocate duvr'
      deallocate(duvr,stat=ier)
    endif
  endif
  if (associated(duvs)) then
    if (associated(duvs,duvi)) then
      !!print *,'Nullify duvs'
      nullify(duvs)
    else
      !!print *,'Deallocate duvs'
      deallocate(duvs,stat=ier)
    endif
  endif
  if (allocated(duvi)) deallocate(duvi,stat=ier)
  if (allocated(duvt)) deallocate(duvt,stat=ier)
  !!Print *,'Done free_uvdata'
end subroutine uv_free_buffers
!
subroutine uv_find_buffers (rname,nu,nv,duv_previous, duv_next,error)
  use clean_arrays
  use gbl_message
  use mapping_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !
  ! MAPPING
  !   Find the next available UV buffer (UVR or UVS).
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname  ! Caller's name
  integer, intent(in) :: nu   ! Size of a visiblity
  integer, intent(in) :: nv   ! Number of visibilities
  real, pointer, intent(out) :: duv_previous(:,:)
  real, pointer, intent(out) :: duv_next(:,:)
  logical, intent(out) :: error
  !
  integer :: ier
  !
  if (associated(duvr)) then
    allocate (duvs(nu,nv),stat=ier)
    if (ier.ne.0) then
      error = .true.
      call map_message(seve%f,rname, &
      & 'UV_FIND_BUFFERS: Memory allocation failure on UVS')
      return
    endif
    call map_message(seve%d,rname,'Storing in DUVS')
    duv_previous => duvr
    duv_next => duvs
  else
    allocate (duvr(nu,nv),stat=ier)
    if (ier.ne.0) then
      error = .true.
      call map_message(seve%f,rname, &
      & 'UV_FIND_BUFFERS: Memory allocation failure on UVR')
      return
    endif
    call map_message(seve%d,rname,'Storing in DUVR')
    duv_previous => duvs
    duv_next => duvr
  endif
  error = .false.
end subroutine uv_find_buffers
!
subroutine uv_clean_buffers(duv_previous,duv_next,error)
  use clean_arrays
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !
  ! MAPPING
  !   Take care of freeing the unused UV buffer, and set UV to point to
  ! the new one.
  !---------------------------------------------------------------------
  real, pointer, intent(inout) :: duv_previous(:,:)
  real, pointer, intent(inout) :: duv_next(:,:)
  logical, intent(in) :: error
  !
  if (associated(duv_previous,duvr)) then
    if (error) then
      deallocate(duvs)
      nullify (duv_previous, duv_next)
      return
    endif
    !
    if (associated(duvr,duvi)) then
      nullify(duvr)
    else
      deallocate (duvr)      ! Free the old one
    endif
    duv => duvs              ! Point to new one
  else if (associated(duv_previous,duvs)) then
    if (error) then
      deallocate(duvr)
      nullify (duv_previous, duv_next)
      return
    endif
    !
    if (associated(duvs,duvi)) then
      nullify(duvs)
    else
      deallocate (duvs)     ! Free the old one
    endif
    duv => duvr             ! Point to new one
  endif
end subroutine uv_clean_buffers

subroutine uv_discard_buffers(duv_previous,duv_next,error)
  use clean_arrays
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !
  ! MAPPING
  !   Take care of freeing the last used UV buffer, and reset 
  !   UV to point to the previous one.
  !---------------------------------------------------------------------
  real, pointer, intent(inout) :: duv_previous(:,:)
  real, pointer, intent(inout) :: duv_next(:,:)
  logical, intent(in) :: error
  !
  if (associated(duv_next,duvr)) then
    if (error) then
      deallocate(duvr)
      nullify (duv_previous, duv_next)
      return
    endif
    !
    if (associated(duvr,duvi)) then
      nullify(duvr)
    else
      deallocate (duvr)      ! Free it 
    endif
    duv => duvs              ! Point to new one
  else if (associated(duv_next,duvs)) then
    if (error) then
      deallocate(duvs)
      nullify (duv_previous, duv_next)
      return
    endif
    !
    if (associated(duvs,duvi)) then
      nullify(duvs)
    else
      deallocate (duvs)     ! Free it
    endif
    duv => duvr             ! Point to new one
  endif
end subroutine uv_discard_buffers
