program uv_cc_model
  use gkernel_interfaces
  !----------------------------------------------------------------------
  ! GILDAS
  ! Compute a UV data set from a Clean Component Table
  ! Input : a UV table, created for example by ASTRO
  ! Input : a Clean Component Table
  ! Output: the UV table, where the visibilities have been computed.
  !----------------------------------------------------------------------
  ! Global variables:
  character(len=256) uvdata,cleant,uvmodel
  real(8) frequency
  logical subtract,error
  !
  ! Code:
  call gildas_open
  call gildas_char('UVSAMPLE$',uvdata)
  call gildas_char('CLEAN$',cleant)
  call gildas_char('UVMODEL$',uvmodel)
  call gildas_dble('FREQUENCY$',frequency,1)
  call gildas_logi('SUBTRACT$',subtract,1)
  call gildas_close
  !
  call cct_model(uvdata,cleant,uvmodel,frequency,subtract,error)
end program uv_cc_model
!<FF>
subroutine cct_model (uvdata,cleant,uvmodel,frequency,subtract,error)
  !----------------------------------------------------------------------
  ! GILDAS
  ! Compute a UV data set from an image model
  ! Input : a UV table, created for example by ASTRO
  ! Input : a Clean Component Table
  ! Output: the UV table, where the visibilities have been computed.
  !
  !----------------------------------------------------------------------
  use gkernel_interfaces
  use image_def
  character(len=*), intent(in) :: uvdata, cleant, uvmodel
  real(8), intent(in) :: frequency
  logical, intent(in) :: subtract
  logical, intent(out) :: error
  !
  type (gildas) :: huvd, hcct, huvm
  real, allocatable :: dcct(:,:,:),duvm(:,:)
  real(8), allocatable :: freqs(:)
  integer :: ier, ic
  !
  error = .false.
  !
  ! Read UVDATA
  call gildas_null(huvd, type = 'UVT')
  call sic_parse_file(uvdata,' ','.uvt',huvd%file)
  call gdf_read_header (huvd,error)
  if (error) return
  !
  ! Define UVMODEL
  call gildas_null(huvm, type = 'UVT')
  call gdf_copy_header (huvd,huvm,error)
  call sic_parse_file(uvmodel,' ','.uvt',huvm%file)
  if (frequency.ne.0) then
    huvm%gil%freq = frequency
    huvm%gil%val(1) = frequency
  endif
  if (huvm%gil%freq.eq.0) then
    call gagout('E-UV_CCMODEL,  Missing UV table frequency')
    error = .true.
    return
  endif
  !
  ! Read data from UVDATA
  allocate (duvm(huvm%gil%dim(1),huvm%gil%dim(2)),stat=ier)
  call gdf_read_data (huvd,duvm,error)
  !
  ! Read the Clean Component Table
  call gildas_null(hcct)
  call sic_parse_file(cleant,' ','.cct',hcct%file)
  call gdf_read_header (hcct,error)
  if (error) return
  allocate (dcct(hcct%gil%dim(1),hcct%gil%dim(2),hcct%gil%dim(3)),stat=ier)
  call gdf_read_data (hcct,dcct,error)
  if (error) return
  !
  allocate (freqs(huvm%gil%nchan),stat=ier)
  do ic = 1,huvm%gil%nchan
    freqs(ic) = gdf_uv_frequency(huvm,dble(ic))
  enddo
  !
  ! Compute the model
  if (hcct%char%code(3).eq.'COMPONENT') then
    call gagout('I-UV_CCMODEL,  Clean Components from MAPPING')
    call do_model_a (freqs   & ! Frequency
     &      ,huvm%gil%dim(1) & ! Visibility size
     &      ,huvm%gil%dim(2) & ! Number of visibilities
     &      ,duvm            & ! Visibilities
     &      ,hcct%gil%dim(1) & !
     &      ,hcct%gil%dim(2) & ! Number of channels
     &      ,hcct%gil%dim(3) & ! Number of Clean Components
     &      ,dcct            & !
     &      ,subtract)         ! Subtract ?
  else
    call gagout('I-UV_CCMODEL,  Clean Components from CLEAN')
    call do_model_b (freqs   &   ! Frequency
     &      ,huvm%gil%dim(1) & ! Visibility size
     &      ,huvm%gil%dim(2) & ! Number of visibilities
     &      ,duvm            & ! Visibilities
     &      ,hcct%gil%dim(1) & !
     &      ,hcct%gil%dim(2) & ! Number of Clean Components
     &      ,hcct%gil%dim(3) & ! Number of channels
     &      ,dcct            & !
     &      ,subtract)         ! Subtract ?
  endif
  !
  ! Write the result
  call gdf_write_image(huvm,duvm,error)
  deallocate (dcct)
  deallocate (duvm)
end subroutine cct_model
!<FF>
subroutine do_model_a (freq,nf,nv,visi,lc,nc,mc,clean,sub)
  !-----------------------------------------------------------------
  !     Compute visibilities for a UV data set according to a
  !     set of Clean Components , and remove them from the original
  !     UV table
  ! This version is for CCT tables from MAPPING
  !-----------------------------------------------------------------
  integer, intent(in) :: nf    ! Number of frequency channels
  integer, intent(in) :: nv    ! Number of visibilities
  real, intent(inout) :: visi(nf,nv)       ! Visibilities
  integer, intent(in) :: lc    ! Dimension of a Clean Component
  integer, intent(in) :: mc    ! Number of Clean Components
  integer, intent(in) :: nc    ! Number of Channels
  real(8), intent(in) :: freq(nc)  ! Frequency
  real, intent(in) :: clean(lc,nc,mc)   ! X,Y,V per channel and component
  logical, intent(in) :: sub   ! Subtract or Add
  !
  real(8), allocatable :: pidsur(:)            ! 2*pi*D/Lambda
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: f_to_k=2.d0*pi/299792458.d-6
  real(8) :: x, y, phase, rvis, ivis
  integer ii, ir, ier
  integer ic,iv,jc
  !
  pidsur = f_to_k * freq
  !
  if (sub) then
    !
    ! Remove clean component from UV data set
    do iv=1,nv
      ir = 7+1
      ii = 7+2
      do jc = 1,nc
        do ic = 1,mc
          if (clean(3,jc,ic).ne.0) then
            x = pidsur(jc)*clean(1,jc,ic)
            y = pidsur(jc)*clean(2,jc,ic)
            phase = visi(1,iv)*x+visi(2,iv)*y
            rvis = clean(3,jc,ic)*cos(phase)
            ivis = clean(3,jc,ic)*sin(phase)
            visi(ir,iv) = visi(ir,iv) - rvis   ! Subtract
            visi(ii,iv) = visi(ii,iv) - ivis
          endif
        enddo
        ir = ir+3
        ii = ii+3
      enddo
    enddo
  else
    do iv=1,nv
      ir = 7+1
      ii = 7+2
      do jc = 1,nc
        visi(ir,iv) = 0.0
        visi(ii,iv) = 0.0
        do ic = 1,mc
          if (clean(3,jc,ic).ne.0) then
            x = pidsur(jc)*clean(1,jc,ic)
            y = pidsur(jc)*clean(2,jc,ic)
            phase = visi(1,iv)*x+visi(2,iv)*y
            rvis = clean(3,jc,ic)*cos(phase)
            ivis = clean(3,jc,ic)*sin(phase)
            visi(ir,iv) = visi(ir,iv) + rvis   ! Add
            visi(ii,iv) = visi(ii,iv) + ivis
          endif
        enddo
        ir = ir+3
        ii = ii+3
      enddo
    enddo
  endif
end subroutine do_model_a
!
subroutine do_model_b (freq,nf,nv,visi,lc,mc,nc,clean,sub)
  !-----------------------------------------------------------------
  !     Compute visibilities for a UV data set according to a
  !     set of Clean Components , and remove them from the original
  !     UV table
  ! This version is for CCT tables from TASK CLEAN
  !-----------------------------------------------------------------
  integer, intent(in) :: nf          ! Number of frequency channels
  integer, intent(in) :: nv          ! Number of visibilities
  real, intent(inout) :: visi(nf,nv) ! Visibilities
  integer, intent(in) :: lc
  integer, intent(in) :: mc          ! Number of Clean Components
  integer, intent(in) :: nc          ! Number of Channels
  real(8), intent(in) :: freq(nc)    ! Frequency
  real, intent(in) :: clean(lc,mc,nc) ! X,Y,V for per component and channel
  logical, intent(in) :: sub         ! Subtract or Add component
  !
  real(8), allocatable :: pidsur(:)  ! 2*pi*D/Lambda
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: f_to_k=2.d0*pi/299792458.d-6
  real(8) :: x, y, phase, rvis, ivis
  integer ii, ir, ier
  integer ic,iv,jc
  !
  allocate(pidsur(nc),stat=ier)
  if (ier.ne.0) return
  !
  pidsur = f_to_k * freq
  !
  if (sub) then
    !
    ! Remove clean component from UV data set
    do iv=1,nv
      ir = 7+1
      ii = 7+2
      do jc = 1,nc
        do ic = 1,mc
          if (clean(3,ic,jc).ne.0) then
            x = pidsur(jc)*clean(1,ic,jc)
            y = pidsur(jc)*clean(2,ic,jc)
            phase = visi(1,iv)*x+visi(2,iv)*y
            rvis = clean(3,ic,jc)*cos(phase)
            ivis = clean(3,ic,jc)*sin(phase)
            visi(ir,iv) = visi(ir,iv) - rvis   ! Subtract
            visi(ii,iv) = visi(ii,iv) - ivis
          endif
        enddo
        ir = ir+3
        ii = ii+3
      enddo
    enddo
  else
    do iv=1,nv
      ir = 7+1
      ii = 7+2
      do jc = 1,nc
        visi(ir,iv) = 0.0
        visi(ii,iv) = 0.0
        do ic = 1,mc
          if (clean(3,ic,jc).ne.0) then
            x = pidsur(jc)*clean(1,ic,jc)
            y = pidsur(jc)*clean(2,ic,jc)
            phase = visi(1,iv)*x+visi(2,iv)*y
            rvis = clean(3,ic,jc)*cos(phase)
            ivis = clean(3,ic,jc)*sin(phase)
            visi(ir,iv) = visi(ir,iv) + rvis   ! Subtract
            visi(ii,iv) = visi(ii,iv) + ivis
          endif
        enddo
        ir = ir+3
        ii = ii+3
      enddo
    enddo
  endif
end subroutine do_model_b
