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 :: iopt_frame=1
  integer(kind=4), parameter :: iopt_hour=2
  integer(kind=4), parameter :: iopt_table=3
  integer(kind=4), parameter :: iopt_ho=4
  integer(kind=4), parameter :: iopt_int=5
  integer(kind=4), parameter :: iopt_stations=6
  integer(kind=4), parameter :: iopt_size=7
  integer(kind=4), parameter :: iopt_offset=8
  integer(kind=4), parameter :: iopt_weight=9
  !
  integer(kind=4), parameter :: mstat=100,muv=3000,mlist=20
  integer(kind=4), parameter :: visi_size=10 ! number of column of output table
  integer(kind=4), parameter :: hori_min=3 ! minimum elevation in degrees
  real(kind=4), parameter :: def_integ_time=15 ! default integration time
  !
  !
  type(uv_track_t) :: uvt
  !
  integer(kind=4) :: nstat_in, ier, nc, ii, i1, i2,iline
  integer(kind=4) :: istation(mstat), nlu, nn,nskip,nces,nsize,nfilled
  type(sic_listi4_t) :: list
  character(len=12) :: name, statn,stations_in(mstat)
  character(len=132) :: clu, oldlis, stalis, delay_mess
  real(kind=4) ::  tt
  integer(kind=4) :: flag
  real(kind=4) ::  xx, yy, zz,  h, sh, ch
  real(kind=4) :: zch(muv), zsh(muv), hmin, hmax, array,hh1,hh2,poff(4)
  real(kind=4) :: uk, vk, wk,  hori, 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), table_ok,delay_ok
  logical :: complete(mstat)
  real(kind=4) ::  frac
  integer(kind=4) ::  iused, nused, ntake,check_nsize
  real(kind=4) :: asize(mstat)
  integer(kind=4), parameter :: mw=3
  character(len=8) :: weight(mw)
  real(kind=4), allocatable :: myvisi(:,:)
  integer(kind=4) :: ivisi
  integer :: date(7)
  character(len=16) :: d_chain
  integer :: idate
  ! Saved variables
  type(gildas), save :: xtab  ! Probably needs to be SAVE'd
  integer(kind=4), save :: count=0 ! when several succesive calls
  logical, save :: first_call = .true.
  real(kind=4), save :: extr=300.0  ! Array size in meters
  real(kind=4) :: px !page_x from sic
  character(len=filename_length), save :: file = ' ' ! output table name 
  ! Data
  data weight /'UNIFORM','AIRMASS','FULL'/
  !
  ! Check that station files is found
  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
  !
  ! backward compatibility to understand 3digit station names (E68 instead o E068)
  uvt%in%three_digit_name_compatible = .true.   
  !
  uvt%in%do_frame = sic_present(iopt_frame,0)
  uvt%in%do_hour=sic_present(iopt_hour,0)
  uvt%in%do_table=sic_present(iopt_table,0)
  uvt%in%do_ho=sic_present(iopt_ho,0)
  uvt%in%do_int=sic_present(iopt_int,0)
  uvt%in%do_stations=sic_present(iopt_stations,0)
  uvt%in%do_size=sic_present(iopt_size,0)
  uvt%in%do_offset=sic_present(iopt_offset,0)
  uvt%in%do_weight=sic_present(iopt_weight,0)
  !
  ! Option /FRAME
  uvt%in%user_array=0.
  if (uvt%in%do_frame) then
    call sic_r4 (line,iopt_frame,1,uvt%in%user_array,.false.,error)
    if (error) return
  endif
  !
  if (first_call) then
    ! do the frame whatever the option upon fist call
    uvt%in%do_frame = .true.
    first_call = .false.
  endif
  !
  ! The logic of /TABLE 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 (uvt%in%do_table) then
    if (uvt%in%do_frame) then
      ! 1st plot with /FRAME
      call sic_ch (line,iopt_table,1,chain,nc,.true.,error)
      if (error) return
      call sic_parsef(chain,file,' ','.uvt')
    elseif (sic_present(iopt_table,1)) then
      ! later call to inand
      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
  !
  uvt%in%do_all=.false.
  
  ! /STATIONS
  if (uvt%in%do_stations) then
    ! stations given through option /STATION
    if (sic_present(0,1)) then
      call astro_message(seve%e,rname,'With option /STATIONS UV_TRACKS should not have any argument ')
      error=.true.
      return
    endif
    call sic_ke(line,iopt_stations,1,stalis,nc,.true.,error)
    if (error) return
    if (stalis.eq.'ALL') then
      uvt%in%do_all = .true.
      nstat_in = -1
      if (sic_present(iopt_stations,2)) then
        call astro_message(seve%e,rname,'Argument ALL should be alone')
        error=.true.
        return
      endif
    else
      i1 = sic_start(iopt_stations,1)
      i2 = sic_end(iopt_stations,sic_narg(iopt_stations))
      stalis = line(i1:i2)
      call sic_parse_listi4('UV_TRACKS',stalis,list,mlist,error)
      if (error) return
      nstat_in = 0
      do i=1,list%nlist
        do ii=list%i1(i),list%i2(i),list%i3(i)
          if (nstat_in.ge.mstat) then
            call astro_message(seve%e,rname,'Too many stations')
            error=.true.
            return
          else
            nstat_in = nstat_in+1
            istation(nstat_in) = ii
            stations_in(nstat_in) = ''
          endif
        enddo
      enddo
    endif
  else
    ! Stations given through command arguments
    ! Stations. Check validity of names passed as 'character variables'.
    stalis = ' '
    nc = 0
    ns = 0
    if (sic_narg(0).gt.mstat) then
      call astro_message(seve%e,rname,'Too many stations entered')
      error=.true.
      return
    endif
    if (sic_narg(0).eq.0) then
      call astro_message(seve%e,rname,'No stations')
      error = .true.
      return
    endif
    if (sic_narg(0).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')
        uvt%in%do_all =.true.
        nstat_in = -1
      else
        call astro_message(seve%e,rname,'Only one station - no uv coverage')
        error = .true.
        return
      endif
    else
      do i=1, sic_narg(0)
        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)
          stations_in(ns)=statn(1:l)
          istation(ns) = -1
        endif
      enddo
      nstat_in = ns
      if (nstat_in.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.
  uvt%in%nsize=1
  uvt%in%nant_size(1) = mstat
  uvt%in%sizes(1) = 0.   ! default set to no size
  ! Part related to limit in delay line
  throw = 2.0*au_m               ! essentially, ignore delay (radio interferometers)
  uvt%in%offset= au_m                   ! 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
    uvt%in%sizes(1) = 15.0
  elseif (obsname(1:4).eq.'ALMA') then
    uvt%in%sizes(1) = 12.0
  elseif (obsname(1:4).eq.'ACA ') then
    uvt%in%sizes(1) = 7.0
  elseif (obsname(1:4).eq.'VLA ') then
    uvt%in%sizes(1) = 25.0
  elseif (obsname(1:3).eq.'SMA ') then
    uvt%in%sizes(1) = 6.0
  elseif (obsname(1:4).eq.'PARA'.or.obsname(1:4).eq.'VLT ') then
    ! Assume Main UT telescopes for the time being...
    uvt%in%nsize = 2
    uvt%in%nant_size(1) = 4
    uvt%in%sizes(1) = 8.0
    uvt%in%nant_size(2) = 2
    uvt%in%sizes(2) = 1.5
    throw   = 127
    uvt%in%offset = 0.0
  elseif  (obsname(1:4).eq.'PTI ') then
    uvt%in%sizes(1) = 0.40
    throw = 76.0               ! 2 delay lines
    uvt%in%offset = 0.0
  elseif  (obsname(1:4).eq.'GI2T') then
    uvt%in%sizes(1) = 1.50
    throw = 6.0                ! 2 delay lines
    uvt%in%offset = 0.0
  elseif  (obsname(1:4).eq.'IOTA') then
    uvt%in%sizes(1) = 0.45
    throw = 3.9                ! new iota small delay ?
    uvt%in%offset = 0.0
  endif
  ! Here one can update the default OFFSET:
  ! option /OFFSET
  ! Load the value of the fixed delay line
  if (uvt%in%do_offset) then
    call sic_r4 (line,iopt_offset,1,uvt%in%offset,.true.,error)
    if (error) then
      call astro_message(seve%e,rname,'No valid offset given')
      return
    endif
  endif
  !
  ! Size of the antennas (mostly for shadowing)
  if (uvt%in%do_size) then
    if (sic_narg(iopt_size).eq.1) then
      ! 1 size for all the antennas
      call sic_r4(line,iopt_size,1,uvt%in%sizes(1),.true.,error)
      if (error) return
      uvt%in%nant_size(1) = mstat
      nsize = 1
    else if (floor(sic_narg(iopt_size)/2.).ne.sic_narg(iopt_size)/2.) then
      call astro_message(seve%e,rname,'Option /SIZE requires an even number arguments')
      call astro_message(seve%e,rname,'/SIZE size1 number1 [size2 number2 ...]')
      error=.true.
      return
    else
      nsize = 0
      i = 1
      do while(uvt%in%nsize.lt.msize .and. i.lt.sic_narg(iopt_size))
        ! /SIZE argument SIZE and number of antennas of this size
        nsize = nsize+1
        ! Read first argument of pair: size
        call sic_r4(line,iopt_size,i,uvt%in%sizes(nsize),.true.,error)
        if (error) return
        i = i+1
        ! Read 2nd argument of pair: number of antennas with this part
        call sic_i4(line,iopt_size,i,uvt%in%nant_size(nsize),.true.,error)
        if (error) return
        i = i+1
      enddo
    endif
    check_nsize=0
    do i=1,nsize
      check_nsize=check_nsize+uvt%in%nant_size(i)
    enddo
    if (check_nsize.lt.nstat_in) then
      call astro_message(seve%e,rname,'The number of defineds sizes does not match the number of used antennas')
      return
    endif
    uvt%in%nsize=nsize
  endif
  if (uvt%in%sizes(1).eq.0) then
    call astro_message(seve%w,rname,'Antenna size unknown. No shadowing '//  &
    'warnings will be given.')
  endif
  !
  ! HORIZON option input  
  uvt%in%horizon = hori_min
  if (uvt%in%do_ho) then
    call sic_r4  (line,iopt_ho,1,hori,.true.,error)
    if (error) return
    if (hori.gt.90) then
      call astro_message(seve%e,rname,'Sourve elevation cannot be higher than 90 degrees')
      error=.true.
      return
    endif
    if (hori.lt.hori_min) then
      uvt%in%horizon=hori_min 
      write (mess,'(a,1x,i2.0,1x,a)') 'Minimum elevation set to',hori_min,'degrees'
      call astro_message(seve%w,rname,mess)
    else
      uvt%in%horizon=hori
    endif
  endif
  !
  ! option /HOUR_ANGLE
  if (uvt%in%do_hour) then
    call sic_r4 (line,iopt_hour,1,hh1,.true.,error)
    if (error) return
    hh2=-hh1
    ! default is symetric wrt transit
    call sic_r4 (line,iopt_hour,2,hh2,.false.,error)
    if (error) return
    uvt%in%in_h1=min(hh1,hh2)
    uvt%in%in_h2=max(hh1,hh2)    
  endif
  !
  ! /INTEGRATION Option
  uvt%in%integ_time = def_integ_time
  if (uvt%in%do_int) then
    call sic_r4 (line,iopt_int,1,uvt%in%integ_time,.true.,error)
    if (error) return
    if (uvt%in%integ_time.le.0) then
      call astro_message(seve%e,rname,'integration time should be longer than 0')
      error=.true.
      return
    endif
  endif
  write(mess,'(A,1PG10.3,A)') 'Integration time ',uvt%in%integ_time,' min'
  call astro_message(seve%i,rname,mess)
  !
  ! /WEIGHT option
  uvt%in%wkey = 1
  if (uvt%in%do_weight) then
    call sic_ke (line,iopt_weight,1,chain,nc,.true.,error)
    if (error) return
    call sic_ambigs(rname,chain,name,uvt%in%wkey,weight,mw,error)
    if (error) return
    call astro_message(seve%i,rname,'Weighting mode is '//name)
    if (name.eq.'FULL') then
      call sic_r4 (line,iopt_weight,3,bandwidth,.true.,error)
      if (error) return
      call sic_r4 (line,iopt_weight,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
    else
      if (sic_present(iopt_weight,2)) then
        call astro_message(seve%e,rname,'Too many arguments for option /WEIGHT')
        error=.true.
        return
      endif
    endif
  else
    bandwidth = 1.0
  endif
  !
  ! END OF COMMAND PARSING
  !
  ! START OF WORK
  !
  ! 1. Check that source goes above the elevation limit and that there is no problem with hour angle limits
  ! Need current source today Declination
  call sic_get_dble('DEC',decs,error)
  if (error) return
  latitud = lonlat(2)
  hmin = a_lever(sngl(decs),latitud,uvt%in%horizon)
  if (hmin.ge.0) then
    call astro_message(seve%e,rname,'Source is not visible')
    error = .true.
    return
  endif
  hmax = -hmin
  ! Default range is rise to set
  uvt%in%h1=hmin
  uvt%in%h2=hmax
  ! Limit the range if requested
  if (uvt%in%do_hour) then
    if (uvt%in%in_h1.lt.hmin) then
      write(mess,'(A,1PG10.3)') 'Source rises only at ',hmin
      call astro_message(seve%w,rname,mess)      
    endif
    uvt%in%h1=max(uvt%in%in_h1,hmin)
    if (uvt%in%in_h2.gt.hmax) then
      write(mess,'(A,1PG10.3)') 'Source sets at ',hmax
      call astro_message(seve%w,rname,mess)
    endif
    uvt%in%h2=min(uvt%in%in_h2,hmax)
  endif
  !
  !2. 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
  frac = uvt%in%integ_time/60
  inttime = uvt%in%integ_time*60. ! needed for atm computation in /weight, full mode
  !
  nh = 0
  h = pi*uvt%in%h1/12.0
  do while (h.le.pi*uvt%in%h2/12.0)
    ch = cos(h)
    sh = sin(h)
    nh = nh + 1
    zch(nh) = ch
    zsh(nh) = sh
    h = h+pi*frac/12.0
  enddo
  !
  !Get best coverage from header Line of station file
  call uv_get_arraysize(rname,fstation,array,nskip,poff,error)
  if (error) return
  !
  if (uvt%in%do_frame) then
  ! Frame : Reset coverage and station list
    call uv_reset_plot(rname,uvt%in,array,extr,freq,error)
    if (error) return
    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()) then
    error=.true.
    return
  endif
  !
  write(chain,'(A,4(1X,1PG13.6))') 'LIMITS ',-array+poff(1),array+poff(2),-array+poff(3),array+poff(4)
  ! poff depends on observatory station file format
  !
  call gr_exec1(chain)
  if (gr_error()) then
    error=.true.
    return
  endif
  ! Init found variable
  do i=1,mstat
    found(i) =.false.
  enddo
  ! Useful values for conversion/plots
  uvt%ang%sd = sin(decs)
  uvt%ang%cd = cos(decs)
  uvt%ang%sp = sin(pi*(lonlat(2))/180.0d0)
  uvt%ang%cp = cos(pi*(lonlat(2))/180.0d0)
  !
  call gr_segm('ARRAY',error)
  !
  ! Init the reading of the station file
  iline= 0
  nn = 0
  iused = 1
  nused = 0
  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,trim(mess))
    goto 998
  endif
  nfilled=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
    iline = iline+1
    if (iline.le.nskip) cycle ! ignore first line - number depends on file format
    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 (uvt%in%do_all) then
      ntake = nn
      take = .true.
    else
      do i=1, nstat_in
        if (uvt%in%do_stations.and.nn.eq.istation(i)) then
          ! station entered by index and option station
          take=.true.
          ntake=i
          exit
        endif
        if (.not.uvt%in%do_stations) then
          ! station entered by name as command argument
          call uv_match_station(rname,uvt%in,name,stations_in(i),take,error)
          if (error) return
          if (take) then
            ntake=i
            exit
          endif
        endif
      enddo
    endif
    if (take) then
      ! Get the station coordinates
      nfilled=nfilled+1
      uvt%stations(ntake)%name = name
      uvt%stations(ntake)%x = xx
      uvt%stations(ntake)%y = yy
      uvt%stations(ntake)%z = zz
      uvt%stations(ntake)%t = tt
      uvt%stations(ntake)%found = .true.
      ! 
      ! Check size of the current antenna
      if (nused.ge.uvt%in%nant_size(iused)) then
        iused = iused+1
        nused = 0
      endif
      nused = nused+1
      uvt%stations(ntake)%asize = uvt%in%sizes(iused)
      ! Plot the station position
      call gr_set_marker (4,3,.3)
      if (uvt%in%do_size) then
        ! Compute marker size to try represent the respective size of the dish
        ! vs the size of the array:
        psize = uvt%stations(ntake)%asize*10/(2*array)  ! box is 10 cm...
        if (psize.gt.0.1) then
          call gr_set_marker (20,3,psize)
        endif
      endif
      ! Draw the marker
      call gr4_marker(1,yy,zz*uvt%ang%cp-xx*uvt%ang%sp,0.,-1.0)
    elseif (uvt%in%do_frame) then     
      ! station not selected : only a square to mark the position
      call gr_set_marker(4,0,.1)
      call gr4_marker(1,yy,zz*uvt%ang%cp-xx*uvt%ang%sp,0.,-1.0)
    endif
  enddo  ! end of loop on station file lines
  !
  close(unit=lun)
  call sic_frelun (lun)
  call gr_segm_close(error)
  !
  if (uvt%in%do_all) then
    stalis='ALL STATIONS'
    uvt%n_stations=nfilled
  else
    if (nstat_in.eq.nfilled) then
      uvt%n_stations=nstat_in
    else
      write (mess,'(a)') 'Problems with input station list'
      do i=1,nstat_in-1
        do j=i+1,nstat_in
          if (stations_in(i).eq.stations_in(j)) then
            write (mess,'(a,a,a)') 'Station ',trim(stations_in(i)),' requested several times'   
          endif
        enddo
      enddo
      call astro_message(seve%e,rname,mess)
      error=.true.
      return
    endif
  ! Build the line with all stations that were entered AND which are found in station file
    k = 0
    do i=1, uvt%n_stations
      if (uvt%stations(i)%found) then
        stalis(k+1:) = uvt%stations(i)%name//'-'
        call sic_black(stalis,k)
        if (i.eq.floor(uvt%n_stations/2.)) then
          ! get index of half antenna list place
          nces=k
        endif
      else
        call astro_message(seve%f,rname,'Station not found: '//uvt%stations(i)%name)
        error=.true.   ! for GTVIEW and other problems...
        return 
      endif
    enddo
    nc = k-1
  endif
!   endif
  !
  if (uvt%in%do_offset.and.uvt%in%offset.gt.0.0.and.uvt%in%offset.lt.au_m) then
    write (delay_mess,102) uvt%in%offset
    call sic_noir(delay_mess,nc)
  else
    delay_mess=''
  endif
  !
  !draw legend:  stations used, source declination and frequency
  call astro_uv_legend(rname,freq,decs,stalis,oldlis,delay_mess,uvt%n_stations, count,nc,nces,error)
  if (error) return
  !
  ! 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()) then
    error=.true.
    return
  endif
  call gr_segm('UVTRACK',error)
  !
  !
  uvt%stations(1)%t=uvt%stations(1)%t+uvt%in%offset
  nvis = 0
  table_ok=uvt%in%do_table
  if (uvt%in%do_table) then
    ! 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.
    ! First loops just to get the number of visilities
    do k = 1,nh
      ! need update for each h
      uvt%ang%zsh=zsh(k)
      uvt%ang%zch=zch(k)
      !
      ! Reset complete variable at each h
      do i=1,uvt%n_stations-1
        complete(i) = uvt%stations(i)%found
        do j=i+1,uvt%n_stations
          complete(j) = uvt%stations(j)%found
        enddo
      enddo
      !
      ! Check for shadowing
      do i=1,uvt%n_stations-1
        if (complete(i)) then
          do j=i+1,uvt%n_stations
            if (complete(j)) then
              call uv_check_shadow(rname,uvt%ang,uvt%stations(i),uvt%stations(j),complete(i),complete(j),error)
              ! complete = false means that antenna is shadowed at the present h
              if (error) return
            endif
          enddo
        endif
      enddo
      !
      ! Now, Take in account max delay of Delay lines
      do i=1,uvt%n_stations-1
        if (complete(i)) then
          do j=i+1,uvt%n_stations
            if (complete(j)) then
              delay_ok=.false.
              call uv_check_delay(rname,uvt%ang,uvt%stations(i),uvt%stations(j),uvt%stations(1),throw,delay_ok,error)
              if (error) return
              if (delay_ok) then
                nvis=nvis+1
              endif
            endif
          enddo
        endif
      enddo
    enddo
    !
    if (uvt%in%do_frame) then
      ! /FRAME means we restart from scratch the visibility table
      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
      ! No /FRAME, add visi to existig file
      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_ok = .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_ok = .false.
         error = .false.
      else
        table_ok=.true.
      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
    uvt%ang%zsh=zsh(k)
    uvt%ang%zch=zch(k)
    !
    ! Check for stations
    do i=1,uvt%n_stations-1
      complete(i) = uvt%stations(i)%found
      do j=i+1,uvt%n_stations
        complete(j) = uvt%stations(j)%found
      enddo
    enddo
    !
    ! Source elevation
    !
    call amset(lonlat(2),amat)
    avec(1) = zch(k)*uvt%ang%cd
    avec(2) = zsh(k)*uvt%ang%cd
    avec(3) = uvt%ang%sd
    call matmul(amat,avec,bvec,1)
    call dangle(az,el,bvec)
    !
    if (uvt%in%wkey.eq.3) then
      ! Full mode for wight: atm computation
      call astro_setuv_weight(el)
    endif
    !
    ! Check for shadowing
    do i=1,uvt%n_stations-1
      if (complete(i)) then
        do j=i+1,uvt%n_stations
          if (complete(j)) then
            psize = sqrt(asize(i)*asize(j))*15/(2*extr)
            call uv_check_shadow(rname,uvt%ang,uvt%stations(i),uvt%stations(j),complete(i),complete(j),error)
            ! complete = false means that antenna is shadowed at the present h
            if (error) return
            if (.not.(complete(i))) then
              write(mess,'(A,I0,A,I0)') 'Antenna ',i,' is shadowed by ',j
              call astro_message(seve%i,rname,mess)
            else if  (.not.(complete(j))) then
              write(mess,'(A,I0,A,I0)') 'Antenna ',j,' is shadowed by ',i
              call astro_message(seve%i,rname,mess)
            endif
          endif
        enddo
      endif
    enddo
    !
    ! Fill the table now and Plot, Take in account max delay of Delay lines
    do i=1,uvt%n_stations-1
      if (complete(i)) then
        do j=i+1,uvt%n_stations
          if (complete(j)) then
            delay_ok=.false.
            call uv_check_delay(rname,uvt%ang,uvt%stations(i),uvt%stations(j),uvt%stations(1),throw,delay_ok,error)
            if (error) return
            psize = sqrt(asize(i)*asize(j))*15/(2*extr)
            ! Plot 'bad' points (throw unable to follow delay) only if DO_SIZE
            call uv_do_baseline(rname,uvt%ang,uvt%stations(i),uvt%stations(j),uk,vk,wk,error)
            if (error) return
            ! Plot Considerations
            if (.not.delay_ok) then
              if (uvt%in%do_size) then
                ! Plot the excluded points in case of do_size
                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.uvt%in%do_size) then
                call gr_set_marker (4,0,0.05)
              else
                call gr_set_marker (20,0,psize)
              endif
            endif
            !            
            uvmin = uvt%stations(i)%asize/2.+uvt%stations(j)%asize/2.
            if ((uk**2+vk**2).le.uvmin**2) then
              call astro_message(seve%d,rname,'---- Y A UN PROBLEME ----')
            else
              if (table_ok.and.delay_ok) then
                ivisi = ivisi+1
                call fill_table (uk,vk,wk,float(idate),(uvt%in%integ_time*60*k),i,j,  &
                myvisi(1,ivisi),el,uvt%in%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_ok) 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)
  return
  102   format (', DL set @ ',f12.5,' m')
end subroutine astro_uv
!
subroutine uv_do_baseline(rname,uvang,uvsta_i,uvsta_j,uk,vk,wk,error)
  use gbl_message
  use gkernel_interfaces
  use ast_astro
  use astro_interfaces, except_this=>uv_do_baseline
  !---------------------------------------------------------------------
  ! @ private
  !
  ! compute baseline coordinates
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: rname   ! command name
  type(uv_track_angles_t), intent(in) :: uvang ! current angle to compute distance
  type(uv_track_station_t), intent(in) :: uvsta_i,uvsta_j ! current stations
  real(kind=4), intent(inout) :: uk,vk,wk
  logical, intent(inout) :: error 
  ! Local
  real(kind=4) :: xx,yy,zz
  !
  xx = uvsta_j%x-uvsta_i%x
  yy = uvsta_j%y-uvsta_i%y
  zz = uvsta_j%z-uvsta_i%z
  uk = uvang%zsh*xx + uvang%zch*yy
  vk = uvang%sd*(-uvang%zch*xx+uvang%zsh*yy)+uvang%cd*zz
  wk = uvang%cd*(-uvang%zch*yy+xx*uvang%zch)+zz*uvang%sd
  !
end subroutine uv_do_baseline
!
subroutine uv_check_shadow(rname,uvang,uvsta_i,uvsta_j,ok_i,ok_j,error)
  use gbl_message
  use gkernel_interfaces
  use ast_astro
  use astro_interfaces, except_this=>uv_check_shadow
  !---------------------------------------------------------------------
  ! @ private
  !
  ! check whether the 2 antennas on stations i,j have shadowing
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: rname   ! command name
  type(uv_track_angles_t), intent(in) :: uvang ! current angle to compute distance
  type(uv_track_station_t), intent(in) :: uvsta_i,uvsta_j ! current stations
  logical, intent(inout) :: ok_i,ok_j
  logical, intent(inout) :: error 
  ! Local
  real(kind=4) :: xx,yy,zz,uk,vk,uvmin,test
  !
  uvmin = uvsta_i%asize/2.+uvsta_j%asize/2.
  xx = uvsta_j%x-uvsta_i%x
  yy = uvsta_j%y-uvsta_i%y
  zz = uvsta_j%z-uvsta_i%z
  uk = uvang%zsh*xx + uvang%zch*yy
  vk = uvang%sd*(-uvang%zch*xx+uvang%zsh*yy)+uvang%cd*zz
  if ((uk**2+vk**2).le.uvmin**2) then
    ! shadowing happends, check who shadows who
    test = (xx*uvang%zch - yy*uvang%zsh)*uvang%cd + zz*uvang%sd
    if (test.gt.0.0) then
      ok_i = .false. 
    else
      ok_j = .false.
    endif
  endif
end subroutine uv_check_shadow
!
subroutine uv_check_delay(rname,uvang,uvsta_i,uvsta_j,uvsta_ref,throw,delay_ok,error)
  use gbl_message
  use gkernel_interfaces
  use ast_astro
  use astro_interfaces, except_this=>uv_check_delay
  !---------------------------------------------------------------------
  ! @ private
  !
  ! check whether the delay is not bigger than the limit (for observatories using fixed delay lines)
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: rname   ! command name
  type(uv_track_angles_t), intent(in) :: uvang ! current angle to compute distance
  type(uv_track_station_t), intent(in) :: uvsta_i,uvsta_j,uvsta_ref ! current stations
  real(kind=4), intent(in) :: throw
  logical, intent(inout) :: delay_ok
  logical, intent(inout) :: error 
  ! Local
  real(kind=4) :: xx,yy,zz,wkj,wki
  !
  xx = uvsta_j%x-uvsta_ref%x
  yy = uvsta_j%y-uvsta_ref%y
  zz = uvsta_j%z-uvsta_ref%z
  wkj = uvang%cd*(-uvang%zsh*yy+uvang%zch*xx)+uvang%sd*zz+uvsta_ref%t-uvsta_j%t
  !
  xx = uvsta_i%x-uvsta_ref%x
  yy = uvsta_i%y-uvsta_ref%y
  zz = uvsta_i%z-uvsta_ref%z
  wki = uvang%cd*(-uvang%zsh*yy+uvang%zch*xx)+uvang%sd*zz+uvsta_ref%t-uvsta_i%t
  !
  ! Count only visibility doable wrt delay lines
  if ((wkj.ge.0).and.(wkj.le.throw).and. (wki.ge.0).and.(wki.le.throw))  delay_ok=.true.
  ! 
end subroutine uv_check_delay
!
subroutine uv_match_station(rname,uvin,fname,istation,match,error)
  use gbl_message
  use gkernel_interfaces
  use ast_astro
  use astro_interfaces, except_this=>uv_match_station
  !---------------------------------------------------------------------
  ! @ private
  !
  ! check if station of the current line in the file matches the requested station
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: rname   ! command name
  type(uv_track_in_t), intent(in) :: uvin
  character(len=*) :: fname ! station name as in station file
  character(len=*) :: istation ! station name as user input
  logical, intent(inout) :: match 
  logical, intent(inout) :: error 
  ! Local
  character(len=256) :: chain
  character(len=3) :: sname
  !
  if (fname.eq.istation) then
    match=.true.
  else if ((obsname.eq.'BURE'.or.obsname.eq.'NOEMA').and.uvin%three_digit_name_compatible) then
    ! 01-jul-2022. Mnemonic station names changed from [E,W,N]+2 digits to [E,W,N]+3 digits in station files
    ! The following trick has been written to ensure backward compatibility reasons
    ! Will be removed after a period of ~ 1--2 yr
    if (len_trim(fname).eq.4.and.len_trim(istation).eq.3.and.fname(2:2).eq.'0') then
      sname(1:1)=fname(1:1)
      sname(2:3)=fname(3:4)
      if (sname.eq.istation) then
        call astro_message(seve%w,rname,'The 3 characters format for NOEMA stations is obsolescent')
        write (chain,'(a,1x,a,1x,a,1x,a)') 'Station',trim(istation),'is now called',trim(fname)
        call astro_message(seve%w,rname,chain)
        match=.true.
      endif
    endif
  endif
  !
end subroutine uv_match_station
!
subroutine uv_reset_plot(rname,uvin,arr,lextr,ff,error)
  use gbl_message
  use gkernel_interfaces
  use ast_astro
  use astro_interfaces, except_this=>uv_reset_plot
  !---------------------------------------------------------------------
  ! @ private
  !
  ! reset the plot upon /frame option
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: rname   ! command name
  type(uv_track_in_t), intent(in) :: uvin
  real(kind=4), intent(in) :: arr
  real(kind=4), intent(inout) :: lextr
  real(kind=8), intent(inout) :: ff        !
  logical, intent(inout) :: error 
  ! Local
  character(len=256) :: chain
  !
  lextr = arr
  if (uvin%user_array.gt.0) then
    ! use user value
    lextr=uvin%user_array
  endif  
  call gr_exec ('CLEAR DIRECTORY')
  write(chain,'(A,4(1X,1PG13.6))') 'LIMITS ',-lextr,lextr,-lextr,lextr
  call gr_exec1(chain)
  if (gr_error()) then
    error=.true.
    return
  endif
  call gr_exec1('SET BOX 4 19 3 18')
  if (gr_error()) then
    error=.true.
    return
  endif
  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 (lextr,freq)
  endif
  !
end subroutine uv_reset_plot
!
subroutine uv_get_arraysize(rname,fsta,arr,nign,off,error)
  use gbl_message
  use gkernel_interfaces
  use ast_astro
  use astro_interfaces, except_this=>uv_get_arraysize
  !---------------------------------------------------------------------
  ! @ private
  !
  ! extract useful info from station file
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: rname   ! command name
  character(len=*), intent(in) :: fsta   ! station file name
  real(kind=4), intent(inout) :: arr        !
  integer(kind=4), intent(inout) :: nign
  real(kind=4), intent(inout) :: off(4) ! offset wrt to origin to plot positions of stations
  logical, intent(inout) :: error 
  ! Local
  integer(kind=4) :: ier,lun,iequal,i
  character(len=256) :: mess,clu
  !
  ier = sic_getlun (lun)
  ier = sic_open(lun,fsta,'OLD',.true.)
  if (ier.ne.0) then
    write (mess,'(a,1x,a)') 'Troubles opening station file:',fsta
    call astro_message(seve%e,rname,trim(mess))
    goto 998
  endif
  if (obsname.eq.'BURE'.or.obsname.eq.'NOEMA'.or.obsname.eq.'SMA') then
    read (lun,*,iostat=ier) arr
    nign=1
    off(1) = 0
    off(2) = 0
    off(3) = 0
    off(4) = 0
    if (ier.ne.0)  then
      write (mess,'(a,1x,a)') 'Troubles reading max baseline in',fsta
      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'.or.obsname.eq.'ACA') 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',fsta
        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',fsta
      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)  arr
    if (ier.ne.0)  then
      write (mess,'(a,1x,a)') 'Troubles reading max baseline in',fsta
      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
    arr = arr*1.2
    nign=9
    if (obsname.eq.'ALMA') then
      off(1) = 0
      off(2) = 0
      off(3) = -660
      off(4) = -660
    else if (obsname.eq.'ACA') then
      off(1) = -52
      off(2) = -52
      off(3) = -570
      off(4) = -570
    endif
  endif
  close(unit=lun)
  call sic_frelun (lun)
  return
  998   continue
  call putios('E-UV_TRACK, ',ier)
  close(unit=lun)
  call sic_frelun (lun)
  return
  !
end subroutine uv_get_arraysize
!
subroutine astro_uv_legend(rname,freq,decs,stalis,oldlis,del_mess,nused, count, nc,nces,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
  integer(kind=4), intent(in) :: nces     !positions to split the displayed line if needed
  character(len=*), intent(in) :: oldlis   !previous list of used stations
  character(len=*), intent(in) :: del_mess   !message about delay if present
  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) :: 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)
  if (len_trim(del_mess).gt.0) then
    write(chain,103) trim(del_mess)
    call gr_exec1(chain)
  endif
  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 ')
103   format ('DRAW TEXT 1 2 "',a,' ^" 6 /user ')
  !
  ! Plot on two lines when more than 6 stations (and less than 13)
  call gr_exec('set char 0.4')
  if (oldlis.ne.stalis) then
    if (nused.gt.12.or.stalis.eq."ALL STATIONS") then !ALMA or other observatory?
      count = count+2
      if (stalis.eq."ALL STATIONS") then
        chain = 'DRAW TEXT 1 1234 "'//stalis//'"   6 /user'
        write(chain(13:16),'(I4)') count
        call gr_exec1 (chain)
      else
        chain = 'DRAW TEXT 1 1234 "More than 12 antennas"   6 /user'
        write(chain(13:16),'(I4)') count
        call gr_exec1 (chain)
      endif
      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
      count = count+2
      chain = 'DRAW TEXT 1 1234 -"'//stalis(nces+1:nc) //'" 6 /user'
      write(chain(13:16),'(I4)') count
      call gr_exec1 (chain)
      count = count+1
      chain = 'DRAW TEXT 1 1234 "'//stalis(1:nces) //'" 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)
  use phys_const
  !---------------------------------------------------------------------
  ! @ 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
  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 - using global astro variables
  !---------------------------------------------------------------------
  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
!
