subroutine astro_uv(line,error)
  use gildas_def
  use image_def
  use gkernel_interfaces, no_interface=>gr4_marker
  use gkernel_types
  use gbl_message
  use ast_astro
  use ast_constant
  use atm_params
  use astro_interfaces, except_this=>astro_uv
  !---------------------------------------------------------------------
  ! @ private
  ! ASTRO Support for command
  ! UV_TRACKS Station1_ .. StationN
  !       [/FRAME Max_U] #1
  !       [/HOUR Hmin Hmax] #2
  !   [/TABLE Name] #3
  !       [/HORIZON Elv] #4
  !       [/INTEGRATION T] #5
  !       [/STATIONS ALL|list] #6
  !       [/SIZE size1 nsize1 size2 nsize2 ...] #7
  !   [/OFFSET offset] #8
  !       [/WEIGHT mode [Jy_per_K Bandwidth]] #9
  !------------------------------------------------------------------------
  ! Notes:
  ! - RL 09-nov-1998 /SIZE must be given to antenna size.
  ! - OFFSET is the position of the fixed delay line which corresponds to the
  ! the first station. It is then necessary to insure that in the following
  ! the tables X(MSTAT) reflect the order in which the stations were entered
  ! in the command line.
  !
  ! Note about XX YY ZZ TT, the positions written in the station's file:
  ! TT is (or should be) the total length (in m) from the center of
  ! the aperture to a reference plane common to all beams (preferably the
  ! entrance plane of delay lines). For XX, YY and ZZ, these are the 3
  ! components of the vector going from the earth centre to the location of
  ! the station on the surface of the earth (local equatorial coordinates),
  ! with XX along this direction, YY in the W-E direction
  ! (positive towards EAST) and ZZ in the N direction. Given local horizontal
  ! (on earth surface) coordinates x,y,z of the station,
  ! x towards Local east, y toward N and z toward Zenith,
  ! the transformation matrix is :
  !
  ! XX      / 0,-sin(lat),  cos(lat) \   x
  ! YY =    | 1,        0,         0 | * y
  ! ZZ      \ 0, cos(lat),  sin(lat) /   z
  !
  ! Where lat is the latitude of the interferometer center
  ! Note about u,v,w:
  ! the transformation from the equatorial coordinates Bx,By,Bz
  ! of a Baseline B to u,v,w is given by the matrix:
  ! u       / sin(H)       , cos(H)       ,      0 \   Bx
  ! v  =    |-sin(D)*cos(H), sin(D)*sin(H), cos(D) | * By
  ! w       \ cos(D)*cos(H),-cos(D)*sin(H), sin(D) /   Bz
  ! where H is the hour angle and D the declination of the source
  !
  ! which give ellipses of centre (0, (B/lambda)*sin(d)*cos(D)), with semi-major
  ! axis (B/lambda)*cos(d) and semi-minor axis (B/lambda)*cos(d)*sin(D)
  !
  ! Taking into account a maximum throw for delay lines may be useful for
  ! RadioInterferometers too (some may have cable length limitations) but
  ! is not desirable by default for them. However, the geometrical delay between
  ! apertures ('aerials'? 'telescopes'?) is used deep in the program. To avoid
  ! problems, I suggest to define the throw of fake 'delay lines' for radio
  ! interferometers to 2 a.u = 3.0E11 m ,with OFFSET to 1 a.u.
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Input command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='UV_TRACK'
  integer(kind=4), parameter :: mstat=100,muv=3000,mlist=20,msize=20
  integer(kind=4) :: nstat, ier, nc, ii, i1, i2
  integer(kind=4) :: istation(mstat), nlu, nn
  type(sic_listi4_t) :: list
  character(len=12) :: name, station(mstat), statn
  character(len=132) :: clu, oldlis, stalis
  real(kind=4) :: t(mstat), tt, offset
  integer(kind=4) :: flag,iequal
  real(kind=4) :: x(mstat), xx, yy, zz, sd, cd, sp, cp, h, sh, ch, y(mstat)
  real(kind=4) :: z(mstat), zch(muv), zsh(muv), hmin, hmax, array
  real(kind=4) :: uk, vk, wk, wkj, wki, horizon, uvmin,psize,throw, latitud
  real(kind=8) :: decs, az, el,avec(3), bvec(3), amat(9)
  integer(kind=4) :: i, j, k, l, ns, nh, lun, nvis
  character(len=256) :: chain
  character(len=message_length) :: mess
  character(len=132) :: fstation
  logical :: take, found(mstat), do_frame, present, table, do_size
  logical :: all, complete(mstat)
  real(kind=4) :: integ_time, frac
  real(kind=4) :: size(msize)
  integer(kind=4) :: nsize, isize(msize), iused, nused, ntake
  real(kind=4) :: asize(mstat)
  real(kind=4) :: test
  real(kind=4), parameter :: au=149597870700d0
  character(len=8) :: weight(3)
  integer(kind=4) :: wkey
  integer(kind=4), parameter :: mw=3
  real(kind=4), allocatable :: myvisi(:,:)
  integer(kind=4), parameter :: visi_size=10
  integer(kind=4) :: ivisi
  ! Saved variables
  type(gildas), save :: xtab  ! Probably needs to be SAVE'd
  integer(kind=4), save :: count=0
  logical, save :: first_call = .true.
  real(kind=4), save :: extr=300.0  ! Array size in meters
  real(kind=4) :: px !page_x from sic
  integer :: date(7)
  character(len=16) :: d_chain
  integer :: idate
  character(len=filename_length), save :: file = ' '
  ! Data
  data weight /'UNIFORM','AIRMASS','FULL'/
  !
  call sic_get_dble('DEC',decs,error)
  if (error) return
  table = sic_present(3,0)
  do_frame = sic_present(1,0)
  !
  if (first_call) then
    do_frame = .true.
    first_call = .false.
  endif
  !
  ! The logic is VERY restrictive.
  !          /TABLE Name     should only be used with /FRAME
  !          /TABLE          without /FRAME can only be used
  !                          if a previous /FRAME /TABLE Name
  !                          has been given in the session.
  ! This means it is impossible to add some UV coverage to an
  ! existing UV Table...  It should be changed at some time.
  if (table) then
    if (do_frame) then
      call sic_ch (line,3,1,chain,nc,.true.,error)
      if (error) return
      call sic_parsef(chain,file,' ','.uvt')
    elseif (sic_present(3,1)) then
      if (len_trim(file).eq.0) then
        call astro_message(seve%e,rname,'No previous Table')
        error = .true.
        return
      endif
      call astro_message(seve%w,rname,'Table name ignored, using '//file)
    endif
  endif
  !
  ! /STATIONS
  all = .false.
  if (sic_present(6,1)) then
    call sic_ke(line,6,1,stalis,nc,.true.,error)
    if (stalis.eq.'ALL') then
      all = .true.
      nstat = -1
    else
      i1 = sic_start(6,1)
      i2 = sic_end(6,sic_narg(6))
      stalis = line(i1:i2)
      call sic_parse_listi4('UV_TRACKS',stalis,list,mlist,error)
      if (error) return
      nstat = 0
      do i=1,list%nlist
        do ii=list%i1(i),list%i2(i),list%i3(i)
          if (nstat.ge.mstat) then
            call astro_message(seve%e,rname,'Too many stations, list truncated')
          else
            nstat = nstat+1
            istation(nstat) = ii
            station(nstat) = ' '
          endif
        enddo
      enddo
    endif
  else
    !
    ! Stations. Check validity of names passed as 'character variables'.
    stalis = ' '
    nc = 0
    ns = 0
    nstat = min(sic_narg(0),mstat)
    if (nstat.eq.0) then
      call astro_message(seve%e,rname,'No stations')
      error = .true.
      return
    endif
    if (nstat.eq.1) then
      call sic_ke (line,0,1,statn,l,.true.,error)
      if (statn(1:3).eq.'ALL') then
        call astro_message(seve%i,rname,'Using all stations from input file')
        all =.true.
        nstat = -1
      else
        call astro_message(seve%e,rname,'Only one station - no uv coverage')
        error = .true.
        return
      endif
    else
      do i=1, nstat
        call sic_ke (line,0,i,statn,l,.true.,error)
        if (error) return
        if(lenc(statn).gt.0)then
          ns=ns+1
          call sic_blanc(statn,l)
          station(ns)=statn(1:l)
          istation(ns) = -1
        endif
      enddo
      nstat = ns
      if (nstat.eq.0) then
        call astro_message(seve%e,rname,'No stations')
        error = .true.
        return
      endif
    endif
  endif
  !
  ! /SIZES size1 nsize1 size2 nsize2 ...
  ! Compute minimum valid UV spacing from dish sizes. For inhomogeneous arrays
  ! (i.e. for the VLT) this should be done for each baseline.
  nsize = 1
  isize(1) = mstat
  size(1) = 0.
  throw = 2.0*au               ! essentially, ignore delay (radio interferometers)
  offset= au                   ! so the dl max is +- 1 au
  ! Note that OFFSET and THROW are updated
  !
  ! Defaults for some observatories we know of. Note that there is no external
  ! definition of THROW, nor different THROWS for pairs of telescopes.
  if (obsname(1:4).eq.'BURE'.or.obsname(1:4).eq.'NOEM'.or.obsname(1:4).eq.'PDBI') then
    size(1) = 15.0
  elseif (obsname(1:4).eq.'ALMA') then
    size(1) = 12.0
  elseif (obsname(1:4).eq.'ACA ') then
    size(1) = 7.0
  elseif (obsname(1:4).eq.'VLA ') then
    size(1) = 25.0
  elseif (obsname(1:3).eq.'SMA ') then
    size(1) = 6.0
  elseif (obsname(1:4).eq.'PARA'.or.obsname(1:4).eq.'VLT ') then
    ! Assume Main UT telescopes for the time being...
    nsize = 2
    isize(1) = 4
    size(1) = 8.0
    isize(2) = 2
    size(2) = 1.5
    throw   = 127
    offset = 0.0
  elseif  (obsname(1:4).eq.'PTI ') then
    size(1) = 0.40
    throw = 76.0               ! 2 delay lines
    offset = 0.0
  elseif  (obsname(1:4).eq.'GI2T') then
    size(1) = 1.50
    throw = 6.0                ! 2 delay lines
    offset = 0.0
  elseif  (obsname(1:4).eq.'IOTA') then
    size(1) = 0.45
    throw = 3.9                ! new iota small delay ?
    offset = 0.0
  endif
  ! Here one can update the default OFFSET:
  ! option /OFFSET
  ! Load the value of the fixed delay line
  if (sic_present(8,0)) then
    call sic_r4 (line,8,1,offset,.true.,error)
    if (error) then
      call astro_message(seve%e,rname,'No valid offset given')
      return
    endif
  endif
  !
  do_size = sic_present(7,0)
  if (sic_present(7,1)) then
    iused = 0
    nsize = 0
    i = 1
    do while(nsize.lt.msize .and. i.lt.sic_narg(7))
      nsize = nsize+1
      call sic_r4(line,7,i,size(nsize),.true.,error)
      if (error) return
      i = i+1
      isize(nsize) = mstat-iused
      call sic_i4(line,7,i,isize(nsize),.false.,error)
      if (error) return
      i = i+1
      iused = iused+isize(nsize)
    enddo
  endif
  if (size(1).eq.0) then
    call astro_message(seve%w,rname,'Antenna size unknown. No shadowing '//  &
    'warnings will be given.')
  endif
  !
  ! Hour angle coverage
  horizon = 0.0
  call sic_r4  (line,4,1,horizon,.false.,error)
  if (error) return
  horizon = max(3.0,min(horizon,90.0))
  latitud = lonlat(2)
  hmin = a_lever(sngl(decs),latitud,horizon)
  if (hmin.ge.0) then
    call astro_message(seve%e,rname,'Source is not visible')
    error = .true.
    return
  endif
  hmax = -hmin
  if (sic_present(2,0)) then
    call sic_r4 (line,2,1,h,.true.,error)
    if (error) return
    if (h.lt.hmin) then
      write(mess,'(A,1PG10.3)') 'Source rises only at ',hmin
      call astro_message(seve%w,rname,mess)
      h = hmin
    endif
    hmin = h
    h = -hmin
    present = hmin.ge.0.
    call sic_r4 (line,2,2,h,present,error)
    if (error) return
    if (h.gt.hmax) then
      write(mess,'(A,1PG10.3)') 'Source sets at ',hmax
      call astro_message(seve%w,rname,mess)
      h = hmax
    endif
    hmax = h
  endif
  !
  ! Compute Hour angle range (one data point every 15mn; just OK for Bure but
  ! a shorter interval is needed for long VLA configurations or the VLT).
  !
  ! to allow any integration time
  integ_time = 15.0
  call sic_r4 (line,5,1,integ_time,.false.,error)
  if (error) return
  if (integ_time.le.0) integ_time = 15.0
  write(mess,'(A,1PG10.3,A)') 'Integration time ',integ_time,' min'
  call astro_message(seve%i,rname,mess)
  frac = integ_time/60
  inttime = integ_time*60.
  !
  nh = 0
  h = pi*hmin/12.0
  do while (h.le.pi*hmax/12.0)
    ch = cos(h)
    sh = sin(h)
    nh = nh + 1
    zch(nh) = ch
    zsh(nh) = sh
    h = h+pi*frac/12.0
  enddo
  !
  ! /WEIGHT option
  !
  wkey = 1
  if (sic_present(9,0)) then
     call sic_ke (line,9,1,chain,nc,.true.,error)
     call sic_ambigs('UV_TRACK',chain,name,wkey,weight,mw+1,error)
     if (error) return
     call astro_message(seve%i,rname,'Weighting mode is '//name)
     if (name.eq.'FULL') then
       call sic_r4 (line,9,3,bandwidth,.true.,error)
       if (error) return
       call sic_r4 (line,9,2,jy_per_k,.true.,error)
       if (error) return
       !
       ! Make sure the Frequencies are set properly by default
       if (freq.ne.freqs) then
          freqs = freq
          freqi = freq
          gim   = 0.0
       endif
     endif
  else
    bandwidth = 1.0
  endif
  !
  if (.not.sic_query_file('astro_stations','data#dir:','.dat',fstation)) then
    call astro_message(seve%f,rname,'astro_stations not found')
    error = .true.
    return
  endif
  !
  ! Open Station Main List; Get best coverage from First Line
  ier = sic_getlun (lun)
  ier = sic_open(lun,fstation,'OLD',.true.)
  if (ier.ne.0) then
    write (mess,'(a,1x,a)') 'Troubles opening station file:',fstation
    call astro_message(seve%e,rname,mess)
    goto 998
  endif
  if (obsname.eq.'BURE'.or.obsname.eq.'NOEMA'.or.obsname.eq.'SMA') then
    read (lun,*,iostat=ier) array
    if (ier.ne.0)  then
      write (mess,'(a,1x,a)') 'Troubles reading max baseline in',fstation
      call astro_message(seve%e,rname,mess)
      write (mess,'(a,1x,a)') 'Make sure this file is made for current observatory:',obsname
      call astro_message(seve%e,rname,mess)
      goto 998
    endif
  else if (obsname.eq.'ALMA') then
    !
    ! Patch for ALMA configuration files
    ! Skip first 7 lines:
    do i=1,7
      read(lun,*,iostat=ier)
      if (ier.ne.0)  then
        write (mess,'(a,1x,a)') 'Troubles reading header part of',fstation
        call astro_message(seve%e,rname,mess)
        write (mess,'(a,1x,a)') 'Make sure this file is made for current observatory:',obsname
        call astro_message(seve%e,rname,mess)
        goto 998
      endif
    enddo
    read(lun,'(a)',iostat=ier) clu
    if (ier.ne.0)  then
      write (mess,'(a,1x,a)') 'Troubles reading max baseline line in',fstation
      call astro_message(seve%e,rname,mess)
      write (mess,'(a,1x,a)') 'Make sure this file is made for current observatory:',obsname
      call astro_message(seve%e,rname,mess)
      goto 998
    endif
    iequal = index(clu,'=')
    read(clu(iequal+1:),*,iostat=ier)  array
    if (ier.ne.0)  then
      write (mess,'(a,1x,a)') 'Troubles reading max baseline in',fstation
      call astro_message(seve%e,rname,mess)
      write (mess,'(a,1x,a)') 'Make sure this file is made for current observatory:',obsname
      call astro_message(seve%e,rname,mess)
      goto 998
    endif
    array = array*1.2
  endif
  !
  ! Frame : Reset coverage and station list
  if (do_frame) then
    extr = array
    ! Optional coverage by user
    call sic_r4 (line,1,1,extr,.false.,error)
    if (error) goto 999
    if (extr.le.0) extr=array
    call gr_exec ('CLEAR DIRECTORY')
    write(chain,'(A,4(1X,1PG13.6))') 'LIMITS ',-extr,extr,-extr,extr
    call gr_exec1(chain)
    if (gr_error()) goto 999
    call gr_exec1('SET BOX 4 19 3 18')
    if (gr_error()) goto 999
    call gr_exec1('TICKS 0 0 0 0 ')
    if (error .or. freq.eq.0.0) then
      error = .false.
      freq = 0.0
      call gr_exec1('BOX')
    else
      call uvbox (extr,freq)
    endif
    count = 0
    oldlis = ' '
  else
    oldlis = stalis
  endif
  !
  ! Get and plot stations
  call sic_get_real('page_x',px,error)
  if (px.gt.21) then
     call gr_exec('SET BOX 20 30 9 19')
  else
     call gr_exec('SET BOX 3 12 18 28')
  endif
  if (gr_error()) goto 999
  write(chain,'(A,4(1X,1PG13.6))') 'LIMITS ',-array,array,-array,array
  !
  ! Patch for ALMA configuration files
  !
  if (obsname.eq.'ALMA') then
     write(chain,'(A,4(1X,1PG13.6))') 'LIMITS ',-array,array,-array-660,array-660
  else if (obsname.eq.'ACA ') then
     write(chain,'(A,4(1X,1PG13.6))') 'LIMITS ',-array-52,array-52,-array-571,array-571
  endif
  !
  call gr_exec1(chain)
  if (gr_error()) goto 999
  do i=1,mstat
    found(i) =.false.
  enddo
  sd = sin(decs)
  cd = cos(decs)
  sp = sin(pi*(lonlat(2))/180.0d0)
  cp = cos(pi*(lonlat(2))/180.0d0)
  !
  call gr_segm('ARRAY',error)
  nn = 0
  iused = 1
  nused = 0
  do while (.true.)
    read(lun,'(a)',iostat=ier) clu
    if (ier.lt.0)  exit      ! EOF
    if (ier.ne.0)  then
      call astro_message(seve%e,rname,'Troubles reading station coordinates')
      goto 998  ! Error reading line
    endif
    if (clu(1:1).eq.'!')  cycle  ! ignore comments
    nlu = lenc(clu)
    if (nlu.eq.0)  cycle     ! ignore empty lines
    !
    if (obsname.eq.'BURE'.or.obsname.eq.'NOEMA'.or.obsname.eq.'SMA') then
      ! BURE format: 4 columns
      read(clu(1:nlu),*,iostat=ier)  name,xx,yy,zz
      tt = 0.0
    else
      ! ALMA format: at least 5 columns (antenna size in column 5)
      read(clu(1:nlu),*,iostat=ier)  name,xx,yy,zz,tt
    endif
    if (ier.ne.0) then
      call astro_message(seve%w,rname,'Could not decode line: '//clu)
      cycle
    endif
    !
    take = .false.
    nn = nn+1
    if (all) then
      ntake = nn
      take = .true.
    else
      do i=1, nstat
        if (name.eq.station(i) .or. nn.eq.istation(i)) then
          ntake = i
          take = .true.
        endif
      enddo
    endif
    if (take) then
      station(ntake) = name
      x(ntake) = xx
      y(ntake) = yy
      z(ntake) = zz
      t(ntake) = tt
      found(ntake) = .true.
      if (nused.ge.isize(iused)) then
        iused = iused+1
        nused = 0
      endif
      nused = nused+1
      asize(ntake) = size(iused)
      ! Compute marker size to try represent the respective size of the dish
      ! vs the size of the array:
      call gr_set_marker (4,3,.3)
      if (do_size) then
        psize = asize(ntake)*10/(2*array)  ! box is 10 cm...
        if (psize.gt.0.1) then
          call gr_set_marker (20,3,psize)
        endif
      endif
      zz = zz*cp-xx*sp
      call gr4_marker(1,yy,zz,0.,-1.0)
    elseif (do_frame) then     !only a square to mark the position
      call gr_set_marker(4,0,.1)
      call gr4_marker(1,yy,zz*cp-xx*sp,0.,-1.0)
    endif
  enddo
  !
  close(unit=lun)
  call sic_frelun (lun)
  call gr_segm_close(error)
  !
  if (all) nstat=nn
  if (nc.eq.0) then            !means: names typed in the command line.
    k = 0
    do i=1, nstat
      if (found(i)) then
        stalis(k+1:) = station(i)//'-'
        call sic_black(stalis,k)
      else
        call astro_message(seve%f,rname,'Station not found: '//station(i))
        goto 999               ! for GTVIEW and other problems...
      endif
    enddo
    nc = k-1
    if (offset.gt.0.0.and.offset.lt.au) then
      write (stalis(nc+1:),102) offset
      call sic_noir(stalis,nc)
    endif
  endif
  if (all) stalis='ALL STATIONS'
  !
  !draw legend:  stations used, source declination and frequency
  call astro_uv_legend(rname,freq,decs,stalis,oldlis,nused, count,nc,error)
  !
  ! Plot coverage
  ! Consider setting marker size to equivalent dish size?
  ! size is a ratio
  call gr_exec('SET BOX 4 19 3 18')
  write(chain,'(A,4(1X,1PG13.6))') 'LIMITS ',-extr,extr,-extr,extr
  call gr_exec1(chain)
  if (gr_error()) goto 999
  call gr_segm('UVTRACK',error)
  !
  ! Size of Output Table. Must be computed exactly, since we
  ! do not want null entries at the end. we must take into account here
  ! rejected samples due to shadowing and/or delay line THROW.
  !
  t(1)=t(1)+offset
  nvis = 0
  if (table) then
    do k = 1,nh
      !
      ! Check for stations
      do i=1,nstat-1
        complete(i) = found(i)
        do j=i+1,nstat
          complete(j) = found(j)
        enddo
      enddo
      !
      ! Check for shadowing
      do i=1,nstat-1
        if (complete(i)) then
          do j=i+1,nstat
            if (complete(j)) then
              psize = sqrt(asize(i)*asize(j))*15/(2*extr) ! size of the symbol to plot
              uvmin = asize(i)/2.+asize(j)/2.
              xx = x(j)-x(i)
              yy = y(j)-y(i)
              zz = z(j)-z(i)
              uk = zsh(k)*xx + zch(k)*yy
              vk = sd*(-zch(k)*xx+zsh(k)*yy)+cd*zz
              if ((uk**2+vk**2).le.uvmin**2) then
                test = (xx*zch(k) - yy*zsh(k))*cd + zz*sd
                if (test.gt.0.0) then
                  complete(i) = .false.
                else
                  complete(j) = .false.
                endif
              endif
            endif
          enddo
        endif
      enddo
      !
      ! Now, Take in account max delay of Delay lines
      do i=1,nstat-1
        if (complete(i)) then
          do j=i+1,nstat
            if (complete(j)) then
              xx = x(j)-x(1)
              yy = y(j)-y(1)
              zz = z(j)-z(1)
              wkj = cd*(-zsh(k)*yy+zch(k)*xx)+sd*zz+t(1)-t(j)
              if (i.gt.1) then
                xx = x(i)-x(1)
                yy = y(i)-y(1)
                zz = z(i)-z(1)
                wki = cd*(-zsh(k)*yy+zch(k)*xx)+ sd*zz+t(1)-t(i)
              else
                wki=0
              endif
              if ((wkj.ge.0).and.(wkj.le.throw).and. (wki.ge.0).and.  &
                  (wki.le.throw))  nvis=nvis+1
            endif
          enddo
        endif
      enddo
    enddo
    if (do_frame) then
      write(mess,'(A,A,A,I0,A)')  &
        'Initialising ',trim(file),' with ',nvis,' (u,v) points'
      call astro_message(seve%i,rname,mess)
      call astro_init_table(xtab,file,nvis,decs,freq,bandwidth,obsname,error)
    else
      !
      write(mess,'(A,I0,A,A)')  &
        'Adding ',nvis,' (u,v) points to table ',trim(file)
      call astro_message(seve%i,rname,mess)
      call astro_extend_table(xtab,file,nvis,decs,freq,error)
    endif
    if (error) then
      call astro_message(seve%w,rname,'Cannot open output Table')
      call astro_close_table(xtab)
      table = .false.
      error = .false.
    else
      allocate(myvisi(visi_size,nvis),stat=ier)
      if (ier.ne.0) then
         call astro_message(seve%w,rname,'Memory allocation failure for Table')
         call astro_close_table(xtab)
         table = .false.
         error = .false.
      endif
    endif
  endif
  !
  call jjdate(jnow_utc, date)
  call ndatec(date, d_chain, error)
  call gag_fromdate(d_chain,idate,error)
  idate = idate+count
  !
  ! OK, redo for good now!
  ivisi = 0
  do k = 1,nh
    !
    ! Check for stations
    do i=1,nstat-1
      complete(i) = found(i)
      do j=i+1,nstat
        complete(j) = found(j)
      enddo
    enddo
    !
    ! Source elevation
    !
    call amset(lonlat(2),amat)
    avec(1) = zch(k)*cd
    avec(2) = zsh(k)*cd
    avec(3) = sd
    call matmul(amat,avec,bvec,1)
    call dangle(az,el,bvec)
    !
    if (wkey.eq.3) then
      call astro_setuv_weight(el)
    endif
    !
    ! Check for shadowing
    do i=1,nstat-1
      if (complete(i)) then
        do j=i+1,nstat
          if (complete(j)) then
            psize = sqrt(asize(i)*asize(j))*15/(2*extr)
            uvmin = asize(i)/2.+asize(j)/2.
            xx = x(j)-x(i)
            yy = y(j)-y(i)
            zz = z(j)-z(i)
            uk = zsh(k)*xx + zch(k)*yy
            vk = sd*(-zch(k)*xx+zsh(k)*yy)+cd*zz
            if ((uk**2+vk**2).le.uvmin**2) then
              test = (xx*zch(k) - yy*zsh(k))*cd + zz*sd ! w coordinates
              if (test.gt.0.0) then
                write(mess,'(A,I0,A,I0)') 'Antenna ',i,' is shadowed by ',j
                complete(i) = .false.
              else
                write(mess,'(A,I0,A,I0)') 'Antenna ',j,' is shadowed by ',i
                complete(j) = .false.
              endif
              call astro_message(seve%w,rname,mess)
            endif
          endif
        enddo
      endif
    enddo
    !
    ! Fill the table now and Plot, Take in account max delay of Delay lines
    do i=1,nstat-1
      if (complete(i)) then
        do j=i+1,nstat
          if (complete(j)) then
            xx = x(j)-x(1)
            yy = y(j)-y(1)
            zz = z(j)-z(1)
            wkj = cd*(-zsh(k)*yy+zch(k)*xx)+sd*zz+t(1)-t(j)
            if (i.gt.1) then
              xx = x(i)-x(1)
              yy = y(i)-y(1)
              zz = z(i)-z(1)
              wki = cd*(-zsh(k)*yy+zch(k)*xx)+sd*zz+t(1)-t(i)
            else
              wki=0
            endif
            xx = x(j)-x(i)
            yy = y(j)-y(i)
            zz = z(j)-z(i)
            uk = zsh(k)*xx + zch(k)*yy
            vk = sd*(-zch(k)*xx+zsh(k)*yy)+cd*zz
            wk = cd*(-zsh(k)*yy+zch(k)*xx)+sd*zz
            psize = sqrt(asize(i)*asize(j))*15/(2*extr)
            ! Plot 'bad' points (throw unable to follow delay) only if DO_SIZE
            if ((wkj.lt.0).or.(wkj.gt.throw).or.(wki.lt.0) .or.  &
                (wki.gt.throw)) then
              if (do_size) then
                call gr_set_marker (4,1,0.05)
                flag=0
              else
                flag=1         ! do not plot
              endif
            else
              flag=0
              if (psize.lt.0.0001 .or. .not.do_size) then
                call gr_set_marker (4,0,0.05)
              else
                call gr_set_marker (20,0,psize)
              endif
            endif
            uvmin = asize(i)/2.+asize(j)/2.
            if ((uk**2+vk**2).le.uvmin**2) then
              call astro_message(seve%d,rname,'---- Y A UN PROBLEME ----')
            else
              if (table.and.(wkj.ge.0).and.(wkj.le.throw).and.(wki.ge.0).and.  &
                  (wki.le.throw)) then
                ivisi = ivisi+1
                call fill_table (uk,vk,wk,float(idate),(integ_time*60*k),i,j,  &
                myvisi(1,ivisi),el,wkey)
              endif
              if (flag.eq.0) then
                call gr4_marker(1,uk,vk,0.0,-1.0)
                uk = -uk
                vk = -vk
                wk = -wk
                call gr4_marker(1,uk,vk,0.0,-1.0)
              endif
              flag=0
            endif
          endif
        enddo
      endif
    enddo
    !
  enddo
  call gr_segm_close(error)
  !
  if (table) then
    call gdf_write_data(xtab,myvisi,error)
    call astro_close_table (xtab)
    deallocate (myvisi, stat=ier)
  endif
  return
  !
  998   continue
  call putios('E-UV_TRACK, ',ier)
  close(unit=lun)
  call sic_frelun (lun)
  999   error = .true.
  return
  102   format (', DL set @ ',f12.5,' m')
end subroutine astro_uv
!
subroutine astro_uv_legend(rname,freq,decs,stalis,oldlis,nused, count, nc,error)
  use gbl_message
  use gkernel_interfaces
  use astro_interfaces, except_this=>astro_uv_legend
  use phys_const
  !---------------------------------------------------------------------
  ! @ private
  !
  ! draw the legend (stations used, declination, frequency)
  ! at the right place according to the plot_page orientation
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: rname   ! command name
  real(kind=8), intent(in) :: freq         ! Frequency
  real(kind=8), intent(in) :: decs         ! Declination [radian]
  character(len=*), intent(in) :: stalis   !list of used stations
  character(len=*), intent(in) :: oldlis   !previous list of used stations
  integer(kind=4), intent(in) :: nused     ! number of used stations
  integer(kind=4), intent(inout) :: count  !
  integer(kind=4), intent(in) :: nc        !
  logical, intent(inout) :: error 
  ! Local
  real(kind=4) :: px
  logical :: err
  character(len=200) :: chain,stafile
  integer(kind=4) :: nc2,ier
  !
  call sic_get_real('page_x',px,err)
  if (px.ge.30) then !landscape
     call gr_exec('SET BOX 20 30 3 9')
  else ! portrait
     call gr_exec('SET BOX 12 20 20 26')
  endif
  call gr_exec('limits 0 10 0 10')
  if (freq.gt.1e3) then
     write(chain,102) clight/freq/1d3
  else
     write(chain,100) freq
  endif
  call gr_exec('set char 0.5')
  call gr_exec1(chain)
  write(chain,101) sngl(decs*180d0/pi) !write in degrees
  call gr_exec1(chain)
  call gr_exec('set char /def')
100   format ('DRAW TEXT 1 1 "Frequency ',f5.1,' GHz" 6 /user')
102   format ('DRAW TEXT 1 1 "Wavelength ',f6.3,' microns" /user')
101   format ('DRAW TEXT 1 0 "Declination ',f5.1,' ^" 6 /user ')
  !
  ! Plot on two lines when more than 6 stations (and less than 13)
  call gr_exec('set char 0.5')
  if (oldlis.ne.stalis) then
     if (nused.gt.12.or.stalis.eq."ALL STATIONS") then !ALMA or other observatory?
        count = count+2
        chain = 'DRAW TEXT 1 1234 "'//stalis//'"   6 /user'
        write(chain(13:16),'(I4)') count
        call gr_exec1 (chain)
        count = count+1
        ier = sic_getlog('ASTRO_STATIONS',stafile)
        if (ier.ne.0) then
          call astro_message(seve%e,rname,  &
               'Failure in translation of ASTRO_STATIONS logical')
          error = .true.
          return
        endif
        chain = 'DRAW TEXT 1 1234 "'//trim(stafile)//'"   6 /user'
        write(chain(13:16),'(I4)') count
        call gr_exec1 (chain)
     else if (nused.le.6) then !PDB = 1 line
        count = count+4
        chain = 'DRAW TEXT 1 1234 "'//stalis(1:nc) //'" 6 /user'
        write(chain(13:16),'(I4)') count
        call gr_exec1 (chain)
     else if (nused.le.12) then !NOEMA = 2 lines
        nc2 = int(nused/2)*4
        count = count+2
        chain = 'DRAW TEXT 1 1234 -"'//stalis(nc2+1:nc) //'" 6 /user'
        write(chain(13:16),'(I4)') count
        call gr_exec1 (chain)
        count = count+1
        chain = 'DRAW TEXT 1 1234 "'//stalis(1:nc2) //'" 6 /user'
        write(chain(13:16),'(I4)') count
        call gr_exec1 (chain)
     endif
  endif
  call gr_exec('set char /def')
  !
end subroutine astro_uv_legend
!
subroutine uvbox(base,freq)
  !---------------------------------------------------------------------
  ! @ private
  !
  !---------------------------------------------------------------------
  real(kind=4), intent(in) :: base  ! Baseline length
  real(kind=8), intent(in) :: freq  ! Frequency
  ! Global
  logical, external :: gr_error
  ! Local
  real(kind=4) :: x
  real(kind=8), parameter :: clight=2.99792458d8   !SPEED OF LIGHT
  character(len=80) :: chain
  !
  call gr_exec1('SET BOX 4 19 3 18')
  if (gr_error()) return
  x = base*freq*1d6/clight
  write(chain,'(A,4(1X,1PG13.6))') 'LIMITS ',-x,x,-x,x
  call gr_exec1(chain)
  chain = 'DRAW TEXT 0 2.5 "U (k'//char(92)//'gl)" 5 /CHARACTER 8'
  call gr_exec1(chain)
  call gr_exec1('SET ORIENT 90.0')
  chain = 'DRAW TEXT 2.0 0 "V (k'//char(92)//'gl)" 5 /CHARACTER 6'
  call gr_exec1(chain)
  call gr_exec1('SET ORIENT 0')
  call gr_exec1('AXIS XU /LABEL P')
  call gr_exec1('AXIS YR /LABEL O')
  x = base
  write(chain,'(A,4(1X,1PG13.6))') 'LIMITS ',-x,x,-x,x
  call gr_exec1(chain)
  call gr_exec1('AXIS XL')
  call gr_exec1('AXIS YL')
  call gr_exec1('LABEL "U (meters)" /X')
  call gr_exec1('SET ORIENT 90.0')
  call gr_exec1('DRAW TEXT -2.0 0 "V (meters)" 5 /CHARACTER 4')
  call gr_exec1('SET ORIENT 0')
end subroutine uvbox
!
subroutine astro_close_table(x)
  use image_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! @ private
  ! To be re-written using
  !    gdf_write_image(header,array,error)
  ! AND may be also
  !    gdf_close_image(header,error)
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: x  !
  ! Local
  logical :: error
  !
  error = .false.
  call gdf_close_image(x,error)
end subroutine astro_close_table
!
subroutine astro_extend_table(x,name,nvis,dec,freq,error)
  use gildas_def
  use image_def
  use gkernel_interfaces
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! Re-written for new Imgage I/O interface
  !---------------------------------------------------------------------
  type(gildas),     intent(inout) :: x      ! Image structure
  character(len=*), intent(in)    :: name   ! File name
  integer(kind=4),  intent(in)    :: nvis   ! Number of visibilities to add
  real(kind=8),     intent(in)    :: dec    ! Declination
  real(kind=8),     intent(in)    :: freq   ! Frequency
  logical,          intent(out)   :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='ASTRO_UV'
  character(len=80) :: chain
  integer(kind=index_length) :: mvis
  !
  call gildas_null(x, type='UVT')
  x%file = name
  x%loca%read = .false.
  !
  call gdf_read_gildas(x,name,'.uvt',error, data=.false.)
  if (error) return
  !! call gio_lsis(error)
  !! read(5,*) i
  call gdf_close_image(x,error)
  !
  ! Couple of checks
  if (abs(x%gil%dec-dec).gt.1d-6) then
    call astro_message(seve%e,rname,'Different declinations')
    error = .true.
  endif
  if (freq.ne.0.0 .and. (abs(freq-x%gil%freq*1d-3).gt.1d-6)) then
    call astro_message(seve%e,rname,'Different frequencies')
    error = .true.
  endif
  if (error) goto 100
  !
  ! Compute new size, and remember there may be more preallocated data
  ! than used in the table to be appended
  write(chain,1001) x%gil%dim(2),nvis
1001 format('Old table size ',i8,' Adding ',i8)
  call astro_message(seve%i,rname,chain)
  !
  mvis = x%gil%dim(2)+nvis
  !
  call gdf_extend_image (x,mvis,error)
  if (error) goto 100
  !
  x%gil%nvisi = mvis  ! Update number of visibilities
  call gdf_update_header(x,error)
  !
  ! Map only new region
  x%blc(1) = 1
  x%blc(2) = x%gil%dim(2)+1-nvis
  x%trc(1) = x%gil%dim(1)
  x%trc(2) = x%gil%dim(2)
  return
  !
  100   call astro_message(seve%e,rname,'Table extension failed')
end subroutine astro_extend_table
!
subroutine astro_init_table(x,name,nvis,dec,freq,band,obs,error)
  use gildas_def
  use image_def
  use gkernel_interfaces
  use gbl_format
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gildas),     intent(inout) :: x      ! Image structure
  character(len=*), intent(in)    :: name   ! File name
  integer(kind=4),  intent(in)    :: nvis   ! Number of visibilities to write
  real(kind=8),     intent(in)    :: dec    ! Declination
  real(kind=8),     intent(in)    :: freq   ! Frequency
  real(kind=4),     intent(in)    :: band   ! Frequency resolution
  character(len=*), intent(in)    :: obs    ! Current observatory
  logical,          intent(out)   :: error  ! Logical error flag
  ! Local
  real(kind=8) :: dummy(3)
  !
  error = .false.
  !
  ! Create new file
  call gildas_null(x, type = 'UVT')
  x%file = name
  x%gil%convert(1,1) = 1.0
  x%gil%convert(3,1) = 1.0
  x%gil%blan_words = 2
  x%gil%extr_words = 0
  x%gil%bval = -1.0
  x%gil%eval = 0.
  x%gil%dim(2) = nvis
  x%gil%dim(1) = 10  ! 7 daps + (real, imag, weight)*nchannels
  !
  x%gil%ndim = 2
  x%char%unit = 'Jy'
  x%char%syst = 'EQUATORIAL'
  x%char%name = ' '
  x%gil%ra = 0.0
  x%gil%dec = dec
  x%gil%epoc = 2000.0
  x%char%line = ' '
  x%gil%fres = band
  if (freq.ne.0d0) then
    x%gil%fima = 0.0
    x%gil%freq = freq*1d3
  else
    x%gil%fima = 102d3
    x%gil%freq = 90d3
  endif
  x%gil%convert(2,1) = x%gil%freq
  x%gil%vres = -299792.458*x%gil%fres/x%gil%freq
  x%gil%voff = 0.0
  x%gil%faxi = 1
  x%loca%size = x%gil%dim(1) * x%gil%dim(2)
  x%gil%nvisi = x%gil%dim(2)
  x%gil%nchan = 1
  !
  call gdf_addteles(x,'TELE',obs,dummy,error)
  if (error)  return
  !
  call gdf_create_image(x,error)
  x%blc = 0
  x%trc = 0
end subroutine astro_init_table
!
subroutine fill_table (u,v,w,d,t,ideb,ifin,visi,el,wkey)
  use atm_params
  !---------------------------------------------------------------------
  ! @ private
  !
  !---------------------------------------------------------------------
  real(kind=4),    intent(in)  :: u         ! U coordinate
  real(kind=4),    intent(in)  :: v         ! V
  real(kind=4),    intent(in)  :: w         ! W
  real(kind=4),    intent(in)  :: d         ! Date
  real(kind=4),    intent(in)  :: t         ! Time
  integer(kind=4), intent(in)  :: ideb      ! Start Antenna
  integer(kind=4), intent(in)  :: ifin      ! End Antenna
  real(kind=4),    intent(out) :: visi(10)  ! Visibility
  real(kind=8),    intent(in)  :: el        ! Elevation
  integer(kind=4), intent(in)  :: wkey      ! Code for Weights
  !
  ! 7 parameters:
  !  U, V, W, Date, Time, Ant1, Ant2
  ! 3 values:
  !  Real, Imag, Weight
  !  1.0, 0.0, 1.0
  !
  visi(1) = u
  visi(2) = v
  visi(3) = w
  visi(4) = d
  visi(5) = t
  visi(6) = ideb
  visi(7) = ifin
  visi(8) = 1.0
  visi(9) = 0.0
  if (wkey.eq.1) then
     visi(10) = 1.0
  elseif (wkey.eq.2) then
     visi(10) = sin(el)**2
  elseif (wkey.eq.3) then
     visi(10) = uvweight
  endif
end subroutine fill_table
!
subroutine matmul(mat,a,b,n)
  !---------------------------------------------------------------------
  ! @ private
  ! 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(kind=8),    intent(in)  :: mat(3,3)  !
  real(kind=8),    intent(in)  :: a(3)      !
  real(kind=8),    intent(out) :: b(3)      !
  integer(kind=4), intent(in)  :: n         !
  ! Local
  integer(kind=4) :: 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 subroutine matmul
!
subroutine amset(obslat,amat)
  use ast_constant
  !---------------------------------------------------------------------
  ! @ private
  !   subroutine to provide transformation matrix from hour angle - dec
  !       into azimuth - elevation.
  !---------------------------------------------------------------------
  real(kind=8), intent(in)  :: obslat   ! in degrees
  real(kind=8), intent(out) :: amat(9)  !
  ! Local
  real(kind=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 subroutine amset
!
subroutine dangle(along,alat,a)
  use ast_constant
  !---------------------------------------------------------------------
  ! @ private
  ! 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(kind=8), intent(out) :: along  !
  real(kind=8), intent(out) :: alat   !
  real(kind=8), intent(in)  :: a(3)   !
  ! Local
  real(kind=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 subroutine dangle
!
subroutine astro_setuv_weight(el)
  use gildas_def
  use gkernel_interfaces
  use atm_params
  use atm_interfaces_public
  use ast_astro
  !---------------------------------------------------------------------
  ! @ private
  ! ATM
  !---------------------------------------------------------------------
  real(kind=8), intent(in) :: el
  !
  real(4) :: w
  real(4) :: frequ
  integer :: ier
  !
  airmass = 1./sin(el)
  h0 = altitude
  !
  p1 = p0*2.0**(-h0/5.5)     ! Pressure at altitude H0
  call atm_atmosp(t0,p1,h0)
  !
  if (gim.ne.0) then
    frequ = freqi
    call atm_transm(water,airmass,frequ,temii,tatmi,tauox,tauw,taut,ier)
    frequ = freqs
    call atm_transm(water,airmass,frequ,temis,tatms,tauox,tauw,taut,ier)
    !
    tant = (gim * (feff*temii+(1.0-feff)*t0 + trec) +  &
           (feff*temis+(1.0-feff)*t0 + trec) ) / (1.0+gim)
    tsys = exp(taut*airmass) * (gim * (feff*temii+(1.0-feff)*t0 + trec) +  &
           (feff*temis+(1.0-feff)*t0 + trec) ) / feff
  else
    frequ = freqs
    call atm_transm(water,airmass,frequ,temis,tatms,tauox,tauw,taut,ier)
    !
    tant = feff*temis+(1.0-feff)*t0 + trec
    tsys = exp(taut*airmass) * (feff*temis+(1.0-feff)*t0 + trec) / feff
  endif
  !
  ! Need  Integration time
  ! Need  Bandwidth
  ! Need  Antenna Jy/K conversion factor
  w = jy_per_k*tsys/sqrt(bandwidth * inttime)
  uvweight = 1./w**2
end subroutine astro_setuv_weight
!
