!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module uv_time
  use gbl_message
  !
  public :: uv_time_comm
  private
  !
contains
  !
  subroutine uv_time_comm(line,error)
    use phys_const
    use image_def
    use gkernel_interfaces
    use uvmosaic_tool, only: mosaic_sort
    use file_buffers
    use uv_buffers
    use uvmap_buffers, only: uvmap_prog
    !---------------------------------------------------------------------
    ! Time-Average the UV Table (usefull for ALMA data, although
    ! it is more efficient to do that on the original UV table
    ! before reading it).
    !
    ! UV_TIME Time /Weight Wcol
    !
    ! Works on the "current" UV data set: Uses UVS or UVR as needed.
    !---------------------------------------------------------------------
    character(len=*), intent(in)  :: line
    logical,          intent(out) :: error
    !
    logical :: shift,sorted
    integer(4) :: wcol
    integer :: ntime,mtime,first_time,last_time
    integer :: nu,nv,mv
    integer :: first,fstart,fend
    integer :: iv,jv,kv,lv,it,ier,mvisi,maxant
    integer :: ifield,np,nvout,ixoff,iyoff
    integer, allocatable :: voff(:)
    integer, allocatable :: ip(:),ftime(:),ltime(:)
    real(4) :: mytime
    real :: uvmax,uvmin
    real :: rmax,diam
    real(8) :: new(3)
    real(8) :: old_time,t0
    real, pointer :: duv_previous(:,:),duv_next(:,:)
    real, allocatable :: din(:,:)
    real(4), allocatable :: doff(:,:)
    real(8), allocatable :: times(:),ttime(:)
    type (gildas) :: hcuv
    character(len=64) :: mychain
    character(len=message_length) :: mess
    character(len=*), parameter :: rname='UV>TIME>COMM'
    !
    if (uvmap_prog%nfields.ne.0) call map_message(seve%w,rname,'UV data is a Mosaic')
    !
    shift = .false.
    new = 0.d0
    !
    !
    if (.not.sic_present(0,1)) then
       call uvgmax(huv,duv,uvmax,uvmin)
       !
       call sic_get_real('UV_CELL[1]',diam,error)
       if (diam.eq.0) then
          call map_message(seve%e,rname,'UV_CELL[1] is not specified')
          error = .true.
          return
       endif
       mytime = nint(diam/(4*pi*uvmax)*86400)
       write(mychain,*) 'Smoothing to ',mytime
       call map_message(seve%i,rname,mychain)
    else
       call sic_r4(line,0,1,mytime,.true.,error)
       if (error) return
    endif
    !
    wcol = 0
    call sic_i4(line,1,1,wcol,.false.,error)
    if (error) return
    !
    ! The UV table is available in HUV%
    if (huv%loca%size.eq.0) then
       call map_message(seve%e,rname,'No UV data loaded')
       error = .true.
       return
    endif
    nu = huv%gil%dim(1)
    nv = huv%gil%dim(2)
    !
    if (uvmap_prog%nfields.eq.0) then
       ! Read the Time Baseline information, and verify it is sorted
       allocate (times(nv), ip(nv), stat=ier)
       if (ier.ne.0) then
          call map_message(seve%e,rname,'Memory allocation error')
          error = .true.
          return
       endif
       !
       t0 = duv(4,1) ! First date
       maxant = 0
       do iv = 1, nv
          times(iv) = (duv(4,iv)-t0)*86400.d0+duv(5,iv)-duv(5,1)
          rmax = max(duv(6,iv),duv(7,iv))
          maxant = max(maxant,nint(rmax))
       enddo
       !
       ! So here is the maximum number of visibilities per time range
       mvisi = (maxant*(maxant-1))/2
       !
       ! Sort the time array
       call gr8_trie(times,ip,nv,error)
       !
       ! Figure out how many output times
       old_time = -1d10
       ntime = 0
       do iv = 1, nv
          if ((times(iv)-old_time).ge.mytime) then
             old_time = times(iv)
             ntime = ntime+1
          endif
       enddo
       mtime = ntime
       !
       allocate (ttime(mtime), ftime(mtime), ltime(mtime), stat=ier)
       if (ier.ne.0) then
          call map_message(seve%e,rname,'Memory allocation error')
          error = .true.
          return
       endif
       !
       ! Find out the time boundaries
       jv = 0
       ntime = 0
       old_time = -1d10
       do iv = 1, nv
          if ((times(iv)-old_time).ge.mytime) then
             if (ntime.gt.0) ltime(ntime) = iv-1
             old_time = times(iv)
             ntime = ntime+1
             ftime(ntime) = iv
             ttime(ntime) = times(iv)
          endif
       enddo
       ltime(ntime) = nv   ! The last is a time change
       !
       ! Prepare header and allocate buffers
       call gildas_null(hcuv,type='UVT')
       call gdf_copy_header(huv,hcuv,error)
       mvisi = ntime*mvisi     
       hcuv%gil%dim(2) = mvisi
       hcuv%gil%nvisi = mvisi     ! For the time being...
       nullify (duv_previous, duv_next)
       call uv_find_buffers (rname,nu,mvisi,duv_previous,duv_next,error)
       if (error) return
       !
       ! Setup the Weight column
       if (wcol.eq.0) wcol = max(3,huv%gil%nchan)/3
       !
       ! Now do the job
       old_time = ttime(1)
       jv = 1  ! Initialize here
       do it=1,ntime
          !
          first_time = ftime(it)
          last_time = ltime(it)
          ! Some useless debugging...
          !write(mess,*) 'Time ',old_time,' range ',first_time,last_time, ' / ',nv
          !call map_message(seve%i,rname,mess)
          mv = last_time-first_time+1
          allocate (din(nu,mv),stat=ier)
          if (ier.ne.0) then
             call map_message(seve%e,rname,'Memory allocation error')
             error = .true.
             return
          endif
          kv = 0
          do lv = first_time,last_time
             kv = kv+1
             din(:,kv) = duv(:,ip(lv))
          enddo
          if (mv.ne.kv) print *,'Missing antennas on time ',it,kv,mv
          kv = jv
          call time_compress(din,nu,1,mv, &
               wcol, hcuv, duv_next, jv, mvisi, error)
          if (error) then
             write(mess,*) 'Programming error or strange UV table ',jv,' > ',mvisi
             call map_message(seve%e,rname,mess)
             return
          endif
          if (jv.lt.kv) then
             write(mess,*) 'No valid averaged visibility for ',old_time
             call map_message(seve%w,rname,mess)
          endif
          jv = jv+1     ! Point to next one, then...
          old_time = ttime(it)
          deallocate (din)
       enddo
       !
       ! Finalize the UV Table with the right numbers
       hcuv%gil%dim(2)= jv-1 ! Is this allowed ?...
       hcuv%gil%nvisi = jv-1
    else
       ! Make sure the UV table has been sorted by fields first
       call map_message(seve%w,rname,'Sorting mosaic UV table')
       ixoff = huv%gil%column_pointer(code_uvt_xoff)
       iyoff = huv%gil%column_pointer(code_uvt_yoff)
       if (ixoff.eq.0) then
          ixoff = uvi%head%gil%column_pointer(code_uvt_loff)
          iyoff = uvi%head%gil%column_pointer(code_uvt_moff)
       endif
       call mosaic_sort(error,sorted,shift,new,uvmax,uvmin, &
            ixoff,iyoff,np,doff,voff)
       if (error) return
       !
       ! Prepare header and allocate buffers
       call gildas_null(hcuv,type='UVT')
       call gdf_copy_header(huv,hcuv,error)
       nullify (duv_previous, duv_next)
       call uv_find_buffers (rname,nu,nv,duv_previous,duv_next,error)
       if (error) return
       !
       if (wcol.eq.0) wcol = max(3,huv%gil%nchan)/3
       !
       ! Loop over fields to sort each data
       first = 1
       ! This loop cannot be parallelized ...
       do ifield = 1,np
          !
          fstart = voff(ifield)       ! Starting Visibility of field
          fend   = voff(ifield+1)-1   ! Ending Visibility of field
          !
          call time_integrate(rname,huv,mytime,wcol,nu,fend-fstart+1, &
               & duv(:,fstart:fend),duv_next(:,first:),nvout,error)
          if (error) return
          print *,'Field ',ifield,nvout, ' Visibilities from range ',fstart,fend
          first = first+nvout
       enddo
       !
       hcuv%gil%dim(2)= first-1 ! Is this allowed ?...
       hcuv%gil%nvisi = first-1
    endif
    !
    write(mess,'(i12,a,i12,a)') hcuv%gil%nvisi,' Visibilities created (', &
         & huv%gil%nvisi,' before)'
    call map_message(seve%i,rname,mess)
    call uv_clean_buffers (duv_previous, duv_next,error)
    if (error) return
    !
    ! Copy back to UV data set
    call gdf_copy_header(hcuv,huv,error)
    !
    ! Indicate Weights have changed, optimization and save status
    do_weig = .true.
    optimize(code_save_uv)%change = optimize(code_save_uv)%change + 1
    save_data(code_save_uv) = .true.
    ! Redefine SIC variables (mandatory)
    call sic_delvariable ('UV',.false.,error)
    call sic_mapgildas ('UV',huv,error,duv)
  end subroutine uv_time_comm
  !
  subroutine time_compress(invisi,nd,first,last,wcol,out,ovisi,jv,mvisi,error)
    use gildas_def
    use image_def
    use gkernel_interfaces
    !---------------------------------------------------------------------
    ! Time compress a UV table
    ! Compute visibilities for a single output time
    !---------------------------------------------------------------------
    type(gildas), intent(in) :: out
    integer,      intent(in) :: nd             ! Visibility size
    real,         intent(in) :: invisi(:,:)    ! Input visibilities
    integer,      intent(in) :: wcol           ! Weight column
    real,         intent(inout) :: ovisi(:,:)  ! Output visibilities
    integer,      intent(in) :: first, last    ! First and last input visibilities
    integer,      intent(inout) :: jv          ! Current output visibility number
    integer,      intent(in) :: mvisi
    logical,      intent(inout) :: error
    !
    real, allocatable, target :: avisi(:,:), bvisi(:,:)
    real, pointer :: my_visi(:,:)
    integer, allocatable :: tb(:), indx(:)
    integer :: vmax, iant, jant
    integer :: iv, kv, nvisi, ier, icol, ic
    logical :: sorted
    real :: sw
    character(len=*), parameter :: rname='TIME_COMPRESS'
    !
    ! Extract the relevant - A copy is needed in all cases...
    nvisi = last-first+1
    allocate (avisi(nd,nvisi),stat=ier)
    if (ier.ne.0) then
       call map_message(seve%e,rname,'Memory allocation error')
       error = .true.
       return
    endif
    avisi(1:nd,1:nvisi) = invisi(:,first:last)
    !
    ! Sort it by BASELINE.
    ! We do not care about time here, since we are time averaging
    !
    ! Check the order
    allocate (tb(nvisi),stat=ier)
    do iv=1,nvisi
       ! Use the baseline number code as major driver
       if (avisi(7,iv).lt.avisi(6,iv)) then
          tb(iv) = (256*avisi(6,iv)+avisi(7,iv))
       else if (avisi(7,iv).gt.avisi(6,iv)) then
          tb(iv) = (256*avisi(7,iv)+avisi(6,iv))
       else
          ! No Baseline code for Short spacings which have Iant = Jant
          tb(iv) = 0
       endif
    enddo
    sorted = .true.
    vmax = tb(1)
    do iv = 1,nvisi
       if (tb(iv).lt.vmax) then
          sorted = .false.
          exit
       endif
       vmax = tb(iv)
    enddo
    !
    ! Sort it if needed
    if (.not.sorted) then
       allocate(indx(nvisi),bvisi(nd,nvisi),stat=ier)
       if (ier.ne.0) then
          call map_message(seve%e,rname,'Memory allocation error')
          error = .true.
          return
       endif
       do iv = 1,nvisi
          indx(iv) = iv
       enddo
       call gi4_trie(tb,indx,nvisi,error)
       if (error) then
          call map_message(seve%e,rname,'Sorting error')
          return
       endif
       do iv=1,nvisi
          kv = indx(iv)
          bvisi(:,iv) = avisi(:,kv)
       enddo
       my_visi => bvisi
    else
       my_visi => avisi
    endif
    !
    ! Now do the real work for each baseline
    icol = out%gil%nlead+out%gil%natom*wcol
    !
    kv = jv ! Output visibility pointer
    ovisi(:,jv) = 0      ! Current visibility
    sw = 0.0             ! Current running weight
    iant = my_visi(6,1)  ! First antenna
    jant = my_visi(7,1)  ! Last antenna
    do iv=1,nvisi
       if (iant.eq.my_visi(6,iv) .and. jant.eq.my_visi(7,iv)) then
          ! Same antennas... Continue adding 
          ! ... unless it is a Short spacing stuff...
          if (iant.eq.-1 .and. sw.ne.0.0) then
             call mean_visiw(out,ovisi(:,kv),sw)
             kv = kv+1
             if (kv.gt.mvisi) then  ! Test for overflow (normally none...)
                print *,'MVISI ',mvisi,' First ',first, ' Overflow ...'
                print *,'KV ',kv, ' -- Visi ',iv+first-1,' changing from ',iant,jant, &
                     & ' to ',my_visi(6,iv),my_visi(7,iv)
                error = .true.
                return
             endif
          endif
       else if (iant.eq.my_visi(7,iv) .and. jant.eq.my_visi(6,iv)) then
          ! Same antennas, but reversed order...
          !
          ! We take care of reversed visibilities, which could happen
          ! when V is close to zero, and the UV table has been already
          ! sorted. This can be done by changing the Imaginary part of
          ! my_visi as well as u,v (and w in principle...)
          ! print *,iv,' Reversed ',my_visi(1:7,iv)
          my_visi(1,iv) = -my_visi(1,iv)
          my_visi(2,iv) = -my_visi(2,iv)
          my_visi(6,iv) = iant
          my_visi(7,iv) = jant
          do ic=out%gil%fcol+1,out%gil%lcol,3
             my_visi(ic,iv) = -my_visi(ic,iv)
          enddo
       else
          !!     print *,'KV ',kv, ' -- Visi ',iv,' changing from ',iant,jant, &
          !!     & ' to ',my_visi(6,iv),my_visi(7,iv)
          if (sw.ne.0.0) then
             call mean_visiw(out,ovisi(:,kv),sw)
             kv = kv+1
             if (kv.gt.mvisi) then
                print *,'MVISI ',mvisi,' First ',first
                print *,'KV ',kv, ' -- Visi ',iv+first-1,' changing from ',iant,jant, &
                     & ' to ',my_visi(6,iv),my_visi(7,iv)
                error = .true.
                return
             endif
             ovisi(:,kv) = 0.0
          endif
          iant = my_visi(6,iv)
          jant = my_visi(7,iv)
          sw = 0.0
       endif
       !
       ! Once done, Add to Current visibility - 
       ! For the first one, it simply copies it to the output place
       call add_visiw(out,ovisi(:,kv),my_visi(icol,iv),my_visi(:,iv),sw)
    enddo
    !
    if (sw.ne.0.0) then
       jv = kv
       call mean_visiw(out,ovisi(:,kv),sw)
    else
       jv = kv-1
    endif
  end subroutine time_compress
  !
  subroutine add_visiw(out,ovisi,aw,avisi,sw)
    use image_def
    !---------------------------------------------------------------------
    ! Add a visibility to current output one
    !---------------------------------------------------------------------
    type(gildas), intent(in)    :: out      ! Input image header
    real,         intent(inout) :: ovisi(:) ! Output visibilities
    real,         intent(in)    :: aw       ! Input weight
    real,         intent(inout) :: avisi(:) ! Input visibilities
    real,         intent(inout) :: sw       ! Output weight
    !
    integer i
    real :: uv2
    real :: uv2max=12.0**2
    !
    if (aw.le.0) return
    !
    ! This is a patch for old files which have been incorrectly
    ! sorted, without the antennas being swapped...
    if (sw.gt.0) then
       uv2 = (ovisi(1)/sw-avisi(1))**2 + (ovisi(2)/sw-avisi(2))**2
       if (uv2.gt.uv2max) then
          if (ovisi(1)*avisi(1).lt.0) then
             print *,'Continuity problem',sqrt(uv2), &
                  & '(Bad Antenna order ?), Patching data'
             print *,ovisi(1:2)/sw,avisi(1:2)
             avisi(1) = -avisi(1)
             avisi(2) = -avisi(2)
             do i = out%gil%nlead+2,out%gil%natom*out%gil%nchan+out%gil%nlead,out%gil%natom
                avisi(i) = -avisi(i)
             enddo
          endif
       endif
    endif
    !
    ovisi(1:3) = ovisi(1:3)+aw*avisi(1:3)
    ovisi(4:out%gil%nlead) = avisi(4:out%gil%nlead)
    do i = out%gil%nlead+1,out%gil%natom*out%gil%nchan+out%gil%nlead,out%gil%natom
       ovisi(i) = ovisi(i) + aw*avisi(i)
       ovisi(i+1) = ovisi(i+1) + aw*avisi(i+1)
       ovisi(i+2) = ovisi(i+2) + avisi(i+2)   ! Sum the weights
    enddo
    do i=out%gil%lcol+1,out%gil%dim(1)
       ovisi(i) = avisi(i)
    enddo
    sw = sw+aw
  end subroutine add_visiw
  !
  subroutine mean_visiw(out,ovisi,sw)
    use image_def
    !---------------------------------------------------------------------
    ! Normalize the final visibility
    !---------------------------------------------------------------------
    type(gildas), intent(in)    :: out      ! Input image header
    real,         intent(inout) :: ovisi(:) ! Output visibilities
    real,         intent(inout) :: sw       ! Output weight
    !
    integer i
    !
    if (sw.le.0) return
    !
    ovisi(1:3) = ovisi(1:3)/sw
    do i = out%gil%nlead+1,out%gil%natom*out%gil%nchan+out%gil%nlead,out%gil%natom
       ovisi(i) = ovisi(i)/sw
       ovisi(i+1) = ovisi(i+1)/sw
    enddo
  end subroutine mean_visiw
  !
  subroutine time_integrate(rname,huv,mytime,wcol,nu,nv,vin,vout,nvout,error)
    use image_def
    use gkernel_interfaces
    !---------------------------------------------------------------------
    ! Time-Average a UV data set
    !---------------------------------------------------------------------
    character(len=*), intent(in)    :: rname     ! Calling routine
    type(gildas),     intent(in)    :: huv       ! UV Header
    real(4),          intent(in)    :: mytime    ! Integration time
    integer,          intent(in)    :: wcol      ! Weight column
    integer,          intent(in)    :: nu        ! Size of a visibility
    integer,          intent(in)    :: nv        ! Number of input visibilities
    real,             intent(in)    :: vin(:,:)  ! input visibilities
    real,             intent(inout) :: vout(:,:) ! output visibilities
    integer,          intent(out)   :: nvout     ! Number of output visibilities
    logical,          intent(inout) :: error     ! Error flag
    !
    real(8), allocatable :: times(:), ttime(:)
    integer, allocatable :: ip(:), ftime(:), ltime(:)
    real, allocatable :: din(:,:)
    integer :: ier, ntime, mtime
    real(8) :: t0, old_time
    integer :: first_time, last_time
    integer :: it,iv,jv,kv,lv,mv
    integer :: mvisi
    character(len=80) :: mess
    !
    ! Read the Time Baseline information, and verify it is sorted
    allocate (times(nv), ip(nv), stat=ier)
    if (ier.ne.0) then
       call map_message(seve%e,rname,'Memory allocation error')
       error = .true.
       return
    endif
    mvisi = ubound(vout,2)
    !
    t0 = vin(4,1) ! First date
    do iv = 1, nv
       times(iv) = (vin(4,iv)-t0)*86400.d0+vin(5,iv)-vin(5,1)
    enddo
    !
    ! Sort the time array
    call gr8_trie(times,ip,nv,error)
    !
    ! Figure out how many output times
    old_time = -1d10
    ntime = 0
    do iv = 1, nv
       if ((times(iv)-old_time).ge.mytime) then
          old_time = times(iv)
          ntime = ntime+1
       endif
    enddo
    mtime = ntime
    !
    allocate (ttime(mtime), ftime(mtime), ltime(mtime), stat=ier)
    if (ier.ne.0) then
       call map_message(seve%e,rname,'Memory allocation error')
       error = .true.
       return
    endif
    !
    ! Find out the time boundaries
    jv = 0
    ntime = 0
    old_time = -1d10
    do iv = 1, nv
       if ((times(iv)-old_time).ge.mytime) then
          if (ntime.gt.0) ltime(ntime) = iv-1
          old_time = times(iv)
          ntime = ntime+1
          ftime(ntime) = iv
          ttime(ntime) = times(iv)
       endif
    enddo
    ltime(ntime) = nv   ! The last is a time change
    !
    ! Now do the job
    old_time = ttime(1)
    jv = 1  ! Initialize here
    do it=1,ntime
       !
       first_time = ftime(it)
       last_time = ltime(it)
       ! Some useless debugging...
       !!print *,'Time ',old_time,' range ',first_time,last_time, ' / ',nv
       mv = last_time-first_time+1
       allocate (din(nu,mv),stat=ier)
       if (ier.ne.0) then
          call map_message(seve%e,rname,'Memory allocation error')
          error = .true.
          return
       endif
       kv = 0
       do lv = first_time,last_time
          kv = kv+1
          din(:,kv) = vin(:,ip(lv))
       enddo
       if (mv.ne.kv) print *,'Missing antennas on time ',it,kv,mv
       kv = jv
       call time_compress(din,nu,1,mv, wcol, huv, vout, jv, mvisi, error)
       if (error) then
          write(mess,*) 'Programming error or strange UV table ',jv,' > ',mvisi
          call map_message(seve%e,rname,mess)
          return
       endif
       if (jv.lt.kv) then
          write(mess,*) 'No valid averaged visibility for ',old_time
          call map_message(seve%w,rname,mess)
       endif
       jv = jv+1     ! Point to next one, then...
       old_time = ttime(it)
       deallocate (din)
    enddo
    nvout = jv-1
  end subroutine time_integrate
end module uv_time
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!;
