program uv_plugc
  use image_def
  use gkernel_interfaces
  use gbl_format
  !---------------------------------------------------------------------
  ! TASK  UV_PLUGC
  !       Plug a continuum table into a line table, as the first channel
  !
  ! Input :
  !	TABLE$	The line UV table
  !	SELF$	  The continuum UV table to plug in
  !	DTIME$	The smoothing time constant
  !     WCOL$   The column(s) which define the continuum data
  !	SUBT$	Subtract point source model from data
  ! S.Guilloteau 19-Jun-1991
  !---------------------------------------------------------------------
  ! Local
  type (gildas) :: huvc
  type (gildas) :: huvl
  !
  real, allocatable :: uvl(:,:)
  real, allocatable :: uvc(:,:) 
  character(len=80) :: uv_table,self_name,name
  real(8) :: time,stime,dtime
  integer :: wcol(2)
  !
  real(kind=8), allocatable :: ttime(:)
  integer, allocatable :: order(:)
  integer :: nsv,nsc,nc,n,j,ier
  real :: resul(3),factor,rbase(2),reel,imag,uv(2)
  logical :: error
  !
  call gildas_open
  call gildas_char('UV_TABLE$',uv_table)
  call gildas_char('SELF$',self_name)
  call gildas_dble('DTIME$',dtime,1)
  call gildas_inte('WCOL$',wcol,2)
  call gildas_real('SUB$',factor,1)
  call gildas_close
  !
  !
  dtime = 0.5d0*dtime
  !
  ! Open continuum table 
  n = lenc(self_name)
  if (n.le.0) goto 999
  name = self_name(1:n)
  call gildas_null(huvc,'UVT')
  call sic_parsef(name,huvc%file,' ','.uvt')
  call gdf_read_header (huvc,error)
  if (error) then
     call gagout('F-UV_PLUGC,  Cannot read input UV table')
     goto 999
  endif
  if (huvc%char%type(1:9).ne.'GILDAS_UV') then
     call gagout ('F-UV_PLUGC,  Input data is not a UV table')
     goto 999
  endif
  !
  allocate (uvc(huvc%gil%dim(1),huvc%gil%dim(2)),stat=ier)
  call gdf_read_data(huvc,uvc,error)
  !
  nsc = huvc%gil%nchan
  wcol(1) = min(max(1,wcol(1)),nsc)
  if (wcol(2).eq.0) then
    wcol(2) = nsc
  else
    wcol(2) = max(1,min(wcol(2),nsc))
  endif
  !
  ! Open line table
  n = lenc(uv_table)
  if (n.le.0) goto 999
  name = uv_table(1:n)
  call gildas_null(huvl,'UVT')
  call sic_parsef(name,huvl%file,' ','.uvt')
  call gdf_read_header (huvl,error)
  if (error) then
     call gagout('F-UV_PLUGC,  Cannot read input UV table')
     goto 999
  endif
  if (huvl%char%type(1:9).ne.'GILDAS_UV') then
     call gagout ('F-UV_PLUGC,  Input data is not a UV table')
     goto 999
  endif
  !
  allocate (uvl(huvl%gil%dim(1),huvl%gil%dim(2)),stat=ier)
  call gdf_read_data(huvl,uvl,error)
  nc = (huvl%gil%dim(1)-7)/3
  !
  ! Sort self-cal table
  ! Load time variable and sort by time order
  nsv = huvc%gil%dim(2)
  allocate (ttime(nsv),order(nsv),stat=ier)
  call dotime (huvc%gil%dim(1),huvc%gil%dim(2),uvc, &
     &    ttime,order,stime)
  !
  ! Loop over line table
  do j=1,huvl%gil%dim(2) 
      !
      ! Get time and baseline
      call getiba (uvl(1,j),stime,time,rbase,uv)
      !
      ! Compute the observed reference visibility for that baseline
      call geself (huvc%gil%dim(1),huvc%gil%dim(2),wcol,uvc,   &
     &        time,dtime,ttime,order, &
     &        rbase,resul,uv)
      !
      ! No data: flag
      if (resul(3).eq.0) then
        call doflag (nc,uvl(1,j))
      else
        ! Compute fraction of source to remove
        reel = factor*resul(1)
        imag = factor*resul(2)
        ! Remove source
        call doplugc (nc,uvl(1,j),reel,imag,resul(3))
      endif
  enddo
  !
  call gdf_write_image(huvl,uvl,error)
  call gagout('S-UV_PLUGC,  Successful completion')
  call sysexi(1)
  999   call sysexi(fatale)
end program uv_plugc
!<FF>
subroutine doplugc (nc,visi,sreel,simag,weigh)
  !---------------------------------------------------------------------
  ! TASK	Self-Calibration
  !	Apply the self-calibration factor to the current visibility
  !	Set weight to zero if no self-cal factor
  ! Argument
  !	VISI	R*(*)	Visibility
  !	SREEL	R	Real part of source to be subtracted
  !	SIMAG	R	Imaginary part of source to be subtracted
  !---------------------------------------------------------------------
  integer :: nc                     !
  real :: visi(*)                   !
  real :: sreel                     !
  real :: simag                     !
  real :: weigh                     !
  !
  visi(5+3*nc) = sreel
  visi(6+3*nc) = simag
  visi(7+3*nc) = weigh
end
!<FF>
subroutine doflag (nc,visi)
  !---------------------------------------------------------------------
  ! TASK	Self-Calibration
  !	Apply the self-calibration factor to the current visibility
  !	Set weight to zero if no self-cal factor
  ! Argument
  !	NC	I	Number of channels
  !	VISI	R*(*)	Visibility
  !---------------------------------------------------------------------
  integer :: nc                     !
  real :: visi(*)                   !
  ! Local
  integer :: i
  !
  ! Set weight to zero if no self-cal data
  do i=10,7+3*nc,3
    visi(i) = 0.0
  enddo
end
!<FF>
subroutine getiba (visi,stime,time,base,uv)
  !---------------------------------------------------------------------
  ! TASK	Self-Calibration
  !	Get time offset and baseline from visibility
  ! Arguments
  !	VISI	R(7)	Visibility
  !	STIME	R*8	Start time
  !	TIME	R*8	Time of the visibility			Output
  !	BASE	R(2)	Start and end antenna			Output
  !---------------------------------------------------------------------
  real :: visi(7)                   !
  real*8 :: stime                   !
  real*8 :: time                    !
  real :: base(2)                   !
  real :: uv(2)                     !
  !
  time = nint(dble(visi(4))-stime)
  time = 86400.d0*time+dble(visi(5))
  base(1) = visi(6)
  base(2) = visi(7)
  uv(1) = visi(1)
  uv(2) = visi(2)
end
!<FF>
subroutine dotime (mv,nv,visi,wtime,it,stime)
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! TASK	Self-Calibration
  !	Compute the observing times of the self-cal data base
  !	sort it and return sorting index
  ! Arguments
  !	MV	I	Size of a visibility
  !	NV	I	Number of visibilities
  !	VISI	R*4(*)	Visibility array
  !	WTIME	R*8(*)	Sorted observing times
  !	IT	I(*)	Sorting indexes
  !	STIME	R*8	Zero time
  !---------------------------------------------------------------------
  integer :: mv                     !
  integer :: nv                     !
  real :: visi(mv,nv)               !
  real*8 :: wtime(nv)               !
  integer :: it(nv)                 !
  real*8 :: stime                   !
  ! Local
  logical :: error
  integer :: i
  real :: tmin,tmax
  !
  tmin = visi(4,1)
  tmax = visi(4,1)
  do i=2,nv
    if (visi(4,i).lt.tmin) then
      tmin = visi(4,i)
    elseif (visi(4,i).gt.tmax) then
      tmax = visi(4,i)
    endif
  enddo
  if (tmin.eq.tmax) then
    do i=1,nv
      wtime(i) = visi(5,i)
    enddo
  else
    do i=1,nv
      wtime(i) = 86400d0*nint(visi(4,i)-tmin)   &
     &        +dble(visi(5,i))
    enddo
  endif
  stime = tmin
  !
  ! Sort
  call gr8_trie(wtime,it,nv,error)
end
!<FF>
subroutine geself (mv,nv,iw,visi,time,ftime,wtime,it,   &
     &    rbase,cvisi,uv)
  !---------------------------------------------------------------------
  ! TASK	Self-Calibration
  !	Compute the Observed Visibility of the "model source"
  ! Arguments
  !	MV	I	Size of a visibility
  !	NV	I	Number of visibilities
  !	IW	I	Self-cal channel
  !	VISI	R*4(*)	Visibility array
  !	TIME	R*8	Time at which factor must be computed
  !	FTIME	R*8	Time interval
  !	WTIME	R*8(*)	Sorted observing times
  !	IT	I(*)	Sorting indexes
  !	RBASE	R*4(2)	Baseline
  !	CVISI	R*4(3)	Complex visibility
  !     UV      R*4(2)  U and V
  !---------------------------------------------------------------------
  integer :: mv                     !
  integer :: nv                     !
  integer :: iw(2)                  !
  real :: visi(mv,nv)               !
  real*8 :: time                    !
  real*8 :: ftime                   !
  real*8 :: wtime(nv)               !
  integer :: it(nv)                 !
  real :: rbase(2)                  !
  real :: cvisi(3)                  !
  real :: uv(2)                     !
  ! Local
  integer :: i,k,l,iv,jv,kv,jr,ji,jw
  real :: reel,imag,weig
  !
  ! Locate the nearest time range by dichotomic search
  call findr (nv,wtime,time,iv)
  reel = 0.0
  imag = 0.0
  weig = 0.0
  !
  ! Now find JV and KV corresponding to +/- FTIME
  i = iv
  10    i = i-1
  if (i.gt.0 .and. (wtime(i).ge.(time-ftime)) ) goto 10
  jv = i
  i = iv
  20    i = i+1
  if (i.le.nv .and. (wtime(i).lt.(time+ftime)) ) goto 20
  kv = i
  !
  ! Everything happens between JV and KV. Load the corresponding
  ! baseline data
  do i=jv,kv
    k = it(i)
    if (abs(wtime(i)-time).le.ftime) then
      if ( (visi(6,k).eq.rbase(1) .and.   &
     &        visi(7,k).eq.rbase(2)) .or. (visi(6,k).eq.rbase(2) .and.   &
     &        visi(7,k).eq.rbase(1)) ) then
        if ( (uv(2).gt.0 .and. visi(2,k).gt.0) .or.   &
     &          (uv(2).le.0 .and. visi(2,k).le.0) ) then
          do l = iw(1),iw(2)
            jr = 5+3*l
            ji = jr+1
            jw = ji+1
            reel = reel+visi(jr,k)*visi(jw,k)
            imag = imag+visi(ji,k)*visi(jw,k)
            weig = weig + visi(jw,k)
          enddo
        else
          !
          ! Change phase by 180 degree if baseline order is reversed
          do l = iw(1),iw(2)
            jr = 5+3*l
            ji = jr+1
            jw = ji+1
            reel = reel+visi(jr,k)*visi(jw,k)
            imag = imag-visi(ji,k)*visi(jw,k)
            weig = weig + visi(jw,k)
          enddo
        endif
      endif
    endif
  enddo
  if (weig.ne.0) then
    reel = reel/weig
    imag = imag/weig
  endif
  cvisi(1) = reel
  cvisi(2) = imag
  cvisi(3) = weig
end
!<FF>
subroutine findr (np,x,xlim,nlim)
  !---------------------------------------------------------------------
  ! GILDAS	Internal routine
  !	Find NLIM such as
  !	 	X(NLIM-1) < XLIM <= X(NLIM)
  !	for input data ordered.
  !	Use a dichotomic search for that
  ! Arguments
  !	NP	I	Number of input points
  !	X	R*8(*)	Input ordered Values
  !	XLIM	R*8	Threshold
  !	NLIM	I	Position of the threshold
  !---------------------------------------------------------------------
  integer :: np                     !
  real*8 :: x(np)                   !
  real*8 :: xlim                    !
  integer :: nlim                   !
  ! Local
  integer :: ninf, nsup, nmid
  !
  ! Check that XLIM is within the range of X
  if (x(1).gt.xlim) then
    nlim = 1
    return
  endif
  ninf = 1
  nsup = np
  !
  do while(nsup.gt.ninf+1)
    nmid = (nsup + ninf)/2
    if (x(nmid).lt.xlim) then
      ninf = nmid
    else
      nsup = nmid
    endif
  enddo
  nlim = nsup
end
