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
  real(8), allocatable :: itimg(:), it(:)
  integer, allocatable :: idxg(:), idx(:)
  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)
  !
  ! Get a bunch of memory ...
  allocate (it(nvis), idx(nvis), stat=ier)
  if (ier.ne.0) then
    error = .true.
    call map_message(seve%e,rname,'Visibility work array allocation error')
    return
  endif
  allocate (itimg(nvg), idxg(nvg), stat=ier)
  if (ier.ne.0) then
    error = .true.
    call map_message(seve%e,rname,'Gain work array allocation error')
    return
  endif
  !
  ! 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, &
     &    idx, it, nvg, gain%r2d, idxg, itimg,  &
     &    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  (.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, &
     &    index,times,nvg,gain,indg,timesg,   &
     &    ampli_gain,phase_gain,flag,error)
  !---------------------------------------------------------------------
  ! Mapping Task
  !   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, intent(in) :: ncol            ! Visibility size
  integer, intent(in) :: nvis            ! Number of visibilities
  real, intent(in) :: data(ncol,nvis)    ! Visibility array
  integer, intent(in) :: ndc             ! Number of channels
  real, intent(out) :: cal(ncol,nvis)    ! Calibrated visibilities
  integer, intent(in) :: index(nvis)     ! Visibility Index
  real(8), intent(inout) :: times(nvis)  ! Visibility Time stamp
  integer, intent(in) :: nvg             ! Number of gains
  real, intent(in) :: gain(10,nvg)       ! Gain array
  integer, intent(out) :: indg(nvg)      ! Index in gains
  real(8), intent(out) :: timesg(nvg)    ! Gain time stamp
  real(8), intent(in) :: ampli_gain      ! Amplitude gain
  real(8), intent(in) :: phase_gain      ! Phase gain
  logical, intent(in) :: flag            ! Keep or Flag uncalibrated data 
  logical, intent(out) :: error          ! Error flag
  ! Local
  integer :: iv, jv, k, mant, ivg, jvg, ia, ja
  parameter (mant=256)  ! ALMA maximum, after renumbering
  complex :: zdata, zgain(mant,mant), zcal, zg
  real :: wg
  real(8) :: t, tg, tgold
  real(8) :: ampli, phase
  real(8) :: time_step = 1.0d0
  !
  logical :: flagged(nvis)
  !-----------------------------------------------------------------------
  !
  ! Get the chronological order, for both input tables:
  do iv=1, nvis
    times(iv) = data(4,iv)*86400.d0+data(5,iv)
  enddo
  call gr8_trie (times,index,nvis,error)
  if (error) then
    call gagout('E-UV_CAL,  Error sorting UV Table')
    return
  endif
  !
  do ivg=1, nvg
    timesg(ivg) = gain(4,ivg)*86400.d0+gain(5,ivg)
  enddo
  call gr8_trie (timesg,indg,nvg,error)
  if (error) then
    call gagout('E-UV_CAL,  Error sorting Gain Table')
    return
  endif
  !
  iv = 1
  jv = index(iv)
  ivg = 1
  tgold = timesg(ivg)
  zgain = 0.0
  !
  ! 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.
  jvg = indg(1) ! To suppress compiler warning
  !
  do ivg = 1, nvg+1
    if (ivg.le.nvg) then
      jvg = indg(ivg)
      tg = timesg(ivg)
    else
      ! Last one, force a dummy time change
      tg = tgold+1e20
    endif
    !         type *, 'ivg, jvg, tg, tgold'
    !         type *, ivg, jvg, tg, tgold
    if (tg.ne.tgold) then
      ! Time change, apply calibration
      t = times(iv)
      jv = index(iv)
      do while (t-tgold.le.time_step)
        !               type *, 'iv,jv,t'
        !               type *, iv,jv,t
        if (t.ge.tgold-time_step) then
          flagged(jv) = .false.
          ia = nint(cal(6,jv))
          ja = nint(cal(7,jv))
          !                  type *, ia, ja, zgain(ia,ja)
          if (zgain(ia,ja).ne.0) then
            zg = zgain(ia,ja)
            wg = abs(zg)**2
            do k=8, 3*ndc+7, 3
              zdata = cmplx(data(k,jv),data(k+1,jv))
              zcal = zdata/zg
              cal(k,jv) = real(zcal)
              cal(k+1,jv) = aimag(zcal)
              cal(k+2,jv) = data(k+2,jv)*wg
            enddo
          else
            if (flag) cal(8:3*ndc+7,jv) = 0.0
          endif
        endif
        iv = iv+1
        if (iv.gt.nvis) goto 100 !! Proper finish, no return
        t = times(iv)
        jv = index(iv)
        ! print *, iv, jv, t-tgold
      enddo
      tgold = tg
      zgain = 0.0
    endif
    ! Always fill the baseline gain array
    ! (even if new time !)
    !
    ia = nint(gain(6,jvg))
    ja = nint(gain(7,jvg))
    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
    if (ampli.ne.0) then
      !
      ! Correct (a fraction of) the phase
      phase = phase_gain*phase
      zg = cmplx(cos(phase),sin(phase))
      !
      ampli = 1d0-ampli_gain+ampli*ampli_gain
      zg = ampli*zg
      !
      ! Fill both baseline directions...
      zgain(ia,ja) = zg
      zgain(ja,ia) = conjg(zg)
    else
      ! Reset Zgain to 0
      zgain = 0.0
    endif
    !            type *, ia, ja, zGAIN(IA,JA)
  enddo
  !
  ! Finish by checking what has been calibrated...
100 continue
  if (any(flagged)) then
    if (flag) then
      Print *,'Flagged visibilities '
      do iv = 1,nvis
        if (flagged(iv)) then
          Print *,iv
          cal(8:3*ndc+7,iv) = 0.0
        endif
      enddo
    else
      Print *,'Uncalibrated visibilities '
      do iv = 1,nvis
        if (flagged(iv)) then
          Print *,iv
        endif
      enddo
    endif
  endif
end subroutine do_outer_cal
