!
subroutine apply_comm(line,error)
  use gildas_def
  use gkernel_interfaces
  use imager_interfaces, except_this => apply_comm
  use gbl_message
  use clean_arrays
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Control 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  !! Command line
  logical, intent(inout) :: error       !! Logical error flag
  !
  ! Constants
  character(len=*), parameter :: rname='CALIBRATE'
  real(8), parameter :: pi=3.141592653589793d0
  integer, parameter :: o_flag=2, o_file=1
  integer, parameter :: mmode=3
  character(len=12) :: smode(mmode)
  data smode /'AMPLITUDE','DELAY','PHASE'/
  !
  ! 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
  character(len=12) :: mode, argum
  character(len=32) :: chain
  !
  ! /FILE option variables
  character(len=filename_length) :: file
  type (gildas) :: uvin, uvou
  logical :: dofile, err
  integer :: nblock, ib, nf, narg
  !
  ! Code ----
  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_current)
    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
    ! Re-select the UV data SG
!    call uvdata_select(rname,error) ! Perhaps
    !
    ! In memory version
    nvis = huv_current%gil%nvisi ! not %dim(2)
    ncol = huv_current%gil%dim(1)
    ndc =  huv_current%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)
    if (error) return
    !
    call uv_clean_buffers (duv_previous, duv_next,error)
    !
    ! Signal the change in UV data - Self Calibration also affects Weights
    call uv_new_data (weight=.true.)
  endif
end subroutine apply_comm 
!
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            !! Logical Error Flag
  !
  ! Constants
  character(len=*), parameter :: rname='CALIBRATE'
  integer, parameter :: mant=256  ! ALMA maximum, after renumbering
  !
  ! Local ---
  integer :: iv, jv, k, ivg, jvg, ia, ja, kv, isev, ier, ncold
  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
  complex, allocatable :: zvis(:)
  !
  ! Code ----
  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)
  !
  allocate(zvis(nvis),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  ! 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 = ' '
  !
  if (debug.ne.0) Print *,'Starting solution search'
  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.gt.1)         Print *, 'ivg, jvg, tg, tgold'
    if (debug.gt.1)         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
        if (t.ge.tgold-time_step) then
          ia = nint(data(6,jv))
          ja = nint(data(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)
            zvis(jv) = zg   ! Remember complex gain
          else
            zvis(jv) = 1.0  ! No correction at all
          endif
        endif
        iv = iv+1
        if (iv.gt.nvis) exit
        t = times(iv)
        jv = index(iv)
        if (debug.gt.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.gt.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.gt.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.gt.0) Print *,'Set ',ia,ja,zgain(ia,ja),gain(10,jvg)
      endif
    endif
  enddo
  !
  if (debug.ne.0) Print *,'Applying calibration '
  ncold = 7+3*ndc   ! Last data column
  !$OMP PARALLEL DEFAULT(none) &
  !$OMP & SHARED(data,cal,flagged,zvis,nvis,ncol,ncold,do_flag) &
  !$OMP & PRIVATE(jv,zg,gg,wg,zdata,zcal,k)
  !$OMP DO
  do jv=1,nvis
    if (flagged(jv).eq.0) then
      cal(:,jv) = data(:,jv)    ! Copy visibility
      zg = zvis(jv)             ! Retrieve complex gain
      ! Down weight all points with amplitude correction.
      !   Down-weights those which have been increased in flux,
      ! as the noise has 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, ncold, 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 (do_flag) then
      cal(1:7,jv) = data(1:7,jv)        ! Keep information
      cal(8:ncold,jv) = 0.0            ! Nullify visibility
      if (ncol.gt.ncold) cal(ncold+1:,jv) = data(ncold+1:,jv) ! Trailing
    else
      cal(:,jv) = data(:,jv)    ! Copy visibility "as is", uncalibrated
    endif
  enddo
  !$OMP ENDDO
  !$OMP END PARALLEL
  !
  iv_first = 0
  iv_last  = 0
  kv = sum(flagged)             ! Number of un-calibrated visibilitie
  !
  if (do_flag.and.(kv.lt.1000)) 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
      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,' 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   !! First visibility of range
  integer, intent(inout) :: iv_last    !! Last visibility of range
  integer, intent(inout) :: lc         !! Current length of CFLAG
  character(len=*), intent(inout) :: cflag  !! Character string to be appended
  !
  ! Local ---
  integer :: nf, mc
  !
  ! Code ----
  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  

