program uv_ref_gauss
  use gildas_def
  use gkernel_interfaces
  use mapping_interfaces
  use image_def
  use gbl_format
  !---------------------------------------------------------------------
  ! TASK  Self-Calibration
  !	Applies "Self-Calibration" results to a CLIC UV table.
  ! Input :
  !	TABLE$	The UV table to be self-calibrated
  !	SELF$	The "gain" table, i.e. a UV table used as phase reference
  !	DTIME$	The smoothing time constant
  !	TYPE$	Type of self-cal, Ampli, Phase or Both
  !	GAUSS$  Position, Amplitude and Size of source
  !	SUBT$	Subtract point source model from data
  ! S.Guilloteau 19-Jun-1991
  !---------------------------------------------------------------------
  ! Local
  type(gildas) :: x,y
  character(len=filename_length) :: uv_table,self_name,name
  character(len=8) :: type
  real(8) :: time,stime,dtime
  integer :: wcol,itype
  !
  complex(4) :: model,  result, self
  real(8), allocatable :: ipw(:)
  integer, allocatable :: ipi(:)
  integer :: sblock=1000
  integer :: i,nvs,nvi,nsc,nc,n,j,k,ier,wrange(2)
  real :: factor,rbase(2),gauss(7),reel,imgi
  real :: kilow,weight,uv(2)
  logical :: error
  real(8) :: freq
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: f_to_k = 1.d0/299792458.d-6
  !
  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,1)
  call gildas_char('TYPE$',type)
  call gildas_real('GAUSS$',gauss,6)
  call gildas_real('SUB$',factor,1)
  call gildas_close
  !
  self = cmplx(1.0,0.0)
  weight = 1.0
  if (type.eq.'BOTH') then
    itype = 0
  elseif (type.eq.'AMPLI') then
    itype = -1
  elseif (type.eq.'PHASE') then
    itype = 1
  elseif (type.eq.'NONE') then
    itype = 2
  endif
  dtime = 0.5d0*dtime
  ! North towards East convention
  gauss(7) = sin(gauss(6))
  gauss(6) = cos(gauss(6))
  !
  ! Open continuum table
  n = lenc(self_name)
  if (n.le.0) goto 999
  name = self_name(1:n)
  call gildas_null (y, type = 'UVT')
  call gdf_read_gildas(y, name, '.uvt', error)
  if (error) then
    call gagout('F-SELF_CAL,  Cannot read input UV table')
    goto 999
  endif
  nsc = y%gil%nchan 
  freq = y%gil%val(1)+y%gil%fres*(y%gil%val(1)/y%gil%freq)*((nsc+1)*0.5-y%gil%ref(1))
  kilow = freq*f_to_k
  wcol = max(1,wcol)
  wcol = min(wcol,nsc)
  wrange(1:2) = wcol
  !
  ! Load time variable and sort by time order
  nvi = y%gil%dim(2)
  nvs = y%gil%dim(1)
  allocate (ipw(nvi), ipi(nvi), stat=ier)
  !
  ! Open line table
  n = lenc(uv_table)
  if (n.le.0) goto 999
  name = uv_table(1:n)
  call sic_parsef(name,x%file,' ','.uvt')
  call gildas_null(x, type = 'UVT')
  call gdf_read_gildas(x, name, '.uvt', error, data=.false.)
  if (error) then
    call gagout ('F-SELF_CAL,  Cannot read input/output UV table')
    goto 999
  endif
  nc = x%gil%nchan 
  !
  ! Sort self-cal table
  call dotime (nvs,nvi,y%r2d, ipw, ipi, stime)
  allocate (x%r2d(x%gil%dim(1), sblock), stat=ier)
  !
  ! Loop over line table
  do i=1,x%gil%dim(2),sblock
    x%blc(2) = i
    x%trc(2) = min(x%gil%dim(2),i-1+sblock)
    call gdf_read_data(x,x%r2d,error)
    k = 0
    do j=x%blc(2),x%trc(2)
      k = k+1
      !
      ! Get time and baseline
      call getiba (x%r2d(:,k),stime,time,rbase,uv)
      !
      ! Compute the observed reference visibility for that baseline
      call geself (nvs,nvi,wrange,y%r2d,   &
     &        time,dtime,ipw,ipi,   &
     &        rbase,result,uv)
      !
      ! No data: flag
      if (result.eq.cmplx(0.0,0.0)) then
        call doflag (nc,x%r2d(:,k)) 
      else
        !
        ! Compute the model visibility
        call domodel (x%r2d(:,k),gauss,model,kilow)
        ! Compute self-cal correction
        if (itype.ne.2) then
          call doself  (model,result,itype,self,weight)
        endif
        ! Compute fraction of source to remove
        reel = factor*real(model)
        imgi = factor*imag(model)
        ! Apply self-cal and remove source
        call doscal (nc,x%r2d(:,k),real(self),imag(self),reel,imgi,   &
     &          weight)
      endif
    enddo
    call gdf_write_data(x,x%r2d,error)
  enddo
  ! end loop
  call gdf_close_image(x,error)
  call gdf_close_image(y,error)
  call gagout('S-UV_REF_GAUSS,  Successful completion')
  call sysexi(1)
  999   call sysexi(fatale)
end program uv_ref_gauss
!
subroutine domodel (uv,gauss,model,kilow)
  !---------------------------------------------------------------------
  !	GAUSS
  !	1	Amplitude
  !	2	X center
  !	3	Y center
  !	4	Major axis
  !	5	Minor axis
  !	6	Cos (Angle)
  !	7	Sin (Angle)
  !---------------------------------------------------------------------
  real, intent(in) :: uv(2)                     !
  real, intent(in) :: gauss(7)                  !
  complex, intent(out) :: model                 !
  real, intent(in) :: kilow                     !
  ! Local
  real(8) :: gfact
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: twopi=2.d0*pi
  !
  real :: phi,major,minor,fact
  !
  ! 1/e width of Fourier Transform is 2*sqrt(log(2.0))/pi/FWHM of image
  ! Rotation commute with Fourier Transform
  !
  fact = gauss(1)
  if (gauss(4).ne.0.0) then
    gfact=pi**2/4d0/dlog(2.0d0)
    major = kilow*(uv(1)*gauss(6)+uv(2)*gauss(7))*gauss(4)
    minor = kilow*(uv(1)*gauss(7)-uv(2)*gauss(6))*gauss(5)
    fact = fact*exp (-gfact * (major**2+minor**2))
  endif
  phi = twopi*kilow*(gauss(2)*uv(1)+gauss(3)*uv(2))
  model = cmplx(fact*cos(phi),fact*sin(phi))
end subroutine domodel
