!
subroutine uv_calibrate(line,error)
  use gildas_def
  use gkernel_interfaces
  use imager_interfaces, except_this => uv_calibrate
  use gbl_message
  use clean_arrays
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Support routine for 
  !     CALIBRATE\APPLY [Mode [Gain]] 
  !         [/FILE UvIN [UvOut]] [/FLAG] Threshold
  ! 
  ! Apply gains from the GAIN data set to the UV data set.
  ! If no available solution, keep the data as it was or flag it,
  ! according to the /FLAG option.
  ! Work on current UV data if no /FILE option.
  ! Work in place if /FILE is specified, and no UvOut argument is given
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  ! Global
  character(len=*), parameter :: rname='CALIBRATE'
  real(8), parameter :: pi=3.141592653589793d0
  integer, parameter :: o_flag=2, o_file=1
  ! Local
  character(len=80) :: mess
  real, pointer :: duv_previous(:,:), duv_next(:,:)
  real(8), allocatable :: itimg(:), it(:)
  integer, allocatable :: flagged(:)
  integer, allocatable :: idxg(:), idx(:)
  integer(4) ::  n, nvis, ncol, nvg, ndc, ier
  real(8) :: phase_gain, ampli_gain
  real(8) :: phase_seuil, ampli_seuil
  real(8) :: fdata, fgain ! Reference frequencies for Gain and UV
  real(4) :: gain, seuil
  logical :: do_flag
  integer, parameter :: mmode=3
  character(len=12) :: smode(mmode), mode, argum
  character(len=32) :: chain
  data smode /'AMPLITUDE','DELAY','PHASE'/
  !
  ! /FILE option variables
  character(len=filename_length) :: file
  type (gildas) :: uvin, uvou
  logical :: dofile, err
  integer :: nblock, ib, nf, narg
  !
  error = .false.
  !
  if (hbgain%loca%size.eq.0) then
    call map_message(seve%e,rname,'Gain table is not defined')
    error = .true.
    return
  endif
  !
  !
  gain = 1.0
  seuil = 0 ! 0 means a large number
  do_flag = sic_present(o_flag,0)
  if (do_flag) then
    call sic_r4(line,o_flag,1,seuil,.false.,error)
    if (error) return
  endif
  !
  if (sic_present(0,1)) then
    call sic_ke(line,0,1,argum,n,.true.,error)
    call sic_r4(line,0,2,gain,.false.,error)
    if (error) return
  else
    call sic_get_char('SELF_MODE',argum,n,error)
  endif    
  call sic_ambigs (rname,argum,mode,n,smode,mmode,error)
  if (error) return
  !
  if (gain.lt.0. .or. gain.gt.1.0) then
    call map_message(seve%e,rname,trim(mode)//' gain out of range [0,1]')
    error = .true.
    return
  endif
  write(chain,'(F5.2)') gain
  mess = 'Applying '//trim(mode)//' calibration with gain '//trim(chain)
  call map_message(seve%i,rname,mess)  
  !
  select case(mode)
  case ('AMPLITUDE') 
    ampli_gain = gain
    ampli_seuil = seuil
    phase_gain = 0.0
    phase_seuil = 0.0
  case ('PHASE')
    phase_gain = gain
    phase_seuil = seuil*pi/180d0
    ampli_gain = 0.0
    ampli_seuil = 0.0
  case ('DELAY')
    fgain = gdf_uv_frequency(hbgain)
    fdata = gdf_uv_frequency(huv)
    write(mess,'(A,F10.1,A,F10.1,A)') 'Frequencies : Data ',fdata, ',  Gain table ',fgain,' MHz'
    call map_message(seve%i,rname,mess)  
    phase_gain = gain * fdata/fgain
    phase_seuil = seuil*pi/180d0
    write(mess,'(A,F6.3)',iostat=ier) 'Phase gain is ',phase_gain
    call map_message(seve%i,rname,mess)  
    ampli_gain = 0.0
    ampli_seuil = 0.0
  end select
  !!Print *,'DO_FLAG ', do_flag,' SEUIL ',seuil
  !!Print *,'Phase & Ampli gain ',phase_gain,ampli_gain,' Seuils ',phase_seuil,ampli_seuil
  if (do_flag.and.seuil.ne.0) then
    if (ampli_gain.eq.0) then
      if (seuil.le.0) then
        write(chain,*) seuil
        call map_message(seve%e,rname,'Invalid threshold '//trim(chain) &
          & //' for PHASE or DELAY flagging, must be > 0')
        error = .true.
        return
      endif
      write(mess,'(A,F8.1,A)',iostat=ier) 'Flagging data with phase errors  > ',phase_seuil,' degree'
    else 
      if (seuil.le.1) then
        write(chain,*) seuil
        call map_message(seve%e,rname,'Invalid threshold '//trim(chain) &
          & //' for AMPLI flagging, must be > 1')
        error = .true.
        return
      endif
      write(mess,'(A,F8.1,A)',iostat=ier) 'Flagging data with Amplitude error  > ',ampli_seuil
    endif
    call map_message(seve%i,rname,mess)  
  endif
  !
  ! Now do the job
  nvg = hbgain%gil%dim(2)
  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  
  !
  dofile = sic_present(o_file,0)
  if (dofile) then
    narg = sic_narg(o_file)
    if (narg.lt.1 .or. narg.gt.2) then
      call map_message(seve%e,rname,'/FILE option requires 1 or 2 arguments')
      error = .true.
      return
    endif
    !
    ! Layout for a by-block operation, used by the /FILE option
    !
    call gildas_null (uvin, type = 'UVT')     ! Define a UVTable gildas header
    call gildas_null (uvou, type = 'UVT')     ! Define a UVTable gildas header
    !
    call sic_ch(line,o_file,1,file,nf,.true.,error)
    if (error)  return
    call gdf_read_gildas (uvin, file, '.uvt', error, data=.false.)
    if (error) return
    call gdf_copy_header(uvin,uvou,error)
    !
    if (narg.eq.2) then
      call sic_ch(line,o_file,2,file,nf,.true.,error)
      if (error) return
      call sic_parse_file(file,' ','.uvt',uvou%file)
      if (error) return
      call gdf_create_image(uvou,error)
      if (error) then
        call gdf_close_image(uvin,err)
        return    
      endif
    endif
    !
    ! Define blocking factor on data file
    !
    ! Set the Blocking Factor
    nblock = space_nitems('SPACE_IMAGER',uvin,1)
    ! Allocate respective space for each file
    ncol = uvin%gil%dim(1)
    ndc =  uvin%gil%nchan
    allocate (uvin%r2d(ncol,nblock),uvou%r2d(ncol,nblock), &
      & it(nblock), idx(nblock), flagged(nblock), stat=ier)
    if (failed_allocate(rname,'UV input data',ier,error)) then
      call gdf_close_image(uvin,err)
      if (narg.eq.2) call gdf_close_image(uvou,err)
      return
    endif
    !
    ! Loop over line table
    uvin%blc = 0
    uvin%trc = 0
    !
    do ib = 1,uvin%gil%dim(2),nblock
      write(mess,*) ib,' / ',uvin%gil%dim(2),nblock
      call map_message(seve%i,rname,mess)
      uvin%blc(2) = ib
      uvin%trc(2) = min(uvin%gil%dim(2),ib-1+nblock)
      call gdf_read_data(uvin,uvin%r2d,error)
      if (error) exit
      !
      nvis = uvin%trc(2)-uvin%blc(2)+1
      !
      ! Here do the job 
      call sub_uvcal(ncol,nvis, uvin%r2d, ndc, uvou%r2d, &
         &    idx, it, do_flag, flagged, nvg, duvbg, idxg, itimg,  &
         &    ampli_gain,phase_gain,ampli_seuil,phase_seuil,error)
      !Print *,'Done do_cal ',self%blc(2),self%trc(2),self%gil%dim(2),error
      if (error) return
      !
      if (sic_ctrlc()) then
        error = .true.
        call map_message(seve%e,rname,'Aborted by ^C')
      else
        call gdf_write_data(uvou,uvou%r2d,error)
      endif
      if (error) exit
    enddo
    !
    deallocate(uvin%r2d,uvou%r2d,stat=ier)
    call gdf_close_image(uvin,err)
    error = err.or.error
    if (narg.eq.2) then
      call gdf_close_image(uvou,err)
      error = err.or.error
    endif
    !
  else
    !
    ! In memory version
    nvis = huv%gil%nvisi ! not %dim(2)
    ncol = huv%gil%dim(1)
    ndc =  huv%gil%nchan
    !
    nullify (duv_previous, duv_next)  
    call uv_find_buffers (rname,ncol,nvis,duv_previous, duv_next,error)
    if (error) return
    !
    nvg = hbgain%gil%dim(2)
    !
    ! Get a bunch of memory ...
    allocate (it(nvis), idx(nvis), flagged(nvis), stat=ier)
    if (ier.ne.0) then
      error = .true.
      call map_message(seve%e,rname,'Visibility work array allocation error')
      return
    endif
    !
    call sub_uvcal(ncol,nvis, duv_previous, ndc, duv_next, &
       &    idx, it, do_flag, flagged, nvg, duvbg, idxg, itimg,  &
       &    ampli_gain,phase_gain,ampli_seuil,phase_seuil,error)
      !Print *,'Done do_cal ',self%blc(2),self%trc(2),self%gil%dim(2),error
    if (error) return
    !
    call uv_clean_buffers (duv_previous, duv_next,error)
    !
    ! Self Calibration affects Weights
    call uv_new_data (weight=.true.)
    !! do_weig = .true.
  endif
end subroutine uv_calibrate
!
subroutine sub_uvcal(ncol,nvis,data,ndc,cal, &
     &    index,times,do_flag,flagged,nvg,gain,indg,timesg,   &
     &    ampli_gain,phase_gain,ampli_seuil,phase_seuil,error)
  use imager_interfaces, only : map_message
  use gbl_message
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! @ public
  !
  ! IMAGER
  !      Support routine for command APPLY
  !
  !   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(inout) :: index(nvis)  ! Visibility Index
  real(8), intent(inout) :: times(nvis)  ! Visibility Time stamp
  logical, intent(in) :: do_flag           ! Flag data with no solution
  integer, intent(inout) :: flagged(nvis)  ! Flag work array
  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
  real(8), intent(in) :: ampli_seuil     ! Amplitude threshold for flag
  real(8), intent(in) :: phase_seuil     ! Phase threshold for flag
  logical, intent(out) :: error          ! Error flag
  !
  character(len=*), parameter :: rname='CALIBRATE'
  integer, parameter :: mant=256  ! ALMA maximum, after renumbering
  ! Local
  integer :: iv, jv, k, ivg, jvg, ia, ja, kv, isev
  complex :: zdata, zgain(mant,mant), zcal, zg
  real :: wg, gg
  real(8) :: t, tg, tgold
  real(8) :: ampli, phase, ampli_min, ampli_max
  real(8) :: time_step = 1.0d0
  character(len=80) :: mess, cflag
  !
  integer :: debug,iv_first,iv_last,lc
  real :: time_lapse
  logical :: first
  !
  debug = 0
  call sic_get_inte('DEBUG_APPLY',debug,error)
  time_lapse = 0.9  ! A little less than 1 sec in case integration time is short
  call sic_get_real('SELF_MARGIN',time_lapse,error)
  !
  !---------------------------------------------------------------------
  !
  ! 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 map_message(seve%e,rname,'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 map_message(seve%e,rname,'Error sorting Gain Table')
    return
  endif
  !
  if (ampli_seuil.ne.0) then
    ampli_min = 1./ampli_seuil
    ampli_max = ampli_seuil
  else
    ampli_min = 0.d0
    ampli_max = 1d30
  endif
  !
  iv = 1
  jv = index(iv)
  ivg = 1
  tgold = timesg(ivg)
  zgain = 0.0
  !
  ! 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) = 1
  jvg = indg(1) ! To suppress compiler warning
  cflag = ' '
  !
  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
    if (debug.ne.0)         Print *, 'ivg, jvg, tg, tgold'
    if (debug.ne.0)         Print *, ivg, jvg, tg, tgold
    !
    ! Verify we are in the same "closed-loop" of antennas, i.e.
    ! same time within the allowed tolerance
    if (tg-tgold.gt.time_lapse) 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
        cal(:,jv) = data(:,jv)    ! Copy visibility
        if (t.ge.tgold-time_step) then
          ia = nint(cal(6,jv))
          ja = nint(cal(7,jv))
          if (debug.ge.1) Print *,'Calibrating ',ia, ja, zgain(ia,ja)
          if (zgain(ia,ja).ne.0) then
            flagged(jv) = 0 
            zg = zgain(ia,ja)
            ! Down weight all points with amplitude correction. 
            !   Down-weights those which have been increased in flux, 
            ! as the noise as increased too !...
            !   But do not give more weights to those whose flux has
            ! decreased, as it is a sign of problems anyway...
            ! Hence the min() function below
            gg = abs(zg)
            wg = min(1.0,gg**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
          endif
        endif
        iv = iv+1
        if (iv.gt.nvis) exit
        t = times(iv)
        jv = index(iv)
        if (debug.eq.2) print *,'IV ',iv,' JV ', jv, 't-TGOLD', t-tgold
      enddo
      if (iv.gt.nvis) exit
      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))
    if (debug.ne.0) Print *,'Setting ',ia,ja,GAIN(10,ivg), gain(10,jvg)
    zgain(ia,ja) = 0.0       ! Although already done just above
    !
    ! Sign of weight gain(10,jvg) indicates if there is a solution
    if (gain(10,jvg).gt.0) then   
      ampli = sqrt(gain(8,jvg)**2+gain(9,jvg)**2)
      phase = atan2(gain(9,jvg),gain(8,jvg))
      if (phase_seuil.gt.0) then
        if (abs(phase).gt.phase_seuil) then
          if (debug.ge.1) Print *,'Flagging ',ia,ja,' Phase ',phase,'> ',phase_seuil
          ampli = 0 ! Will be flagged...
        endif
      endif
      !    
      if (ampli.gt.ampli_min .and. ampli.lt.ampli_max) then
        !
        ! Correct (a fraction of) the phase
        phase = phase_gain*phase
        zg = cmplx(cos(phase),sin(phase))
        ! and (a fraction of) the amplitude
        ampli = 1d0-ampli_gain+ampli*ampli_gain
        zg = ampli*zg
        !
        ! Fill both baseline directions...
        zgain(ia,ja) = zg
        zgain(ja,ia) = conjg(zg)
        if (debug.ne.0) Print *,'Set ',ia,ja,zgain(ia,ja),gain(10,jvg)
      endif
    endif
  enddo
  !
  iv_first = 0
  iv_last  = 0
  kv = sum(flagged)
  !
  if (do_flag) then
    first = .true.
    cflag = ' '
    lc = 1
    do iv = 1,nvis
      if (flagged(iv).ne.0) then
        if (iv_first.eq.0) then
          iv_first = iv
          iv_last = iv
        else
          iv_last = iv
        endif
        cal(8:3*ndc+7,iv) = 0.0
      else
        if (iv_last.ne.0) then
          if (first) then
            write(*,*) 'Flagged visibilities: '
            first =.false.
          endif
          call coutput(iv_first,iv_last,cflag,lc)
          iv_first = 0
          iv_last = 0
        endif
      endif
    enddo
  endif
  !
  if (iv_last.ne.0) then
    if (first) write(*,*) 'Flagged visibilities: '
    call coutput(iv_first,iv_last,cflag,lc)
    if (lc.gt.0) write(*,*) cflag
  endif
  !
  if (kv.eq.0) then
    write(mess,'(A,I0,A)') 'Calibrated all ',nvis-kv,' visibilities'
    isev = seve%i
  else if (do_flag) then
    write(mess,'(A,I0,A,I0,A)') 'Calibrated ',nvis-kv,', flagged ',kv, &
      & ' visibilities'
    isev = seve%w
  else
    write(mess,'(A,I0,A,I0,A)') 'Calibrated ',nvis-kv,', kept ',kv, &
      & ' visibilities'
    isev = seve%w
  endif
  call map_message(isev,rname,mess)
end subroutine sub_uvcal
!
subroutine coutput(iv_first,iv_last,cflag,lc)
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Support routine for commands APPLY and SELFCAL APPLY
  !   Printout list of flagged visibilities 
  !---------------------------------------------------------------------  
  integer, intent(inout) :: iv_first, iv_last
  integer, intent(inout) :: lc
  character(len=*), intent(inout) :: cflag
  !
  integer :: nf, mc
  !
  if (iv_last.eq.0) return
  mc = len(cflag)
  ! 
  nf = iv_last-iv_first+1
  if (nf.gt.1) then
    if (lc.gt.mc-24) then
      write(*,*) cflag(1:lc-1)
      lc = 1
    else
      lc = lc+1
    endif
    write(cflag(lc:),'(A,I0,A,I0,A)')  ' [',iv_first,' - ',iv_last,'], ' 
  else
    if (lc.gt.mc-12) then
      write(*,*) cflag(1:lc-1)
      lc = 1
    else
      lc = lc+1
    endif
    write(cflag(lc:),'(1X,I0,A)') iv_first,', '
  endif
  lc = len_trim(cflag)
  iv_first = 0
  iv_last = 0
end subroutine coutput  

