program uv_track_phase
  use gildas_def
  use image_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  !       Task to create a UV table from Station Coordinates and Observation
  ! parameters.
  !---------------------------------------------------------------------
  ! Global
  real :: a_lever
  include 'gbl_pi.inc'
  ! Local
  type(gildas) :: xima,yima,zima
  integer :: mstat, nstat, muv, ier, nc
  parameter (mstat=100, muv=10000)
  real :: x(mstat), xx, yy, zz, sd, cd, sp, cp, h, sh, ch
  real :: y(mstat), z(mstat), extr, zch(muv), zsh(muv), hlim(2)
  real :: hmin, hmax, array, uk, vk, horizon, phase, ph
  real :: uvmin, uvmin2, uv_spacing, diameter, dd, bx(mstat), by(mstat)
  real*8 :: decs,freq,latitud,amat(9),bvec(3),az,el,avec(3),bandwidth
  integer :: i, j, k, kh, lun, count, nvis, nshadow, nfill, ip, ff
  character(len=256) :: chain, file, fstation, phase_screen, cal_file
!  integer(kind=address_length) :: ipa, ipb, ipc, ipx, ipy, ipz
!  integer(kind=address_length) :: addr
  logical :: error,new,complete(mstat),ok,cal(muv)
  real :: integ_time, frac, test, date, bandw
  real :: trec, tsys, tau, jpk, weight, total
  real :: step_time, windangle, windvelo, cal_dist_x, cal_dist_y
  real :: cal_integ, cal_dist, cal_angle, source_integ
  real :: t, time(muv), hour(muv), alt, deadtime, ontime
  real :: sd_cal, cd_cal, sd_sou, cd_sou, dx, dy
  real :: offset, offsetx, offsety, t0, later
  real :: phrad(mstat), phn(mstat), phn0(mstat), phcal(mstat)
  real :: phase_scale, wvr_precis, wvr_noise
  real :: amp, amperror(mstat),amplitude(2), ampli(mstat)
  real :: drift(mstat), tmp, ptg, amp_time
  real :: azerr(mstat), elerr(mstat)
  real*8 :: ra_err(2), dec_err(2)
  integer :: nnx, nny, nh, nh_sou, nh_cal, nshadow_c, nfill_c
  integer :: nshadow_s,nfill_s,next_c,next_s
  parameter (step_time=180.0)
  logical :: first, do_screen, do_calib, do_radiom, do_correct
  logical :: do_anrefr
  !
  !------------------------------------------------------------------------
  !
  trec = 50.0
  tau = 0.1
  first = .true.
  total = 0.0
  !
  ! uv_track
  call gildas_open
  call gildas_dble('DECLINATION$',decs,1)
  call gildas_dble('FREQUENCY$',freq,1)
  call gildas_logi('NEW$',new,1)
  call gildas_char('UV_TABLE$',file)
  call gildas_char('STATION_FILE$',fstation)
  call gildas_real('UV_SPACING$',uv_spacing,1)
  call gildas_real('DIAMETER$',diameter,1)
  call gildas_real('HORIZON$',horizon,1)
  call gildas_dble('LATITUDE$',latitud,1)  ! deg
  call gildas_real('HOUR$',hlim,2)
  call gildas_real('INTEGRATION$',integ_time,1)
  call gildas_real('BANDWIDTH$',bandw,1)
  call gildas_real('TREC$',trec,1)
  call gildas_real('TAU$',tau,1)
  call gildas_real('PHASE$',phase,1)
  ! screen phase
  call gildas_logi('DO_SCREEN$',do_screen,1)
  call gildas_char('PHASE_SCREEN$',phase_screen)
  call gildas_real('PHASE_NOISE$',phase_scale,1)
  call gildas_real('WINDANGLE$',windangle,1)   ! deg
  call gildas_real('WINDVELO$',windvelo,1) ! m/s
  ! calibrator
  call gildas_logi('DO_CALIB$',do_calib,1)
  call gildas_char('CAL_UV_TABLE$',cal_file)
  call gildas_real('DEADTIME$',deadtime,1) ! sec
  call gildas_real('CAL_INTEG$',cal_integ,1)   ! sec
  call gildas_real('SOURCE_INTEG$',source_integ,1) ! sec
  call gildas_real('CAL_DIST$',cal_dist,1) ! deg
  call gildas_real('CAL_ANGLE$',cal_angle,1)   ! deg
  call gildas_real('ALTITUDE$',alt,1)  ! m
  ! wvr correction
  call gildas_logi('DO_RADIOM$',do_radiom,1)
  call gildas_real('WVR_PRECIS$',wvr_precis,1)
  call gildas_real('WVR_NOISE$',wvr_noise,1)
  call gildas_logi('DO_CORRECT$',do_correct,1)
  ! amplitude errors
  call gildas_real('AMPLITUDE$',amplitude,2)
  call gildas_real('AMP_TIME$',amp_time,1) ! sec
  ! anomalous refraction
  call gildas_logi('DO_ANREFR$',do_anrefr,1)
  call gildas_close
  !
  if (do_correct) do_calib = .true.
  !
  ! Current limitation
  if ((.not.new).and.(do_calib)) then
    call gagout('E-UV_TRACK,  Options not compatible')
    stop
  endif
  !
  ! Convert to rad
  decs = decs*pi/180.0
  phase = phase*pi/180.0
  windangle = windangle*pi/180.0
  cal_angle = cal_angle*pi/180.0
  wvr_noise = wvr_noise*pi/180.0
  !
  ! CAL_INTEG and SOURCE_INTEG are in dump, convert in time (sec)
  cal_integ = cal_integ*integ_time
  source_integ = source_integ*integ_time
  !
  ! Translate angular distance into linear distance at altitude alt
  cal_dist = cal_dist*pi/180.0
  cal_dist = alt*tan(cal_dist)
  !
  ! Output uvt file: source
  chain = file
  call sic_parsef(chain,file,' ','.uvt')
  call gagout('W-UV_TRACK,  Source table name '   &
     &    //file(1:lenc(file)))
  !
  ! Ouput uvt file: calibrator
  if (do_calib) then
    chain = cal_file
    call sic_parsef(chain,cal_file,' ','.uvt')
    call gagout('W-UV_TRACK,  Calibrator table name '   &
     &      //cal_file(1:lenc(cal_file)))
  endif
  !
  ! Use all stations in station file
  chain = fstation
  ier = sic_getlog(chain)
  call sic_parsef (chain,fstation,' ','.dat')
  !
  ! Antenna Diameter and Min UV spacing
  if (diameter.eq.0) then
    call gagout ('W-UV_TRACKS,  Antenna size unknown. '//   &
     &      'No shadowing warnings will be given.')
    jpk = 1.0
  else
    !
    ! Jy/K for 70 % Aperture efficiency
    jpk = 2.0*1.38e3*4.0/(pi*diameter**2)/0.70
    write(chain,'(A,F7.2,A)') 'I-UV_TRACKS, Using ',jpk,   &
     &      ' Jansky/K'
    call gagout(chain)
  endif
  !
  ! Hour angle coverage
  horizon = max(3.0,min(horizon,90.0))
  !
  ! Observatory coordinates
  call amset(latitud,amat)     ! Hour-Dec to Az-El matrix
  !
  ! Source is visible?
  hmin = a_lever(sngl(decs),sngl(latitud),horizon)
  if (hmin.ge.0) then
    write(6,*) 'Dec. ',decs
    write(6,*) 'Latitude ',latitud
    write(6,*) 'E-UV_TRACK,  Source is not visible'
    call sysexi(fatale)
  endif
  !
  ! Declination
  sd_sou = sin(decs)
  cd_sou = cos(decs)
  sd_cal = sin(decs)
  cd_cal = cos(decs)
  !
  ! Hour angle range
  hmax = -hmin
  if (hlim(1).ne.0.0) then
    if (hlim(1).lt.hmin) then
      write(6,*) 'W-UV_TRACK,  Source rises only at ',hmin
    else
      hmin = hlim(1)
    endif
  endif
  if (hlim(2).ne.0.0) then
    if (hlim(2).gt.hmax) then
      write(6,*) 'W-UV_TRACK,  Source already sets at ',hmax
    else
      hmax = hlim(2)
    endif
  endif
  !
  ! Open Station Main List; Get best coverage from First Line
  ier = sic_getlun (lun)
  ier = sic_open(lun,fstation(1:lenc(fstation)),'OLD',.true.)
  if (ier.ne.0) goto 998
  read (lun,'(A)',iostat=ier,end=998,err=998) chain
  !
  ! Handle various formats.
  array = 0.0
  ok = chain(1:1).eq.'!'
  if (ok) then
    do while(ok)
      read(lun,'(A)',iostat=ier) chain
      ok = chain(1:1).eq.'!'
    enddo
  else
    read(lun,'(A)',iostat=ier) chain
  endif
  array = array**2
  !
  ! Read coordinates from station file
  ! For each antenna, read: X,Y,Z,Diameter,BX,BY with BX,BY the baselines
  ! projected onto the local horizontal plane
  nstat = 0
  xx = 0.
  yy = 0.
  zz = 0.
  ok = .true.
  do while (ok)
    nstat = nstat+1
    i = 1
    do while(chain(i:i).eq.' ')
      i = i+1
    enddo
    ip = index(chain(i:),' ')+i
    read(chain(ip:),*,iostat=ier) x(nstat),y(nstat),z(nstat),dd,   &
     &      bx(nstat),by(nstat)
    xx = xx+x(nstat)
    yy = yy+y(nstat)
    zz = zz+z(nstat)
    read(lun,'(A)',iostat=ier) chain
    ok = ier.eq.0
  enddo
  close(unit=lun)
  call sic_frelun(lun)
  !
  ! Check diameter (done only for the last antenna)
  if (dd.ne.diameter) then
    call gagout ('W-UV_TRACKS,  Antenna size in configuration '//   &
     &      'file different from task input.')
  endif
  !
  ! Array size
  xx = xx/nstat
  yy = yy/nstat
  zz = zz/nstat
  array = 0.0
  do i=1,nstat
    array = max(array,(x(i)-xx)**2+   &
     &      (y(i)-yy)**2+(z(i)-zz)**2)
  enddo
  array = 2.0*sqrt(array)
  write(6,*) 'I-UV_TRACKS, Array size is ',array
  !
  ! Integration time (in secondes)
  if (integ_time.eq.0) then
    integ_time = 24.*3600.*uv_spacing/(4.*pi*array)
  endif
  integ_time = nint(integ_time)
  if (integ_time.gt.step_time) integ_time = step_time
  write(6,*) 'I-UV_TRACKS, Integration time ',integ_time,' sec.'
  !
  ! Precompute the coordinates
  frac = integ_time/3600.      ! in hours
  deadtime = deadtime/3600.
  nh = 0
  nh_sou = 0
  nh_cal = 0
  h = pi*hmin/12.0
  t = 0.
  ontime = 0.0
  if (do_calib) then
    !
    ! Sequence: source_integ seconds on source
    !           dead time
    !           cal_integ seconds on calibrator
    !           dead_time
    ! But start with a Calibrator
    ! H = PI*(HMIN-2*DEADTIME-CAL_INTEG)/12.0
    ontime = source_integ
    !
    do while (h.lt.(pi*hmax/12.0))
      do while (ontime.lt.source_integ)
        ch = cos(h)
        sh = sin(h)
        nh = nh + 1
        nh_sou = nh_sou+1
        zch(nh) = ch
        zsh(nh) = sh
        cal(nh) = .false.
        h = h+pi*frac/12.0
        hour(nh) = h
        t = t+integ_time
        time(nh) = t
        ontime = ontime+integ_time
      enddo
      ontime = 0.0
      h = h+pi*deadtime/12.0
      t = t+deadtime*3600.
      do while (ontime.lt.cal_integ)
        ch = cos(h)
        sh = sin(h)
        nh = nh + 1
        nh_cal = nh_cal+1
        zch(nh) = ch
        zsh(nh) = sh
        cal(nh) = .true.
        h = h+pi*frac/12.0
        hour(nh) = h
        t = t+integ_time
        time(nh) = t
        ontime = ontime+integ_time
      enddo
      ontime = 0.0
      h = h+pi*deadtime/12.0
      t = t+deadtime*3600.
    enddo
  else
    !
    ! Only source observations
    do while (h.lt.(pi*hmax/12.0))
      ch = cos(h)
      sh = sin(h)
      nh = nh + 1
      zch(nh) = ch
      zsh(nh) = sh
      cal(nh) = .false.
      h = h+pi*frac/12.0
    enddo
    nh_sou = nh
  endif
  write(6,*) 'Number of time dump ',nh
  write(6,*) 'Number of time dump on source ',nh_sou
  write(6,*) 'Number of time dump on calib. ',nh_cal
  tmp = t/integ_time
  write(6,*) 'Total equivalent dumps ',tmp
  !
  ! Bandwidth (in MHz)
  bandwidth = bandw            ! single -> double precision
  if (bandwidth.eq.0) then
    bandwidth = 8000.
  endif
  !
  ! Create or open SOURCE uvt table -- use X
  date = -10000.
  nvis = nh_sou*nstat*(nstat-1)/2
  write(6,*) 'Source: Number of visibilities ',nvis
  if (new) then
    xima%gil%inc(2) = integ_time
    call init_table (xima,file,nvis,decs,freq,bandwidth,error)
  else
    call extend_table (xima,file,nvis,decs,freq,bandwidth,error)
    date = -9999.
  endif
  if (error) then
    write(6,*) 'F-UV_TRACK,  Cannot open output Table'
    call sysexi(fatale)
  endif
  if (new) then
    allocate (xima%r2d(xima%gil%dim(1), xima%gil%dim(2)), stat=ier)
  else
    allocate (xima%r2d(xima%gil%dim(1), xima%trc(2)-xima%blc(2)+1), stat=ier)
  endif
  if (ier.ne.0) then
    write(6,*) 'W-UV_TRACK,  Cannot allocate output Table'
    call sysexi(fatale)
  endif
!!  ipx = gag_pointer(addr,memory)
  !
  ! Create CALIBRATOR uvt table -- use Y
  if (do_calib) then
    nvis = nh_cal*nstat*(nstat-1)/2
    write(6,*) 'Calibrator: Number of visibilities ',nvis
    call init_table (yima,cal_file,nvis,decs,freq,bandwidth,error)
    if (error) then
      write(6,*) 'F-UV_TRACK,  Cannot open output Table'
      call sysexi(fatale)
    endif
    allocate (yima%r2d(yima%gil%dim(1), yima%gil%dim(2)), stat=ier)
!    ipy = gag_pointer(addr,memory)
  endif
  !
  ! Open phase screen file -- use Z -- data in IPB
  if (do_screen) then
    call open_screen(phase_screen,nnx,nny,dx,dy,zima,phase_scale,error)
    if (error) then
      write(6,*) 'F-UV_TRACK,  Problem with Screen Phase image'
      call sysexi(fatale)
    endif
!    ipb = gag_pointer(addr,memory)
!    ipc = ipb + nnx*nny        ! Gradient address
    !
    ! Rotate and check the array layout, to be used for phase extraction
    call prepare_array(bx,by,nstat,windangle,windvelo,t,   &
     &      cal_dist,nnx,nny,dx,dy,error)
    if (error) goto 999        ! CALL SYSEXI(FATALE)
    !
    ! Distance to calibrator, on axis // and perp. to wind directions
    cal_dist_x = cal_dist*cos(cal_angle)
    cal_dist_y = cal_dist*sin(cal_angle)
  endif
  !
  ! Prepare phase gradient -- data in IPC
  if ((do_screen).and.(do_anrefr)) then
    !
    ! Translate phase gradient into pointing error
    call phase_to_ptg(zima%r3d(1,1,2),nnx,nny,freq,phase_scale)
  endif
  !
  ! Amplitude errors: compute drift rate for each antenna from given rms
  call compute_amp(drift,nstat,amplitude(2))   ! Drift
  call compute_amp(ampli,nstat,amplitude(1))   ! Offset
  !
  ! Time loop
  uvmin2 = diameter**2
  nshadow = 0
  nshadow_s = 0
  nshadow_c = 0
  nfill = 0
  nfill_s = 0
  nfill_c = 0
  next_c = 0
  next_s = 0
  h = pi*hmin/12.0
  later = time(nh) + 10.0      ! Time after end of data
  t0 = later
  ptg = time(1)
  !
  do k = 1,nh
    !
    ! Time (sec)
    t = time(k)
    !
    ! Calibrate the amplitude?
    if ((t-ptg).gt.amp_time) then
      ptg = t
      call compute_amp(ampli,nstat,amplitude(1))
    endif
    !
    ! Source or calibrator?
    if (cal(k)) then
      sd = sd_cal
      cd = cd_cal
      offsetx = cal_dist_x
      offsety = cal_dist_y
!      ipa = ipy
      t0 = later
    else
      sd = sd_sou
      cd = cd_sou
      offsetx = 0.0
      offsety = 0.0
!      ipa = ipx
    endif
    !
    ! Reset shadowing
    do i=1,nstat
      complete(i) = .true.
    enddo
    !
    ! Check for shadowing
    do i=1,nstat-1
      if (complete(i)) then
        do j=i+1,nstat
          if (complete(j)) then
            xx = x(i)-x(j)
            yy = y(i)-y(j)
            zz = z(i)-z(j)
            uk = zsh(k)*xx + zch(k)*yy
            vk = sd*(-zch(k)*xx+zsh(k)*yy)+cd*zz
            if ((uk**2+vk**2).le.uvmin2) then
              test = (xx*zch(k) - yy*zsh(k))*cd + zz*sd
              if (test.gt.0.0) then
                complete(j) = .false.
                ff = j
              else
                complete(i) = .false.
                ff = i
              endif
              !!                        PRINT *,'U2+V2',UK**2+VK**2,UK,VK,UVMIN2,I,J,FF
            endif
          endif
        enddo
      endif
    enddo
    !
    ! Compute source elevation
    avec(1) = zch(k)*cd
    avec(2) = zsh(k)*cd
    avec(3) = sd
    call matmul(amat,avec,bvec,1)
    call dangle(az,el,bvec)
    !
    ! Difference azimuth -- wind direction
    ! Angle convention:
    ! Azimuth: 0 South, -90 East, +90 West
    ! Windangle: 0 East, +90 North, -0 South (trig.)
    ! To get same convention than windangle: az = -az-90
    !
    az = -az-pi/2.
    az = az-windangle
    !
    ! Compute Tsys
    call atmos(trec,tsys,tau,el)
    if (first) then
      write(chain,'(A,F8.1)') 'I-UV_TRACK, Typical Tsys ',tsys
      call gagout(chain)
      first = .false.
    endif
    !
    ! Compute Weight
    weight= 2*bandwidth*integ_time/(jpk*tsys)**2
    total = total+weight
    !
    ! Generate phase noise from input phase screen
    if (do_screen) then
      !
      call phase_noise(phn,nstat,zima%r3d,nnx,nny,dx,dy,   &
     &        bx,by,windvelo,t,offsetx,offsety,phase_scale,   &
     &        do_anrefr,zima%r3d(1,1,2),az,el,azerr,elerr)
      !
      ! Radiometer correction
      if (do_radiom) then
        if (cal(k)) then
          do i=1,nstat
            phcal(i) = phn(i)
          enddo
        else
          call phase_rad(phrad,phn,nstat,wvr_precis,t,   &
     &            phn0,t0,wvr_noise)
        endif
      endif
    else
      !
      ! Pure random noise
      call phase_random(phase,phn,nstat)
    endif
    !
    ! Generate amplitude noise
    call ampli_noise(amperror,nstat,ampli,drift,t,ptg)
    !
    ! Fill the table now
    do i=1,nstat-1
      do j=i+1,nstat
        !
        ! Phase
        if ((.not.cal(k)).and.do_radiom) then
          ph = phrad(i)-phrad(j)
          if (do_correct) then
            ph = ph - (phcal(i)-phcal(j))
          endif
        else
          ph = phn(i)-phn(j)
        endif
        !
        ! Amplitude
        amp = sqrt(amperror(i)*amperror(j))
        !
        ! Pointing error (anomalous refraction)
        ! RADEC convert az,el offsets into ra,dec offsets
        if (do_anrefr) then
          call radec(azerr(i),elerr(i),hour(k),latitud,decs,   &
     &            ra_err(1),dec_err(1))
          call radec(azerr(j),elerr(j),hour(k),latitud,decs,   &
     &            ra_err(2),dec_err(2))
        else
          ra_err(1) = 0.
          dec_err(1) = 0.
          ra_err(2) = 0.
          dec_err(2) = 0.
        endif
        ! RA_ERR(1) = azerr(i)
        ! DEC_ERR(1) = elerr(i)
        ! RA_ERR(2) = azerr(j)
        ! DEC_ERR(2) = elerr(j)
        !
        ! Baseline
        xx = x(i)-x(j)
        yy = y(i)-y(j)
        zz = z(i)-z(j)
        uk = zsh(k)*xx + zch(k)*yy
        vk = sd*(-zch(k)*xx+zsh(k)*yy)+cd*zz
        if (complete(i).and.complete(j)) then
          total = total+weight
          nfill = nfill+1
          if (cal(k)) then
            nfill_c = nfill_c+1
            next_c = next_c+1
            call fill_table (uk,vk,date,t,   &
     &            weight,i,j,yima%r2d(1,next_c),el,   &
     &            integ_time,ph,amp,ra_err,dec_err)
          else
            nfill_s = nfill_s+1
            next_s = next_s+1
            call fill_table (uk,vk,date,t,   &
     &            weight,i,j,xima%r2d(1,next_c),el,   &
     &            integ_time,ph,amp,ra_err,dec_err)
          endif
        else
          nshadow = nshadow+1
          if (cal(k)) then
            nshadow_c = nshadow_c+1
            next_c = next_c+1
            call fill_table (uk,vk,date,t,   &
     &            0.0,i,j,yima%r2d(1,next_c),el,   &
     &            integ_time,ph,amp,ra_err,dec_err)
          else
            nshadow_s = nshadow_s+1
            next_s = next_s+1
            call fill_table (uk,vk,date,t,   &
     &            0.0,i,j,xima%r2d(1,next_c),el,   &
     &            integ_time,ph,amp,ra_err,dec_err)
          endif
        endif
      enddo
    enddo
    !
    ! End time loop
  enddo
  write(6,*) 'Wrote ',nfill,' visibilities (',nshadow,' shadowed)'
  write(6,*) 'Source: ',nfill_s, 'vis. (',nshadow_s,' shadowed)'
  write(6,*) 'Calib.: ',nfill_c, 'vis. (',nshadow_c,' shadowed)'
  !
  ! Free, close, etc
  call gdf_write_data (xima, xima%r2d, error)
  call cut_table(xima,file,0,error)
  if (do_calib) then
    call gdf_write_data (yima, yima%r2d, error)
    call cut_table(yima,cal_file,0,error)
  endif
  if (do_screen) then
    call gdf_close_image(zima,error)
  endif
  !
  ! Write estimate noise
  total = 1e-3/sqrt(total)
  write(chain,*) 'I-UV_TRACK,  Expected noise ',total,' Jy/beam'
  call gagout(chain(2:))
  call sysexi(1)
  !
  998   call gagout('E-UV_TRACK,  Trouble with ASTRO_STATIONS')
  call gagout(fstation)
  call putios('E-UV_TRACK, ',ier)
  close(unit=lun)
  call sic_frelun (lun)
  999   call gagout('F-UV_TRACK,  Fatal Error')
  call sysexi(fatale)
end program uv_track_phase
!<FF>



!!subroutine newuvt_init (xima,name,nvis,error)
subroutine init_table (xima,name,nvis,dec,freq,bandwidth,error)
  use image_def
  use gkernel_interfaces
  use gbl_format
  !---------------------------------------------------------------------
  ! Creates the output table header in X (the significant header parameters
  ! have already been defned in clic_table)
  !---------------------------------------------------------------------
  type (gildas), intent(inout) :: xima  ! UV data file
  character(len=*), intent(in) :: name  ! desired file name
  integer, intent(in) :: nvis           ! Number of visibilities
  logical, intent(out) :: error         ! Error flag
  real(8), intent(in) :: dec                         !
  real(8), intent(in) :: freq                        !
  real(8), intent(in) :: bandwidth                   !
  ! Local
  integer :: i, last
  !
  ! Do not nullify X header here: it has already been partly computed before.
  !
  error = .false.
  !
  xima%file = name
  xima%gil%blan_words = def_blan_words
  xima%gil%extr_words = def_extr_words
  xima%gil%desc_words = def_desc_words
  xima%gil%posi_words = def_posi_words
  xima%gil%proj_words = def_proj_words
  xima%gil%spec_words = def_spec_words
  xima%gil%reso_words = def_reso_words
  xima%gil%uvda_words = 2 ! Not Zero is enough
  !
  xima%gil%eval = 0.
  xima%gil%dim(2) = nvis              ! +1 ! = add the dummy uv = 7.5 m point
  xima%gil%ref(2) = 0.
  xima%gil%inc(2) = 1.                  ! needed to avoid crash in GRAPHIC
  xima%gil%val(2) = 0.
  xima%gil%ndim = 2
  xima%char%unit = 'Jy'
  xima%char%syst = 'EQUATORIAL'
  xima%gil%ptyp = p_azimuthal
  xima%gil%pang = 0.0
  xima%gil%xaxi = 0
  xima%gil%yaxi = 0
  xima%gil%faxi = 1
  !
  xima%gil%dec = dec
  xima%gil%epoc = 2000.0
  xima%gil%a0 = xima%gil%ra
  xima%gil%d0 = xima%gil%dec
  xima%char%line = ' '
  xima%gil%fres = bandwidth
  if (freq.ne.0d0) then
    xima%gil%fima = (freq+12.0)*1d3
    xima%gil%freq = freq*1d3
  else
    xima%gil%fima = 102d3
    xima%gil%freq = 90d3
  endif
  xima%gil%val(1) = xima%gil%freq
  !
  ! Here define the order in which you want the extra "columns"
  xima%gil%column_pointer = 0
  xima%gil%column_size = 0
  xima%gil%column_pointer(code_uvt_u) = 1
  xima%gil%column_pointer(code_uvt_v) = 2
  xima%gil%column_pointer(code_uvt_w) = 3
  xima%gil%column_pointer(code_uvt_date) = 4
  xima%gil%column_pointer(code_uvt_time) = 5
  xima%gil%column_pointer(code_uvt_anti) = 6
  xima%gil%column_pointer(code_uvt_antj) = 7
  xima%gil%natom = 3
  xima%gil%nstokes = 1
  ! Extra columns
  xima%gil%fcol = 8
  last = xima%gil%fcol+xima%gil%natom * xima%gil%nchan
  xima%gil%column_pointer(code_uvt_el) = last
  last = last+1
  xima%gil%column_pointer(code_uvt_int) = last
  last = last+1
  xima%gil%column_pointer(code_uvt_xoff) = last  ! xoffi
  last = last+1
  xima%gil%column_pointer(code_uvt_yoff) = last  ! yoffi
  last = last+1
  xima%gil%column_pointer(code_uvt_loff) = last  ! xoffj
  last = last+1
  xima%gil%column_pointer(code_uvt_moff) = last  ! yoffj
  do i=1,code_uvt_last
    if (xima%gil%column_pointer(i).ne.0) xima%gil%column_size(i) = 1
  enddo
  !
  xima%gil%nvisi = nvis
  xima%gil%type_gdf = code_gdf_uvt
  call gdf_setuv (xima,error)
  xima%loca%size = xima%gil%dim(1) * xima%gil%dim(2)
  print *, 'Into newuvt_init ',xima%gil%nvisi, xima%gil%nchan, xima%gil%dim(1:2)
  print *, 'Into newuvt_init UVDA_WORDS', xima%gil%uvda_words
  call gdf_create_image (xima,error)
  print *, 'Done newuvt_init '
end subroutine init_table
!<FF>
!!subroutine newuvt_extend (xima,name,nvis,nn,ndobs,ndscan,error,lc)
subroutine extend_table (xima,name,nvis,dec,freq,bandwidth,error)
  use image_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! Open a Table to extend it.
  !---------------------------------------------------------------------
  type (gildas), intent(inout) :: xima  ! UV data file
  character(len=*), intent(in) :: name  ! desired file name
  integer, intent(in) :: nvis           ! Number of visibilities
  logical, intent(out) :: error         ! Error flag
  real(8), intent(in) :: dec                         !
  real(8), intent(in) :: freq                        !
  real(8), intent(in) :: bandwidth                   !
!  integer, intent(in) :: nn             !
!  integer, intent(in) :: ndobs(nn)      !
!  integer, intent(in) :: ndscan(nn)     !
!  logical, intent(in) :: lc             ! Check table before
  ! Local
  integer(kind=size_length) :: mvis
  integer :: ier
  character(len=60) :: chain
  !-----------------------------------------------------------------------
  !
  call gdf_read_gildas(xima, name, '.uvt', error, data=.false.)
  if (.not.error) then
    if (abs(xima%gil%dec-dec).gt.1d-6) then
      write(6,*) 'W-ASTRO_UV,  Different declinations'
      error = .true.
    endif
    if (freq.ne.0.0 .and. (abs(freq-xima%gil%freq*1d-3).gt.1d-6)) then
      write(6,*) 'W-ASTRO_UV,  Different frequencies'
      error = .true.
    endif
    if (abs(bandwidth-xima%gil%fres).gt.1d-6) then
      write(6,*) 'W-ASTRO_UV, Different bandwidth'
      error = .true.
    endif
  endif
  if (error) return
  !
  ! Compute new size, and remember there may be more preallocated data
  ! than used in the table to be appended
  write(chain,1001) xima%gil%dim(2),nvis
1001 format('Old table size ',i8,' Adding ',i8)
  call gagout('I-EXTEND_TABLE,  '//chain)
  !
  mvis = xima%gil%dim(2)+nvis
  !
  print *,'Lead Trail ',xima%gil%nlead, xima%gil%ntrail
  call gdf_extend_image (xima,mvis,error)
  print *,'Lead Trail ',xima%gil%nlead, xima%gil%ntrail
  if (error) then
    call gagout('I-EXTEND_TABLE,  Table extension failed')
    return
  endif
  !
  ! Map only new region
  xima%blc(1) = 1
  xima%blc(2) = xima%gil%dim(2)+1-nvis
  xima%trc(1) = xima%gil%dim(1)
  xima%trc(2) = xima%gil%dim(2)
  print *, 'Done newuvt_extend '
end subroutine extend_table
!
subroutine cut_table (xima,name,ncut,error)
  use image_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! Update the number of visibilities
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: xima !
  character(len=*) :: name          !
  integer, intent(in) :: ncut         ! Number of missing visibilities
  logical :: error                    !
  !
  ! Local
  character(len=80) :: chain
  !----------------------------------------------------------------------
  !
  xima%gil%nvisi = xima%gil%dim(2) - ncut
  write(chain,1001) xima%gil%dim(2), xima%gil%nvisi
  xima%gil%dim(2) = xima%gil%nvisi
  call gagout('I-CUT_TABLE,  '//chain)
  call gdf_update_header(xima,error)
  print *, 'Done newuvt_cut ',xima%gil%nchan
  !
1001 format('Old size ',i8,' New ',i8)
end subroutine cut_table


subroutine fill_table (u,v,d,t,w,ideb,ifin,visi,e,dt,ph,amp,   &
     &    err_x,err_y)
  !---------------------------------------------------------------------
  ! 7 Parametres :
  ! U, V, W=0, Date, Temps, Ant1, Ant2
  ! 3 values
  ! Reel, Imag, Poids
  ! 1.0,   0.0, 1.0
  !---------------------------------------------------------------------
  real :: u                         !
  real :: v                         !
  real :: d                         !
  real :: t                         !
  real :: w                         !
  integer :: ideb                   !
  integer :: ifin                   !
  real :: visi(*)                   !
  real*8 :: e                       !
  real :: dt                        !
  real :: ph                        !
  real :: amp                       !
  real*8 :: err_x(2)                !
  real*8 :: err_y(2)                !
  !
  visi(1) = u
  visi(2) = v
  visi(3) = 0.0
  visi(4) = d
  visi(5) = t
  visi(6) = ideb
  visi(7) = ifin
  visi(8) = amp*cos(ph)
  visi(9) = amp*sin(ph)
  visi(10) = w
  visi(11) = e
  visi(12) = dt
  visi(13) = err_x(1)
  visi(14) = err_y(1)
  visi(15) = err_x(2)
  visi(16) = err_y(2)
end
!<FF>
function a_lever(d,d0,el)
  !---------------------------------------------------------------------
  ! Lever d'une etoile de declinaison D a latitude D0
  ! Ce code est different de "lever" de GreG, donc je l'appelle A_LEVER
  ! (sinon big problemes,...GD, 8-10-1992)
  ! D Declination in radians
  ! D0  Latitude in degrees
  !   EL  elevation limit in degrees
  ! LEVER Hour angle in Hours
  !
  ! PI/2-D0+EL < D  Circumpolaire
  ! D0-PI/2+EL < D < PI/2-D0+EL H = ACOS (TAN(D)/TAN(D0-PI/2))
  ! D < D0-PI/2+EL  Toujours cocheue...
  !
  ! Formule applicable a la partie visible du ciel en projection
  ! sur un plan
  !---------------------------------------------------------------------
  real :: a_lever                   !
  real :: d                         !
  real :: d0                        !
  real :: el                        !
  ! Local
  real :: dd,d1,d2,ee
  real*8 :: pi
  parameter (pi=3.14159265358979323846d0)
  !
  if (d0.lt.0.) then
    d2 = -d
    d1 = -d0*pi/180.0
  else
    d2 = d
    d1 = d0*pi/180.0
  endif
  dd = d1-pi*0.5d0
  ee = el*pi/180.
  a_lever = (-sin(ee)+sin(d2)*cos(dd))/(cos(d2)*sin(dd))
  if (a_lever.le.-1.0) then
    a_lever = -12.0            ! Circumpolar
  elseif (a_lever.ge.1.0) then
    a_lever = 0.0              ! Not visible
  else
    a_lever = -12.0/pi* acos(a_lever)
  endif
end
!<FF>
subroutine amset(obslat,amat)
  !---------------------------------------------------------------------
  !   subroutine to provide transformation matrix from hour angle - dec
  !       into azimuth - elevation.
  !---------------------------------------------------------------------
  real*8 ::  obslat                 ! in degrees
  real*8 ::  amat(9)                !
  ! Global
  include 'gbl_pi.inc'
  ! Local
  real*8 ::  x1,y1,z1
  !
  x1=pi/180d0*obslat
  y1=dsin(x1)
  z1=dcos(x1)
  amat(1)=-y1
  amat(2)=0.d0
  amat(3)=z1
  amat(4)=0.d0
  amat(5)=-1.d0
  amat(6)=0.d0
  amat(7)=z1
  amat(8)=0.d0
  amat(9)=y1
end
!<FF>
subroutine dangle(along,alat,a)
  !---------------------------------------------------------------------
  ! version 1.0  mpifr cyber edition  22 may 1977.
  ! see nod 2 manual page m 9.1
  ! c.g haslam       mar  1972.
  ! this routine recovers the longitude and latitude angles, along
  ! (0 - 360) and alat ( +.- 180) in deg_to_radrees, which correspond to the
  ! vector a.
  !---------------------------------------------------------------------
  real*8 ::   along                 !
  real*8 ::   alat                  !
  real*8 ::   a(3)                  !
  ! Global
  include 'gbl_pi.inc'
  ! Local
  real*8 ::   aa
  !
  aa     = a(1)*a(1)+a(2)*a(2)
  aa     = dsqrt(aa)
  alat   = pi/2d0
  if (aa.ge.0.000001d0) then
    aa = a(3)/aa
    alat = datan(aa)           ! latitude in Radian
  endif
  !
  if (a(2).ne.0.d0 .or. a(1).ne.0.d0) then
    along=datan2(a(2),a(1))    ! longitude in Radian
  else
    along = 0.d0
  endif
end
!<FF>
subroutine dcosin(along,alat,a)    ! direction cosinus
  !---------------------------------------------------------------------
  ! version 1.0  mpifr cyber edition  22 may 1977.
  ! see nod 2 manual page m 9.1
  ! c.g haslam       mar  1972.
  ! this routine computes the vector a for the angles, along and alat,
  ! which should be specified in deg_to_radrees.
  !---------------------------------------------------------------------
  real*8 ::   along                 !
  real*8 ::   alat                  !
  real*8 ::   a(3)                  !
  ! Global
  include 'gbl_pi.inc'
  ! Local
  real*8 ::   x,y,z
  !
  x    = along                 ! x in radians
  y    = alat                  ! y in radians
  z    = dcos(y)
  a(1) = dcos(x)*z
  a(2) = dsin(x)*z
  a(3) = dsin(y)
end
!<FF>
subroutine matmul(mat,a,b,n)
  !---------------------------------------------------------------------
  ! version 1.0  mpifr cyber edition  22 may 1977.  G.Haslam
  ! version 2.0  iram
  !
  ! this routine provides the transformation of vector a to vector b
  ! using the n dimensional direction cosine array, mat.
  !---------------------------------------------------------------------
  real*8 ::    mat(3,3)             !
  real*8 ::    a(3)                 !
  real*8 ::    b(3)                 !
  integer ::   n                    !
  ! Local
  integer ::   i,j
  !
  if (n.gt.0) then
    do i=1,3
      b(i) = 0.d0
      do j=1,3
        b(i) = b(i)+mat(i,j)*a(j)
      enddo
    enddo
  else
    do i=1,3
      b(i) = 0.d0
      do j=1,3
        b(i) = b(i)+mat(j,i)*a(j)
      enddo
    enddo
  endif
end
!<FF>
subroutine atmos(trec,tsys,tau0,el)
  real :: trec                      !
  real :: tsys                      !
  real :: tau0                      !
  real*8 :: el                      !
  ! Local
  real :: tau,tatm,feff,tcab
  feff = 0.93
  tatm = 240.0
  tcab = 300.0
  !
  tau = tau0/sin(el)
  tsys = feff*(1.-exp(-tau))*tatm + (1.0-feff)*tcab + trec
  tsys = exp(tau)/feff*tsys
end
!<FF>
!<FF>
subroutine open_screen(phase_screen,nnx,nny,dx,dy,s,scale,error)
  use gildas_def
  use gkernel_interfaces
  use image_def
  type(gildas), intent(inout) :: s
  character(len=*) :: phase_screen      !
  integer :: nnx                        !
  integer :: nny                        !
  real :: dx                            !
  real :: dy                            !
  real :: scale                         !
  logical :: error                      !
  ! Global
  include 'gbl_pi.inc'
  ! Local
  integer :: n
  character(len=256) :: name
  !
  n = lenc(phase_screen)
  if (n.le.0) return
  name = phase_screen(1:n)
  call gildas_null (s)
  call gdf_read_gildas (s, name, '.gdf', error)
  if (error) then
    call gagout ('F-UV_TRACK, Cannot read phase screen')
    return
  endif
  !
  if (s%gil%dim(3).ne.3) then
    call gagout('F-UV_TRACK, Phase sreen does not have gradients')
    error = .true.
    return
  endif
  !
  ! Dimensions
  nnx = s%gil%dim(1)
  nny = s%gil%dim(2)
  dx = s%gil%inc(1)
  dy = s%gil%inc(2)
  !
  ! Scaling factor for phases
  if (s%gil%inc(3).eq.0) s%gil%inc(3) = 1.0
  scale = scale / s%gil%inc(3)
  print *,'Scale ',scale,s%gil%inc(3)
  scale = scale*pi/180.0
  if (scale.eq.0.) then
    scale = pi/180.0
  endif
  !
end
!<FF>
subroutine prepare_array(bx,by,nstat,windangle,windvelo,   &
     &    time,cal_dist,nnx,nny,dx,dy,error)
  integer :: nstat                  !
  real :: bx(nstat)                 !
  real :: by(nstat)                 !
  real :: windangle                 !
  real :: windvelo                  !
  real :: time                      !
  real :: cal_dist                  !
  integer :: nnx                    !
  integer :: nny                    !
  real :: dx                        !
  real :: dy                        !
  logical :: error                  !
  ! Local
  real :: tmp,cs,sn,xx,yy,xmin,xmax,ymin,ymax
  integer :: i
  !
  error = .false.
  !
  ! Rotate the array layout by windangle
  !
  cs = cos(windangle)
  sn = sin(windangle)
  do i = 1,nstat
    tmp = bx(i)
    bx(i) =  tmp*cs + by(i)*sn
    by(i) = -tmp*sn + by(i)*cs
  enddo
  !
  ! Array dimension
  xmin = 1e20
  ymin = 1e20
  xmax = 0.0
  ymax = 0.0
  do i = 1,nstat
    xmin = min(xmin,bx(i))
    ymin = min(ymin,by(i))
    xmax = max(xmax,bx(i))
    ymax = max(ymax,by(i))
  enddo
  write(*,*) 'Min/max antenna positions ',xmin,ymin,xmax,ymax
  write(*,*) 'Wind in X ',windvelo,time,windvelo*time
  write(*,*) 'Calib distance ',cal_dist
  !
  ! Check the dimension of the phase screen
  ! Max. distance to be added in X = windvelo * max elapsed time
  ! Max. distance to be added in Y = 2*distance to calibrator (to allow
  !      any cal_angle)
  xx = xmax-xmin + windvelo*time +2*cal_dist + 2*dx
  yy = ymax-ymin + 2*cal_dist + 2*dy
  if ((dx*nnx).le.xx) then
    call gagout('W-UV_TRACKS,  Phase screen too short, Wrapping')
  endif
  if ((dy*nny).le.yy) then
    call gagout('E-UV_TRACKS,  Phase screen too narrow')
    write(*,*) 'Phase screen X',dx,nnx,' Y ',dy,nny
    write(*,*) 'Wind ',windvelo
    write(*,*) 'Time ',time
    write(*,*) 'Cal. distance ',cal_dist
    error = .true.
    return
  endif
  !
  ! Move array: start at 1m in X, center the array in Y
  do i = 1,nstat
    bx(i) = bx(i)-xmin+1
    by(i) = by(i)-(ymax+ymin)/2.+nny*dy/2.
  enddo
  !
end
! <FF>
subroutine phase_noise(phn,nstat,screen,nnx,nny,dx,dy,   &
     &    bx,by,windvelo,time,offsetx,offsety,scale,do_anrefr,   &
     &    ptg,az,el,azerr,elerr)
  integer :: nstat                  !
  real :: phn(nstat)                !
  integer :: nnx                    !
  integer :: nny                    !
  real :: screen(nnx,nny)           !
  real :: dx                        !
  real :: dy                        !
  real :: bx(nstat)                 !
  real :: by(nstat)                 !
  real :: windvelo                  !
  real :: time                      !
  real :: offsetx                   !
  real :: offsety                   !
  real :: scale                     !
  logical :: do_anrefr              !
  real :: ptg(nnx,nny,2)            !
  real*8 :: az                      !
  real*8 :: el                      !
  real :: azerr(nstat)              !
  real :: elerr(nstat)              !
  ! Local
  integer :: n
  !
  integer :: i,px,py
  real :: offx, offy, tmpx, tmpy, cs, sn
  !
  ! Rotation angle for anomalous refraction
  cs = cos(az)
  sn = sin(az)
  !
  ! Translate array layout
  offx = windvelo*time + offsetx
  offy = offsety
  !
  ! Extract phase noise
  do i = 1,nstat
    px = nint((bx(i)+offx)/dx)+1
    px = mod(px+1,nnx) - 1     ! Automatic wrap around
    py = nint((by(i)+offy)/dy)+1
    if ((px.lt.1).or.(py.gt.nny).or.(py.lt.1)) then
      call gagout('W-UV_TRACKS,  Phase screen too small')
      phn(i) = 0.0
      azerr(i) = 0.0
      elerr(i) = 0.0
    else
      phn(i) = screen(px,py)*scale
      !
      !         if (i.eq.1) then
      !            write(*,*) 'ant. 1, time ',time,' position ',bx(1),by(1),
      !     $                 'offsets ',offx,offy, offsetx, 'in pixel ',px,py,
      !     $                 'phase',phn(1),'screen ',dx,dy,scale
      !         endif
      !
      ! Anomalous refraction
      if (do_anrefr) then
        tmpx = ptg(px,py,1)
        tmpy = ptg(px,py,2)
        azerr(i) =  tmpx*cs+tmpy*sn
        elerr(i) = -tmpx*sn+tmpy*cs
      endif
    endif
  enddo
  !
end
!<FF>
subroutine phase_random(phase,phn,n)
  real :: phase                     !
  integer :: n                      !
  real :: phn(n)                    !
  ! Local
  integer :: i
  real :: rangau
  !
  do i = 1,n
    phn(i) = rangau (phase)
  enddo
end
!<FF>
subroutine phase_rad(phrad,phn,n,precis,t,phn0,t0,noise)
  integer :: n                      !
  real :: phrad(n)                  !
  real :: phn(n)                    !
  real :: precis                    !
  real :: t                         !
  real :: phn0(n)                   !
  real :: t0                        !
  real :: noise                     !
  ! Local
  real :: rangau
  integer :: i
  logical :: debut
  !
  ! Computes phase deduced from radiometer data
  !   PHN = current atmospheric phase
  !   PHN0 = phase at beginning of correction
  !   PHRAD = after radiometric correction
  !
  debut = .false.
  if (t0.gt.t) then
    t0 = t
    debut = .true.
  endif
  !
  do i = 1,n
    if (debut) then
      phn0(i) = phn(i)
      phrad(i) = phn0(i)
    else
      phrad(i) = phn0(i) + (phn(i)-phn0(i))*precis
    endif
  enddo
  !
  ! Add WVR noise
  if (noise.gt.0) then
    do i = 1,n
      phrad(i) = phrad(i) + rangau (noise)
    enddo
  endif
end
!<FF>
subroutine compute_amp(drift,n,amplitude)
  integer :: n                      !
  real :: drift(n)                  !
  real :: amplitude                 !
  ! Local
  integer :: i
  real :: rangau
  !
  if (amplitude.eq.0) then
    do i = 1,n
      drift(i) = 0.0
    enddo
  else
    do i = 1,n
      drift(i) = rangau(amplitude)
    enddo
  endif
end
!<FF>
subroutine ampli_noise(amperror,n,ampli,drift,t,t0)
  integer :: n                      !
  real :: amperror(n)               !
  real :: ampli(n)                  !
  real :: drift(n)                  !
  real :: t                         !
  real :: t0                        !
  ! Local
  integer :: i
  real :: rangau, tt
  !
  tt = (t-t0)/3600.            ! in hours
  do i = 1,n
    amperror(i) = ampli(i)+drift(i)*tt !  in %
    amperror(i) = 1.-amperror(i)/100.
    if (amperror(i).lt.0.) then
      amperror(i) = 0.0
    endif
  enddo
  ! Print *,'Amp errr ',amperror(1),amperror(n)
  ! Print *,'Ampliude & Drift ',ampli(1),drift(1)
end
!<FF>
subroutine phase_to_ptg(gr,nnx,nny,freq,scale)
  integer :: nnx                    !
  integer :: nny                    !
  real :: gr(nnx,nny,2)             !
  real*8 :: freq                    !
  real :: scale                     !
  ! Local
  integer :: i,j
  real :: factor, lambda
  real*8 :: pi
  parameter (pi=3.141592653589793238d0)
  !
  lambda = 299792.458e3/(freq*1e9) ! in meter
  factor = lambda/(2*pi)       ! rad to meters
  factor = factor*scale        ! phase rms scaling factor (convert deg to rad)
  !
  ! phase gradient in deg/m
  ! * factor --> m/m
  ! atan --> pointing error in rad
  !
  do i=1,nnx
    do j=1,nny
      gr(i,j,1) = atan(gr(i,j,1)*factor)
      gr(i,j,2) = atan(gr(i,j,2)*factor)
    enddo
  enddo
  !
end
!<FF>
subroutine radec(along,elat,hour,tellat,dedate,dra,ddec)
  !---------------------------------------------------------------------
  ! Copy from task/nic/radec.f
  ! Modifications 31.07.01
  ! Original version: takes LST and RA as input, and computes HA
  !           SUBROUTINE RADEC(ALONG,ELAT,ALST,TELLAT,RADATE,DEDATE,DRA,DDEC)
  ! Present version: takes directly HA as input
  !           SUBROUTINE RADEC(ALONG,ELAT,HOUR,TELLAT,DEDATE,DRA,DDEC)
  !           All angles given and computed in radians
  !           except TELLAT, given in deg
  !
  !   THIS ROUTINE TAKES AS INPUT THE AZ AND EL OFFSET RELATIVE
  !   TO THE FIELD CENTRE, THE L.S.T., THE OBSERVATORY LATITUDE
  !   AND THE CURRENT EPOCH EQUATORIAL COORDINATES OF THE FIELD
  !   CENTRE AND RETURNS THE RA AND DEC OFFSETS RELATIVE TO THE
  !   FIELD CENTRE.
  !   ALONG , ELAT = OFFSETS RELATIVE TO FIELD CENTRE IN AZ-EL
  !   ALST = L.S.T. OF DATA POINT
  !   TELLAT = OBSERVATORY LATITUDE
  !   RADATE , DEDATE = CURRENT EPOCH RA AND DEC OF FIELD CENTRE
  !   DRA , DDEC = RA AND DEC OFFSETS RELATIVE TO FIELD CENTRE
  !
  ! Input:
  !   ALONG,ALAT : Offset to the field centre (arcsec)
  !   ALST       : Local sideral time (sec)
  !   TELLAT     : Telescope latitude (degrees)
  !   RADATE,DEDATE : RA and DEC of the day (degrees)
  ! Output:
  !   DRA,DDEC   : RA and DEC offsets relative to the field centre (degrees)
  !---------------------------------------------------------------------
  real ::     along                 !
  real ::     elat                  !
  real ::     hour                  !
  real*8 ::   tellat                !
  real ::     dedate                !
  real*8 ::   dra                   !
  real*8 ::   ddec                  !
  ! Local
  real ::     raoff,decoff
  real*8 ::   ha
  real*8 ::   deccur
  real*8 ::   dlo,dla
  real*8 ::   sinr,cosr,sine,cose,sinpa,cospa,sinlo,coslo,sinla,cosla
  real*8 ::   sindd,cosdd,cosdra,sindra
  real*8 ::   pa
  !
  real*8 ::   sindec,cosdec,sinol,cosol,obslat
  real*8 ::   pi
  parameter (pi=3.141592653589793238d0)
  !
  ! NIC code
  !      ALST1 = ALST / 240. * DEG_TO_RAD
  !      RACUR = RADATE * DEG_TO_RAD
  !      DLO = ALONG / 3600. * DEG_TO_RAD
  !      DLA = ELAT /3600. * DEG_TO_RAD
  !      HA = RACUR - ALST1               ! hour angle
  !
  ! UV_OBSERVE code
  obslat = tellat*pi/180.
  deccur = dedate
  dlo = along                  ! real to double
  dla = elat                   ! real to double
  ha = hour                    ! real to double
  !
  sindec = dsin(deccur)
  cosdec = dsqrt(1.d0 - sindec * sindec)
  sinol = dsin(tellat)
  cosol = dsqrt(1.d0 - sinol * sinol)
  !
  sinr = dsin(ha)
  cosr = dcos(ha)
  sine = sindec * sinol + cosdec * cosol * cosr
  ! E = DASIN(SINE)
  cose = dsqrt(1.d0 - sine * sine)
  sinpa = cosol * sinr / cose
  cospa = (sinol - sindec *sine) / (cosdec * cose)
  pa = datan2(sinpa,cospa)
  sinlo = dsin(dlo)
  coslo = dcos(dlo)
  sinla = dsin(dla)
  cosla = dcos(dla)
  sindd = cospa * sinla - sinpa * cosla *sinlo
  ddec = dasin(sindd)
  cosdd = dcos(ddec)
  cosdra = cosla * coslo / cosdd
  if(abs(sinpa).lt.1.d-6) then
    dra = -dlo
  else
    sindra = -(sinla - cospa * sindd) / (sinpa * cosdd)
    dra = datan2(sindra,cosdra)
  endif
  raoff = dra
  decoff = ddec
  return
end
