program uv_pointing
  use gildas_def
  use image_def
  use gkernel_interfaces, no_interface=>fourt
  !---------------------------------------------------------------------
  ! Pointing Error Simulation
  !
  !     Fast pointing error simulation based on  gridded interpolation
  !     from the Fourier Transform of an image
  !
  !     H.Wiesemeyer S.Guilloteau
  !
  !----------------------------------------------------------------------
  !
  ! Expression of A
  !     A(x,y) = exp[-2ln(2)/Theta(i)^2 ((x-Dx(i))^2+(y-Dy(i))^2)]
  !            * exp[-2ln(2)/Theta(j)^2 ((x-Dx(j))^2+(y-Dy(j))^2)]
  !
  ! Expression of ThetB
  !     1/ThetB^2 = 1/2 (1/Theta(i)^2+1/Theta(j)^2)
  !
  ! Expression of FT(A)
  !
  !     FT(u,v) = pi ThetB^2 /(4 ln(2)) exp {-pi^2 ThetB^2 / (4 ln(2)) (u^2+v^2) }
  !       * exp{ -2 ln(2) [(Dx1^2_Dy1^2)/Theta1^2 + (Dx2^2_Dy2^2)/Theta2^2] }
  !       * exp{ ThetB^2 ln(2) [(Dx1/Theta1^2 + Dx2/Theta2^2)^2
  !                           + (Dy1/Theta1^2 + Dy2/Theta2^2)^2 ] }
  !       * exp{ -i pi ThetB^2 [(u Dx1 + v Dy1)/Theta1^2 + (u Dx2 + v Dy2)/Theta2^2 ] }
  !
  !
  ! Simplification in the case of identical antennas
  !
  !     FT(u,v) = pi Thet^2 /(4 ln(2)) exp {-pi^2 Thet^2 / (4 ln(2)) (u^2+v^2) }
  !       * exp{ -ln(2) / Thet^2 [(Dx1-Dx2)^2^ + (Dy1-Dy2)^2] }
  !       * exp{ -i pi [(u Dx1 + v Dy1) + (u Dx2 + v Dy2)] }
  !
  !
  ! Evaluation of disturbed visibility
  !      V(u_0,v_0) = FT(u-u_0,v-v_0,Dx(Iant),Dy(Iant) ** FTSKY(u,v)
  !
  ! Replaced by a simple sum of the nearest neighbours
  !     V(u_0,v_0) = SiSj
  !                FT(ui-u_0,vj-v_0,Dx(Iant),Dy(Iant) * FTSKY(ui,vj)
  !                Weight(ui-u_0,vj-v_0) * Du Dv
  !
  ! Note that this CONVOLUTION in Fourier Plane by a Weight(u,v) function
  ! is equivalent to a MULTIPLICATION in Image Plane by its Fourier Transform.
  !
  ! One could (in theory) correct for this gridding effect later.
  !---------------------------------------------------------------------
  ! Global
  include 'gbl_pi.inc'
  include 'gbl_memory.inc'
  ! Local
  type(gildas) :: x,y,z
  real :: su,sv,suv,uvr,eps,frequency
  real*8 :: freq
  integer :: nx,ny,mx,my,nw,nv,ntt,na
  integer :: n,nn(2),ndim
  integer :: ier
  complex, allocatable :: ipft(:,:), wfft(:)
  integer, allocatable :: time_visi(:), visi_time(:), order(:)
  real(8), allocatable :: dt(:)
  real, allocatable :: perr(:,:,:)
!  integer(kind=address_length) :: addr,addr2
!  integer(kind=address_length) :: ipft, ipz, ipv
!  integer(kind=address_length) :: ipitt, ipord, ip1, ip2, iperr, ipw
  character(len=256) :: name, image, uvdata, uvmodel, pfile
  logical :: error, mosaic
  real :: sigma(2)
  real :: theta, pixel_area, lambda, factor
  integer :: icode, mtt, ma
  !
  ! Code:
  call gagout('I-UV_POINTING,  Version 1.1 20-Dec-2000')
  call gildas_open
  call gildas_char('UVSAMPLE$',uvdata)
  call gildas_char('IMAGE$',image)
  call gildas_char('UVMODEL$',uvmodel)
  call gildas_real('FREQUENCY$',frequency,1)
  call gildas_logi('MOSAIC$',mosaic,1)
  call gildas_inte('CODE$',icode,1)
  call gildas_char('POINTING$',pfile)
  call gildas_real('ERRORS$',sigma,2)
  call gildas_real('PRIMARY$',theta,1)
  call gildas_close
  !
  ! Get the model image
  n = lenc(image)
  if (n.le.0) goto 999
  name = image(1:n)
  call gildas_null(z)
  z%gil%ndim = 2
  call gdf_read_gildas(z, name, '.lmv', error)
  if (error) then
    call gagout ('F-UV_POINTING,  Cannot read input image')
    goto 999
  endif
  pixel_area = abs(z%gil%inc(1)*z%gil%inc(2))  ! in radian
  !
  ! Need to oversample in the UV plane, i.e. extend initial image,
  ! to avoid large gridding errors
  !
  nx = z%gil%dim(1)
  ny = z%gil%dim(2)
  mx = 8*nx
  my = 8*ny
  if (mx.gt.5000.or.my.gt.5000) then
    mx = 4*nx
    my = 4*ny
  endif
  !
  allocate (ipft(mx,my), stat=ier)
  call plunge_real (z%r2d,nx,ny,ipft,mx,my)
  !
  ! Original image no longer needed...
  deallocate (z%r2d)
  !
  ! Template UV data set
  n = lenc(uvdata)
  if (n.le.0) goto 999
  name = uvdata(1:n)
  call gildas_null (x, type = 'UVT')
  call gdf_read_gildas (x, name, '.uvt', error, data=.false.)
  if (error) then
    call gagout ('F-UV_POINTING,  Cannot read input table')
    goto 999
  endif
  !
  ! Create the model UV table (Y from X)
  call gildas_null (y, type = 'UVT')
  call gdf_copy_header (x,y,error)
  freq = z%gil%freq
  if (frequency.ne.0) then
    freq = frequency*1e3
  endif
  y%gil%freq = freq
  !
  print *,'freq ',y%gil%freq,freq
  ! Define scaling factor from Brightness to Flux (2 k B^2 / l^2)
  lambda = 299792.458e3/(freq*1e6) ! in meter
  ! 1.38E3 is the Boltzmann constant times 10^26 to give result in Jy
  factor = 2*1.38e3/lambda**2*pixel_area
  print *,'Factor ',factor,pixel_area
  if (factor.eq.0.0) factor = 1.0
  !
  n = lenc(uvmodel)
  if (n.le.0) goto 999
  name = uvmodel(1:n)
  call sic_parsef(name,y%file,' ','.uvt')
  call gdf_create_image (y, error)
  if (error) then
    call gagout ('F-UV_POINTING,  Cannot create output UV model')
    goto 999
  endif
  !
  call gdf_allocate(y,error)
  call gdf_read_data (x, y%r2d, error)
  nw = y%gil%dim(1)
  nv = y%gil%dim(2)
  !
  ! Template UV data set no longer needed
  call gdf_close_image(x, error)
  !
  ! Get the number of time samples
  allocate (visi_time(nv), dt(nv), time_visi(nv), stat=ier)
  call do_timelist (   &
     &    y%r2d,   &
     &    nw,nv,   &
     &    visi_time, &   ! Visibility --> Time
     &    dt,   &     ! Date + Time
     &    time_visi,   &     ! Time --> Visi
     &    ntt,na)
  !
  ! Get the index order...
  allocate (order(ntt), stat=ier)
  call gi4_trie(visi_time,order,ntt,error)
  deallocate (dt, time_visi, stat=ier)   !  call free_vm (3*nv,addr)
  !
  ! Pointing errors
  if ((icode.gt.5).or.(icode.lt.1)) then
    call gagout('F-UV_POINTING,  Pointing mode is 1..5')
    goto 999
  endif
  !
  ! Pointing error file: gdf table
  if (mosaic.or.(icode.eq.5)) then
    call gagout('I-UV_POINTING, Reading an external table')
    n = lenc(pfile)
    if (n.le.0) goto 999
    name = pfile(1:n)
    call gildas_null(x)
    call gdf_read_gildas (x, name, '.tab', error)
    if (error) then
      call gagout ('F-UV_POINTING, Cannot read error table')
      goto 999
    endif
    !
    ! Check dimension are ok
    ! We need dim(1) = number of visibilitiy dumps (NTT)
    !         dim(2) = number of antennas (NA)
    !         dim(3) = 2
    ! Table can be larger (the end won't be read)
    if ((x%gil%dim(1).lt.ntt).or.(x%gil%dim(2).lt.na).or.   &
     &      (x%gil%dim(3).ne.2)) then
      call gagout('W-UV_POINTING, Pointing error file too small')
      goto 999
    endif
    mtt = x%gil%dim(1)
    ma = x%gil%dim(2)
  endif
  !
  ! Now compute or read the errors
  sigma(1) = sigma(1)*pi/3600/180
  sigma(2) = sigma(2)*pi/3600/180
  print *,'Sigma ',sigma
  allocate (perr(2,ntt,na), stat=ier)
  call do_pointerr (   &
     &    order,    &   ! Ordering of times
     &    ntt,na,   &
     &    perr,     &   ! Pointing errors
     &    sigma,    &   ! For each direction
     &    mosaic,   &   ! Mosaic mode
     &    x%r3d,    &   ! Pointing error table (icode=5)
     &    mtt,ma,icode,error)
  if (error) call sysexi(fatale)
  !
  ! Free files
  if (mosaic.or.(icode.eq.5)) then
    deallocate (x%r3d, stat=ier)
    call gdf_close_image(x, error)
  endif
  !
  ! Get the model image Fourier Transform
  allocate (wfft(mx+my), stat=ier)
  nn(1) = mx
  nn(2) = my
  ndim = 2
  call fourt(ipft,nn,ndim,1,0,wfft) 
  ! Recenter it
  call recent(mx,my,ipft) 
  !
  su = 1.0/(mx*z%gil%inc(1))
  sv = 1.0/(my*z%gil%inc(2))
  theta = theta*pi/180.0/3600.0    ! In radians
  suv = max(-su,sv)
  eps = 1e-8
  uvr = suv * nint(2.*sqrt(-log(2.)*log(eps))/(pi*theta)/suv)
  print *,'UV cells ',uvr/suv,uvr,suv
  !
  ! Now to the job
  call do_model (   &
     &    y%r2d,    &
     &    nw,nv,    &
     &    visi_time,&
     &    na,ntt,   &
     &    perr,     &
     &    freq,     &
     &    ipft,     &    ! Fourier transform of sky brightness
     &    mx,my,    &
     &    wfft, wfft(mx+1),   &  ! Use for U,V coordinates of grid
     &    su,sv,theta,uvr,factor)
  !
  call gdf_write_data(y, y%r2d, error)
  call gdf_close_image(y, error)
  call sysexi(1)
  !
  999   call sysexi(fatale)
end program uv_pointing
!
!<FF>
subroutine plunge_real (r,nx,ny,c,mx,my)
  !---------------------------------------------------------------------
  !     Plunge a Real array into a larger Complex array
  !---------------------------------------------------------------------
  integer :: nx                     ! Size of input array
  integer :: ny                     ! Size of input array
  real :: r(nx,ny)                  ! Input real array
  integer :: mx                     ! Size of output array
  integer :: my                     ! Size of output array
  real :: c(2,mx,my)                ! Output complex array
  ! Local
  integer :: kx,ky,lx,ly
  integer :: i,j
  !
  kx = nx/2+1
  lx = mx/2+1
  ky = ny/2+1
  ly = my/2+1
  !
  do j=1,my
    do i=1,mx
      c(1,i,j) = 0.0
      c(2,i,j) = 0.0
    enddo
  enddo
  !
  do j=1,ny
    do i=1,nx
      c(1,i-kx+lx,j-ky+ly) = r(i,j)
    enddo
  enddo
end
!<FF>
subroutine do_timelist (visi,nw,nv,itt,dtt,vtt,ntt,na)
  !---------------------------------------------------------------------
  !     Build a list of times from the input visibilities
  !---------------------------------------------------------------------
  integer :: nw                     !
  integer :: nv                     !
  real :: visi(nw,nv)               ! Visibilities
  integer :: itt(nv)                ! Pointer from visibility to time
  real*8 :: dtt(nv)                 ! Date & Time of each time sample
  integer :: vtt(nv)                ! Pointer from time to visibility
  integer :: ntt                    !
  integer :: na                     !
  ! Local
  integer :: iv,jv,it,i,la
  real :: date,time
  logical :: goon
  !
  itt(1) = 1
  vtt(1) = 1
  ntt = 1
  date = visi(4,1)
  time = visi(5,1)
  dtt(ntt) = dble(date)*dble(24*3600)+dble(time)
  print *,'Found new time at visi ',1,dtt(ntt)
  na = max(visi(6,1),visi(7,1))
  !
  do iv=2,nv
    date = visi(4,iv)
    time = visi(5,iv)
    la = max(visi(6,iv),visi(7,iv))
    na = max(na,la)
    it = ntt
    goon = .true.
    do while (goon)
      jv = vtt(it)
      if (date.eq.visi(4,jv).and.   &
     &        time.eq.visi(5,jv)) then
        itt(iv) = it
        goon = .false.
      elseif  (it.eq.1) then
        ntt = ntt+1
        itt(iv) = ntt
        vtt(ntt) = iv
        dtt(ntt) = dble(date)*dble(24*3600)+dble(time)
        print *,'Found new time at visi ',iv,dtt(ntt)
        goon = .false.
      else
        it = it-1
      endif
    enddo
  enddo
  print *,'Found ',na,' different antennas'
  print *,'Found ',ntt,' different times'
  print *,'Times ',(dtt(i),i=1,ntt)
end
!<FF>
subroutine do_pointerr (order,ntt,na,err,sigma,mosaic,   &
     &    poinerr,mtt,ma,icode,error)
  !---------------------------------------------------------------------
  !     Generate the pointing errors
  !     5 Cases
  !     ICODE = 1       No error
  !     ICODE = 2       Fixed error (identical for all antennas)
  !     ICODE = 3       Purely random error
  !     ICODE = 4       Random per antenna, fixed in time
  !     ICODE = 5       Table driven error, gdf table
  !         Table dimension: NTT,NA,2
  !
  !     If MOSAIC is true, then read table (icode=5) and add errors
  !     (icode = 1 to 4)
  !---------------------------------------------------------------------
  integer :: ntt                    !
  integer :: order(ntt)             !
  integer :: na                     !
  real :: err(2,na,ntt)             !
  real :: sigma(2)                  !
  logical :: mosaic                 !
  integer :: mtt                    !
  integer :: ma                     !
  real :: poinerr(mtt,ma,2)         !
  integer :: icode                  !
  logical :: error                  !
  ! Global
  include 'gbl_pi.inc'
  ! Local
  real :: rangau
  real*8 :: sec
  integer :: ia,it,jt,kt
  !
  error = .false.
  !
  ! No error
  do it=1,ntt
    do ia=1,na
      err(1,ia,it) = 0.0
      err(2,ia,it) = 0.0
    enddo
  enddo
  ! Purely fixed
  if (icode.eq.2) then
    do it=1,ntt
      do ia=1,na
        err(1,ia,it) = sigma(1)
        err(2,ia,it) = sigma(2)
      enddo
    enddo
    ! Purely random
  elseif (icode.eq.3) then
    do it=1,ntt
      do ia=1,na
        err(1,ia,it) = rangau(sigma(1))
        err(2,ia,it) = rangau(sigma(2))
      enddo
    enddo
    ! Random for each antenna, but fixed in time
  elseif (icode.eq.4) then
    do ia=1,na
      err(1,ia,1) = rangau(sigma(1))
      err(2,ia,1) = rangau(sigma(2))
    enddo
    do it=2,ntt
      do ia=1,na
        err(1,ia,it) = err(1,ia,1)
        err(2,ia,it) = err(2,ia,1)
      enddo
    enddo
  endif
  !
  ! For a Mosaic add the Mosaic centers, from the external file
  if (mosaic.or.(icode.eq.5)) then
    ! External description: gdf file
    sec = pi/3600./180.
    do it=1,ntt
      jt = order(it)
      do ia=1,na
        err(1,ia,jt) = err(1,ia,jt)+poinerr(it,ia,1)*sec
        err(2,ia,jt) = err(2,ia,jt)+poinerr(it,ia,2)*sec
      enddo
    enddo
  endif
end
!<FF>
subroutine do_model (visi,nw,nv,itt,na,nt,err,freq,   &
     &    ftsky,mx,my,uval,vval,su,sv,thet,uvr,factor)
  integer :: nw                     !
  integer :: nv                     !
  real :: visi(nw,nv)               ! Visibilities
  integer :: itt(nv)                ! Pointer to times
  integer :: na                     ! Number of antennas
  integer :: nt                     ! Number of different times
  real :: err(2,na,nt)              ! Pointing error for each antenna / time
  real*8 :: freq                    ! Observing frequency
  integer :: mx                     !
  integer :: my                     !
  complex :: ftsky(mx,my)           ! Fourier Transform
  real :: uval(mx)                  ! u,v Values
  real :: vval(my)                  ! u,v Values
  real :: su                        ! Step of Fourier Transform
  real :: sv                        ! Step of Fourier Transform
  real :: thet                      ! Beam size (in radian)
  real :: uvr                       ! UV radius for convolution
  real :: factor                    ! Input map scaling factor
  ! Global
  include 'gbl_pi.inc'
  ! Local
  real*8 :: u,v,lambda,uu,vv
  real*8 :: us,vs
  real*8 :: dxi,dyi,dxj,dyj
  real*8 :: pithet,uvthet,lnthet
  complex*16 :: avis,tvis,cmp
  complex*8 :: svis
  real*8 :: arg,carg,sarg
  integer :: ia,ja,it
  integer :: lx,ly,ilo,iup,jlo,jup
  integer :: i,iv,ii,jj
  !
  lambda = 299792.458d3/(freq*1d6)
  pithet = pi**2*thet**2/(4.0*log(2.))
  uvthet = -pithet/pi*su*sv * factor
  lnthet = log(2d0)/thet**2
  lx = mx/2+1
  ly = my/2+1
  us = 1.0/su
  vs = 1.0/sv
  do i=1,mx
    uval(i) = (i-lx)*su
  enddo
  do i=1,my
    vval(i) = (i-ly)*sv
  enddo
  !
  do iv = 1,nv
    u = visi(1,iv)/lambda
    v = visi(2,iv)/lambda
    ia = visi(6,iv)
    ja = visi(7,iv)
    it = itt(iv)
    dxi = err(1,ia,it)
    dyi = err(2,ia,it)
    dxj = err(1,ja,it)
    dyj = err(2,ja,it)
    !
    !     FT(u,v) = pi Thet^2 /(4 ln(2)) exp {-pi^2 Thet^2 / (4 ln(2)) (u^2+v^2) }
    !       * exp{ -ln(2) / Thet^2 [(Dx1-Dx2)^2^ + (Dy1-Dy2)^2] }
    !       * exp{ -i pi [(u Dx1 + v Dy1) + (u Dx2 + v Dy2)] }
    !
    !  FT(u,v) = pi Thet^2 /(4 ln(2))                       ! Scale
    !  * exp{ -ln(2) / Thet^2 [(Dx1-Dx2)^2 + (Dy1-Dy2)^2] } ! Cross-pointing error
    !  * exp {-pi^2 Thet^2 / (4 ln(2)) u^2}                 ! U attenuation term
    !  * exp { -i pi [u Dx1) + u Dx2] }                     ! U phase term
    !  * exp {-pi^2 Thet^2 / (4 ln(2)) v^2 }                ! V attenuation term
    !  * exp{ -i pi [v Dy1 + v Dy2] }                       ! V phase term
    !
    ilo = nint((u+uvr)*us) + lx
    iup = nint((u-uvr)*us) + lx
    jlo = nint((v-uvr)*vs) + ly
    jup = nint((v+uvr)*vs) + ly
    ilo = max(1,ilo)
    iup = min(mx,iup)
    jlo = max(1,jlo)
    jup = min(my,jup)
    !
    avis = (0.,0.)
    do jj = jlo,jup
      tvis = (0.,0.)
      do ii = ilo,iup
        uu = uval(ii) - u
        arg = -pi*uu*(dxi+dxj)
        carg = cos(arg)
        sarg = sin(arg)
        cmp = cmplx(carg,sarg)
        arg = exp(-pithet*uu**2)
        tvis = tvis+cmp*ftsky(ii,jj)*arg
      enddo
      vv = vval(jj) - v
      arg = -pi*vv*(dyi+dyj)
      carg = cos(arg)
      sarg = sin(arg)
      cmp = cmplx(carg,sarg)
      arg = exp(-pithet*vv**2)
      avis = avis+cmp*tvis*arg
    enddo
    !
    ! FT(u,v) = pi Thet^2 /(4 ln(2))
    !   * exp{ -ln(2) / Thet^2 [(Dx1-Dx2)^2^ + (Dy1-Dy2)^2] }
    !   * su * sv
    !
    arg = uvthet*exp(-lnthet*((dxi-dxj)**2+(dyi-dyj)**2))
    avis = avis*arg
    !
    ! Done
    svis = avis
    visi(8,iv) =  real(svis)
    visi(9,iv) = aimag(svis)
  enddo
end
!<FF>
subroutine recent(nx,ny,z)
  !---------------------------------------------------------------------
  ! Recenters the Fourier Transform, for easier display. The present version
  ! will only work for even dimensions.
  !---------------------------------------------------------------------
  integer :: nx                     !
  integer :: ny                     !
  complex :: z(nx,ny)               !
  ! Local
  integer :: i, j
  complex :: tmp
  !
  do j=1,ny/2
    do i=1,nx/2
      tmp = z(i+nx/2,j+ny/2)
      z(i+nx/2,j+ny/2) = z(i,j)
      z(i,j) = tmp
    enddo
  enddo
  !
  do j=1,ny/2
    do i=1,nx/2
      tmp = z(i,j+ny/2)
      z(i,j+ny/2) = z(i+nx/2,j)
      z(i+nx/2,j) = tmp
    enddo
  enddo
  !
  do i=1,nx
    do j =1,ny
      if (mod(i+j,2).ne.0) then
        z(i,j) = -z(i,j)
      endif
    enddo
  enddo
end
