program uv_cal
  use gildas_def
  use gkernel_interfaces
  !
  real(8) :: phase_gain, ampli_gain
  character(len=filename_length) :: uvdata, uvgain, uvcal
  logical :: flag
  logical :: error=.false.
  !
  ! Code:
  call gildas_open
  call gildas_char('UVDATA$',uvdata)
  call gildas_char('UVGAIN$',uvgain)
  call gildas_char('UVCAL$',uvcal)
  call gildas_dble('AMPLI_GAIN$',ampli_gain,1)
  call gildas_dble('PHASE_GAIN$',phase_gain,1)
  call gildas_logi('FLAG$',flag,1)
  call gildas_close
  !
  call sub_uv_cal(uvdata,uvgain,uvcal,ampli_gain,phase_gain,flag,error)
  if (error) call sysexi(fatale)
end program 
!
subroutine sub_uv_cal(uvdata,uvgain,uvcal,ampli_gain,phase_gain,flag,error)
  use gildas_def
  use gkernel_interfaces
  use image_def
  use gbl_message
  !---------------------------------------------------------------------
  ! GILDAS
  ! Apply gains from a table to another table.
  !       The antenna numbers must match  those of the GAIN Table.
  !       There is no specific verification about this.
  ! Input : a UV table (observed)
  ! Input : a UV table, with the gains.
  ! Output: a UV calibrated table
  !---------------------------------------------------------------------
  real(8), intent(in) :: phase_gain ! Phase Gain
  real(8), intent(in) :: ampli_gain ! Amplitude Gain
  character(len=filename_length), intent(in) :: uvdata ! Raw data
  character(len=filename_length), intent(in) :: uvgain ! Gain table
  character(len=filename_length), intent(in) :: uvcal  ! Calibrated data
  logical, intent(in) :: flag       ! Flag or Keep uncalibrated data
  logical, intent(out) :: error     ! Error return value
  ! Global
  real(8), parameter :: pi=3.141592653589793d0
  character(len=*), parameter :: rname='UV_CAL'
  ! Local
  type(gildas) :: gain,raw,self
  integer(4) ::  ib, n, nvis, ncol, nvg, ndc, ier, nblock
  character(len=filename_length) :: name
  character(len=message_length) :: mess
  !
  ! print *,'Phase Gain ',phase_gain
  error = .false.
  !
  ! Input file RAW / name UVDATA 
  n = len_trim(uvdata)
  if (n.le.0) goto 999
  name = uvdata(1:n)
  call gildas_null(raw, type = 'UVT')
  call gdf_read_gildas(raw, name, '.uvt', error, data=.false.)
  if (error) then
    call map_message(seve%e,rname,'Cannot read input UV table ')
    return
  endif
  !
  nvis = raw%gil%dim(2)
  ncol = raw%gil%dim(1)
  ndc = raw%gil%nchan
  !
  ! Prepare output calibrated table  SELF / name UVCAL
  call gildas_null (self, type = 'UVT')
  call gdf_copy_header(raw,self,error)
  n = len_trim(uvcal)
  if (n.eq.0) goto 999
  name  = uvcal(1:n)
  call sic_parsef(name,self%file,' ','.uvt')
  call gagout('I-UV_CAL,  Creating UV table '//trim(self%file))
  call gdf_create_image (self,error)
  if (error) then
    call map_message(seve%e,rname,'Cannot create Calibrated Table')
    return
  endif
  !
  ! Input file GAIN / name UVGAIN
  n = len_trim(uvgain)
  if (n.le.0) goto 999
  call gildas_null(gain, type = 'UVT')
  name = uvgain(1:n)
  call sic_parse_file(name,' ','.uvt',gain%file)
  call gagout('I-UV_CAL,  Reading Gain table '//trim(gain%file))
  call gdf_read_gildas(gain, name, '.uvt', error, data=.true.)
  if (error) then
    call map_message(seve%e,rname,'Cannot read gain Table')
    return
  endif
  nvg = gain%gil%dim(2)
  !
  ! Define blocking factor, on largest data file, usually the input one
  ! but not always...
  call gdf_nitems('SPACE_GILDAS',nblock,raw%gil%dim(1)) ! Visibilities at once
  nblock = min(nblock,raw%gil%dim(2))
  ! Allocate respective space for each file
  allocate (raw%r2d(raw%gil%dim(1),nblock), self%r2d(self%gil%dim(1),nblock), stat=ier)
  if (ier.ne.0) then
    write(mess,*) 'Memory allocation error ',raw%gil%dim(1), nblock
    call map_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! create the image
  call gdf_create_image(self,error)
  if (error) return
  !
  ! Loop over line table - The example assumes the same
  ! number of visibilities in Input and Output, which may not
  ! be true...
  raw%blc = 0
  raw%trc = 0
  self%blc = 0
  self%trc = 0
  !
  do ib = 1,raw%gil%dim(2),nblock
    write(mess,*) ib,' / ',raw%gil%dim(2),nblock
    call map_message(seve%d,rname,mess)
    raw%blc(2) = ib
    raw%trc(2) = min(raw%gil%dim(2),ib-1+nblock)
    self%blc = raw%blc
    self%trc = raw%trc
    nvis = raw%trc(2)-raw%blc(2)+1
    call gdf_read_data(raw,raw%r2d,error)
    !
    call do_outer_cal(ncol,nvis,raw%r2d,ndc,self%r2d,nvg,gain%r2d,  &
                      ampli_gain,phase_gain,flag,error)
    !print *,'Done do_cal ',self%blc(2),self%trc(2),self%gil%dim(2),error
    call gdf_write_data (self,self%r2d,error)
    if (error) return
  enddo
  !
  ! Enfin libre ...
  call gdf_close_image(self, error)
  call gdf_close_image(raw, error)
  if (associated(raw%r2d))   deallocate(raw%r2d)
  if (associated(self%r2d))  deallocate(self%r2d)
  if (associated(gain%r2d))  deallocate(gain%r2d)
  if  (.not.error) call map_message(seve%i,rname,'Successful completion')
  return
  !
  999 call map_message(seve%e,rname,'Missing filename')
  error = .true.
end subroutine sub_uv_cal
!
subroutine do_outer_cal(ncol,nvis,data,ndc,cal,nvg,gain,ampli_gain,  &
  phase_gain,flag,error)
  use gbl_message
  use gkernel_interfaces
  use mapping_interfaces
  use uv_sort, only: uv_findtb
  !---------------------------------------------------------------------
  !  Apply phase and/or amplitude calibration to the "raw" UV data.
  ! Phase and Amplitudes are stored in the "gain" UV table, and usually
  ! come from a previous use of Task uv_gain. This subroutine allows to
  ! apply the corrections to a spectral line table, whatever the way the
  ! gains were computed before.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: ncol             ! Visibility size
  integer(kind=4), intent(in)    :: nvis             ! Number of visibilities
  real(kind=4),    intent(in)    :: data(ncol,nvis)  ! Visibility array
  integer(kind=4), intent(in)    :: ndc              ! Number of channels
  real(kind=4),    intent(out)   :: cal(ncol,nvis)   ! Calibrated visibilities
  integer(kind=4), intent(in)    :: nvg              ! Number of gains
  real(kind=4),    intent(in)    :: gain(10,nvg)     ! Gain array
  real(kind=8),    intent(in)    :: ampli_gain       ! Amplitude gain
  real(kind=8),    intent(in)    :: phase_gain       ! Phase gain
  logical,         intent(in)    :: flag             ! Keep or Flag uncalibrated data
  logical,         intent(inout) :: error            ! Error flag
  ! Local
  integer(kind=4) :: anticol,antjcol,datecol,timecol
  integer(kind=4) :: ivg,jvg,iantg,jantg,minantg,maxantg,dateg
  integer(kind=4) :: ivd,jvd,iantd,jantd,minantd,maxantd,dated
  real(kind=4) :: timeg,timed
  integer(kind=4) :: k,lastivd,diff,cnt
  complex(kind=4) :: zdata,zgain,zcal,zg
  real(kind=4) :: wg
  real(kind=8) :: ampli,phase
  real(kind=8), parameter :: time_tol=1.0d0
  logical :: flagged(nvis),sorted,conj
  integer(kind=4), parameter :: code_sort_ubt=3  ! See module uv_sort_codes
  character(len=message_length) :: mess
  ! Automatic arrays
  integer(kind=4) :: indd(nvis),indg(nvg)
  integer(kind=4) :: rindd(nvis),rindg(nvg)
  real(kind=8) :: keyd(nvis),keyg(nvg)
  !
  datecol = 4  ! hx%gil%column_pointer(code_uvt_date)
  timecol = 5  ! hx%gil%column_pointer(code_uvt_time)
  anticol = 6  ! hx%gil%column_pointer(code_uvt_anti)
  antjcol = 7  ! hx%gil%column_pointer(code_uvt_antj)
  !
  ! Get the chronological order, for both input tables. Tables are
  ! ordered by UNIQUE-BASE then TIME because time is a fuzzy argument,
  ! with a tolerance when matching. This ensures that matches will be
  ! contiguous, and they can also be optimized.
  call uv_findtb(code_sort_ubt,data,nvis,ncol,keyd,indd,rindd,sorted,error)
  if (error)  return
  call uv_findtb(code_sort_ubt,gain,nvg, 10,  keyg,indg,rindg,sorted,error)
  if (error)  return
  ! NB: keyd and keyg can not be correlated in return because they can use
  !     different relative dates.
  !
  ! First setup CAL = DATA by default 
  ! Uncalibrated data will be kept or flagged as desired
  cal(:,:) = data(:,:)
  !
  ! The loop is done on calibration times, so
  ! there is no guarantee that a given data visibility is treated.
  !
  ! To handle this, we set a counter for each visibility, to
  ! check whether it has indeed been affected...
  !
  flagged(1:nvis) = .true.
  lastivd = 0
  !
  do ivg=1,nvg ! For all visibilities in gain table
    jvg = indg(ivg)
    iantg = nint(gain(anticol,jvg))
    jantg = nint(gain(antjcol,jvg))
    if (iantg.lt.jantg) then
      minantg = iantg
      maxantg = jantg
    else
      minantg = jantg
      maxantg = iantg
    endif
    dateg = nint(gain(datecol,jvg))
    timeg = gain(timecol,jvg)
    !
    ! Set up the gain for this time and baseline
    ampli = sqrt(gain(8,jvg)**2+gain(9,jvg)**2)
    phase = atan2(gain(9,jvg),gain(8,jvg))
    if (gain(10,jvg).le.0) ampli = 0.d0
    if (ampli.ne.0.d0) then
      ! Correct (a fraction of) the phase
      phase = phase_gain*phase
      zg = cmplx(cos(phase),sin(phase))
      ampli = 1d0-ampli_gain+ampli*ampli_gain
      zgain = ampli*zg
    else
      ! Reset Zgain to 0
      zgain = 0.0
    endif
    !
    ! Find the data visibilities which have exactly same baseline,
    ! and about the same datetime.
    ivd = lastivd
    do while (ivd.lt.nvis)
      ivd = ivd+1
      jvd = indd(ivd)
      !
      iantd = nint(data(anticol,jvd))
      jantd = nint(data(antjcol,jvd))
      if (iantd.lt.jantd) then
        minantd = iantd
        maxantd = jantd
      else
        minantd = jantd
        maxantd = iantd
      endif
      dated = nint(data(datecol,jvd))
      timed = data(timecol,jvd)
      !
      diff = compare_visi(minantg,maxantg,dateg,timeg,  &
                          minantd,maxantd,dated,timed)
      if (diff.lt.0) then
        ! Data visibility is before current gain visibility
        lastivd = ivd  ! We can safely restart from this one (+1) next time.
        cycle          ! Need to continue iterating data times.
      elseif (diff.gt.0) then
        ! Data visibility is after current gain visibility. No need to go
        ! further we won't find anything useful after this.
        exit
      endif
      ! Ok, this data visibility matches the gain visibility.
      conj = iantd.eq.jantg
      !
      if (zgain.ne.0.0) then
        flagged(jvd) = .false.
        wg = abs(zgain)**2
        do k=8,3*ndc+7,3
          zdata = cmplx(data(k,jvd),data(k+1,jvd))
          if (conj) then
            zcal = zdata/conjg(zgain)
          else
            zcal = zdata/zgain
          endif
          cal(k,  jvd) = real(zcal)
          cal(k+1,jvd) = aimag(zcal)
          cal(k+2,jvd) = data(k+2,jvd)*wg
        enddo
      endif
      !
    enddo
    !
  enddo
  !
  ! Finish by checking what has not been calibrated...
  if (any(flagged)) then
    cnt = 0
    if (flag) then
      ! Uncalibrated data are nullified
      do jvd=1,nvis
        if (flagged(jvd)) then
          ! print *,jvd  ! Too verbose...
          cnt = cnt+1
          cal(8:3*ndc+7,jvd) = 0.0
        endif
      enddo
      write(mess,'(3(A,I0))')  &
        'W-UV_CAL, Flagged ',cnt,' uncalibrated visibilities (total ',nvis,')'
    else
      ! Uncalibrated data is left unmodified
      do jvd=1,nvis
        if (flagged(jvd)) then
          cnt = cnt+1
          ! print *,jvd  ! Too verbose...
        endif
      enddo
      write(mess,'(3(A,I0))')  &
        'W-UV_CAL, ',cnt,' uncalibrated visibilities (total ',nvis,')'
    endif
    call gagout(mess)
  endif
  !
contains
  function compare_visi(a1,a2,ad,at,  &
                        b1,b2,bd,bt)
    !-------------------------------------------------------------------
    ! Compare A and B visibilities according to their first antenna,
    ! then second antenna, then date, then time within tolerance.
    ! Return -1 if A>B, 0 if A=B, +1 if A<B
    !-------------------------------------------------------------------
    integer(kind=4) :: compare_visi
    integer(kind=4), intent(in) :: a1,a2,ad
    real(kind=4),    intent(in) :: at
    integer(kind=4), intent(in) :: b1,b2,bd
    real(kind=4),    intent(in) :: bt
    ! Local
    real(kind=4) :: diff
    !
    ! Compare first antennas
    if (a1.gt.b1) then
      compare_visi = -1
      return
    elseif (a1.lt.b1) then
      compare_visi = +1
      return
    endif
    ! Compare second antennas
    if (a2.gt.b2) then
      compare_visi = -1
      return
    elseif (a2.lt.b2) then
      compare_visi = +1
      return
    endif
    ! Compare dates
    if (ad.gt.bd) then
      compare_visi = -1
      return
    elseif (ad.lt.bd) then
      compare_visi = +1
      return
    endif
    ! Compare times within tolerance
    diff = at-bt
    if (diff.gt.time_tol) then
      compare_visi = -1
    elseif (diff.lt.-time_tol) then
      compare_visi = +1
    else
      compare_visi = 0
    endif
    !
  end function compare_visi
  !
end subroutine do_outer_cal
