!-----------------------------------------------------------------------
! 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.
!-----------------------------------------------------------------------
!
module uv_buffers
  use gbl_message
  use image_def
  use mapping_types
  use file_buffers
  use uvmap_buffers, only: do_weig
  !
  public :: uv_select_buffer,uv_reset_buffer,uv_free_buffers
  public :: uv_find_buffers,uv_clean_buffers,uv_discard_buffers
  public :: uv_dump_buffers
  !
  public :: uvi,uvtb,uvm
  public :: huv,duv
  public :: duvr,duvs
  !
  public :: uv_buffer
  public :: uv_plotted
  public :: do_weig     ! Debug ***JP: What does it mean?
  !
  private
  !
  type(gildas), save, target :: huv        ! Current UV data
  type(mapping_2d_t), save, target :: uvi  ! Initial UV data
  type(mapping_2d_t), save, target :: uvtb ! Time-Baseline sorted UV data, for UV_FLAG
  type(mapping_2d_t), save, target :: uvm  ! Model UV data
  !
  real, pointer :: duv(:,:)   ! Current UV data
  real, pointer :: duvr(:,:)  ! Resampled UV data
  real, pointer :: duvs(:,:)  ! Sorted UV data
  !
  logical, save :: uv_plotted
  !
  type uv_buffer_user_t
   contains
     procedure, public :: init   => uv_buffer_user_init
     procedure, public :: sicdef => uv_buffer_user_sicdef
  end type uv_buffer_user_t
  type(uv_buffer_user_t) :: uv_buffer
  !
contains
  !
  subroutine uv_buffer_user_init(user,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(uv_buffer_user_t), intent(out)   :: user
    logical,                 intent(inout) :: error
    !
    nullify(duvr)
    nullify(duvs)
    call gildas_null(huv, type='UVT')
    call gildas_null(uvi%head,type='UVT')
    call gildas_null(uvtb%head,type='UVT')
    call gildas_null(uvm%head,type='UVT')
  end subroutine uv_buffer_user_init
  !
  subroutine uv_buffer_user_sicdef(user,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(uv_buffer_user_t), intent(inout) :: user
    logical,                 intent(inout) :: error
    !
    integer(kind=index_length) :: dim(4) = 0
    !
    dim(1) = 2
    !***JP: Is the pre-processing for tests?
#if defined(INDEX4) || !defined(BITS64)
    call sic_def_inte('UV_DIM',huv%gil%dim,1,dim,.false.,error)
    if (error) return
    call sic_def_inte('UVS_DIM',uvtb%head%gil%dim,1,dim,.false.,error)
    if (error) return
#else
    call sic_def_long('UV_DIM',huv%gil%dim,1,dim,.false.,error)
    if (error) return
    call sic_def_long('UVS_DIM',uvtb%head%gil%dim,1,dim,.false.,error)
    if (error) return
#endif
    call sic_def_inte('UV_NCHAN',huv%gil%nchan,0,0,.false.,error)
    if (error) return
    !
    !***JP: primary definition of do_weig is in the uvmap_buffers module
    !***JP: unclear whether do_weig related things should happen here or there
    call sic_def_logi('DO_WEIG',do_weig,.false.,error)
    if (error) return
  end subroutine uv_buffer_user_sicdef
  !
  subroutine uv_select_buffer(rname,nu,nv,error)
    !---------------------------------------------------------------------
    ! Select the next available UV buffer (UVR or UVS) for
    ! commands using them.
    !---------------------------------------------------------------------
    character(len=*), intent(in)    :: rname
    integer,          intent(in)    :: nu    ! Visibility size
    integer,          intent(in)    :: nv    ! Number of visibilities
    logical,          intent(inout) :: 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,'Memory allocation failure on UVS')
          return
       endif
       if (associated(duvr,uvi%data)) 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,uvi%data)) 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
    !---------------------------------------------------------------------
    ! 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(uvtb%data)) deallocate (uvtb%data)        ! UV data not plotted
    uv_plotted = .false.
    !
    if (.not.allocated(uvi%data)) 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,uvi%data)) then
       !!print *,'DUVR was pointing towards UVI%DATA'
       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,uvi%data)) then
       !!print *,'DUVS was pointing towards UVI%DATA'
       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(uvi%head,huv,error)
    !
    duvr => uvi%data     ! As in READ
    !
    ! This means we were already pointing to the previous UV data set
    if (associated(duv,uvi%data)) 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 => uvi%data
    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 gkernel_interfaces
    !---------------------------------------------------------------------
    ! Dump the allocation status of the UV buffers. (Debugging only)
    !---------------------------------------------------------------------
    character(len=*), intent(in) :: rname
    !
    integer(kind=index_length) :: udim(2)
    logical :: error
    !
    if (associated(duvr)) then
       if (associated(duvr,uvi%data)) then
          call map_message(seve%w,rname,'DUVR associated to UVI%DATA')
       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,uvi%data)) then
          call map_message(seve%w,rname,'DUVS associated to UVI%DATA')
       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(uvtb%data)) call map_message(seve%w,rname,'Transposed buffer allocated.')
    !
    if (associated(duv,uvi%data)) then
       call map_message(seve%w,rname,'DUV associated to UVI%DATA')
    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
    !---------------------------------------------------------------------
    ! Deallocate all UV buffers.
    !---------------------------------------------------------------------
    !
    integer :: ier
    !
    ! Free the previous zone
    !!print *,'Into free_uvdata '
    if (associated(duvr)) then
       if (associated(duvr,uvi%data)) then
          nullify(duvr)
          !!print *,'Nullify duvr'
       else
          !!print *,'Deallocate duvr'
          deallocate(duvr,stat=ier)
       endif
    endif
    if (associated(duvs)) then
       if (associated(duvs,uvi%data)) then
          !!print *,'Nullify duvs'
          nullify(duvs)
       else
          !!print *,'Deallocate duvs'
          deallocate(duvs,stat=ier)
       endif
    endif
    if (allocated(uvi%data))  deallocate(uvi%data,stat=ier)
    if (allocated(uvtb%data)) deallocate(uvtb%data,stat=ier)
    !!print *,'Done free_uvdata'
  end subroutine uv_free_buffers
  !
  subroutine uv_find_buffers(rname,nu,nv,duv_previous,duv_next,error)
    !---------------------------------------------------------------------
    ! Find the next available UV buffer (UVR or UVS).
    !---------------------------------------------------------------------
    character(len=*), intent(in)    :: rname
    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(inout) :: 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)
    !---------------------------------------------------------------------
    ! 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(inout) :: error
    !
    if (associated(duv_previous,duvr)) then
       if (error) then
          deallocate(duvs)
          nullify (duv_previous, duv_next)
          return
       endif
       !
       if (associated(duvr,uvi%data)) 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,uvi%data)) 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)
    !---------------------------------------------------------------------
    ! 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(inout) :: error
    !
    if (associated(duv_next,duvr)) then
       if (error) then
          deallocate(duvr)
          nullify (duv_previous, duv_next)
          return
       endif
       !
       if (associated(duvr,uvi%data)) 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,uvi%data)) then
          nullify(duvs)
       else
          deallocate (duvs)     ! Free it
       endif
       duv => duvr              ! Point to new one
    endif
  end subroutine uv_discard_buffers
end module uv_buffers
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
