subroutine astro_uv(line,error)
  use gildas_def
  use image_def
  use gkernel_interfaces
  use gkernel_types
  use gbl_message
  use ast_astro
  use ast_constant
  use atm_params
  use ast_telescope
  use imager_interfaces, except_this=>astro_uv
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER Support for command
  ! UV_TRACKS Config [Dec Freq]  
  !       [/FRAME Max_U]  
  !       [/HOUR Hmin Hmax]   
  !       [/TABLE Name ’NEW]]   
  !       [/HORIZON Elv]   
  !       [/INTEGRATION T]   
  !       [/STATIONS Station1_ .. StationN ]   
  !       [/SIZE size1 nsize1 size2 nsize2 ...]   
  !       [/OFFSET offset]  
  !       [/WEIGHT mode [Jy_per_K Bandwidth]]  
  !!
  !------------------------------------------------------------------------
  ! 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, we 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
  !
  ! Constants
  character(len=*), parameter :: rname='UV_TRACK'
  !
  !  & ' UV_TRACKS', '/FRAME', '/HORIZON', '/HOUR_ANGLE', '/INTEGRATION', &
  !  & '/OFFSET', '/SIZE', '/STATIONS', '/TABLE', '/WEIGHT'   /   
  integer(kind=4), parameter :: iopt_frame=1
  integer(kind=4), parameter :: iopt_hori=2
  integer(kind=4), parameter :: iopt_hour=3
  integer(kind=4), parameter :: iopt_int=4
  integer(kind=4), parameter :: iopt_offset=5
  integer(kind=4), parameter :: iopt_size=6
  integer(kind=4), parameter :: iopt_stations=7
  integer(kind=4), parameter :: iopt_table=8
  integer(kind=4), parameter :: iopt_weight=9
  integer(kind=4), parameter :: mstat=100,mlist=20
  integer(kind=4), parameter :: hori_min=3 ! minimum elevation in degrees
  integer(kind=4), parameter :: mw=3
  character(len=8) :: weight(mw)
  data weight /'UNIFORM','AIRMASS','FULL'/
  !
  ! Local ---
  type(uv_track_t) :: uvt
  integer(kind=4) :: muv
  real(kind=4), allocatable :: zch(:), zsh(:)
  integer(kind=4) :: visi_size ! number of column of output table
  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), cmode
  character(len=132) :: clu, oldlis, stalis, delay_mess
  real(kind=4) ::  tt
  integer(kind=4) :: flag
  real(kind=8) :: dx,dy,dz
  real(kind=4) ::  xx, yy, zz,  h, sh, ch, xm(2), ym(2)
  real(kind=4) :: hmin, hmax, array,hh1,hh2,poff(4)
  real(kind=4) :: uk, vk, wk, 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), allocatable :: myvisi(:,:)
  integer(kind=4) :: ivisi
  integer :: date(7)
  character(len=16) :: d_chain
  integer :: idate 
  real :: rdate
  real(kind=4) :: px                ! page_x from GreG
  ! Saved variables
  type(gildas), save :: xtab            ! Probably needs to be SAVE'd
  integer(kind=4), save :: icount=0     ! Date counter 
  integer(kind=4), save :: icolour=0    ! Pen colour counter
  real(kind=4), save :: extr=300.0      ! Array size in meters
  real(kind=4), save :: integ_time=1    ! Integration time (in Minutes !...)
  real(kind=8), save :: decd=+20.d0     ! Source declination
  real(kind=4), save :: hori=hori_min   ! Lower elevation limit
  character(len=filename_length), save :: file = ' ' ! output table name 
  !
  logical, save :: do_plot              ! Plot UV Tracks 
  logical :: do_station                 ! Plot Configuration
  logical :: do_cover                   ! Plot a quick coverage
  logical :: do_shadow                  ! Print a message for Shadowing
  integer :: ih
  !
  character(len=4) :: key
  integer :: n_stations, n
  integer :: nfield
  real, allocatable :: offs(:,:)
  integer :: jf
  real :: theoff(2)
  character(len=256) :: string
  logical :: by_number=.false.    ! An old code version was using Station Numbers, not Names
  real(8) :: xvla,yvla,zvla
  !
  ! Code ----
  !
  ! Figure out the Pointing Offsets in case of a Mosaic
  call astro_uv_fields(nfield,offs)
  if (nfield.le.1) then
    visi_size = 12
  else
    visi_size = 14
  endif
  error = .false.
  !
  if (obsname.eq.' ') then
    call map_message(seve%e,rname,'Telescope array is undefined, use ARRAY command before UV_TRACK')
    error = .true.
    return
  endif
  !
  ! Check that station files is found
  if (sic_present(0,1)) then
    call sic_ch(line,0,1,string,n,.true.,error)
    if (string(1:n).ne.'*') then
      call sic_lower(string(1:n))
      string = trim(config_prefix)//string(1:n)
      ier = sic_setlog('astro_stations',trim(string))
    endif
    ! Get Declination unless using an existing Table
    if (.not.sic_present(iopt_table,0)) then
      if (.not.sic_present(0,2)) then
        call map_message(seve%e,rname,'Missing Source Declination as 1st argument')
        error = .true.
        return
      endif
      call sic_r8(line,0,2,decd,.true.,error)
      if (error) return
      ! Frequency in GHz
      call sic_r8(line,0,3,freq,.false.,error)
      if (error) return
    endif
    !
  endif
  if (.not.sic_query_file('astro_stations','data#dir:','.cfg',fstation)) then
    call map_message(seve%e,rname,'Astro_Stations file '//trim(fstation)//' not found')
    error = .true.
    return
  endif
  !
  ! backward compatibility to understand 3digit station names (E68 instead o E068)
  ! for NOEMA
  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_hori=sic_present(iopt_hori,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)
  !
  !
  ! Change the logic of /TABLE and /FRAME compared to ASTRO
  !   /TABLE Name NEW       to initialize a new table
  !   /TABLE [Name]         to add to existing table
  !       (in memory or from a previous file)
  !       Declination and Frequency derived from that table.
  if (uvt%in%do_table) then
    key = 'OLD'
    call sic_ke(line,iopt_table,2,key,nc,.false.,error)
    if (error) return 
    icount = icount+2   ! Increment Date counter
    icolour = icolour+1
    !
    if (key.eq.'NEW') then
      do_plot = sic_present(iopt_frame,0)
      if (do_plot) uvt%in%user_array = 0.
      ! Declination
      if (.not.sic_present(0,2)) then
        call map_message(seve%e,rname,'Missing Source Declination as 1st argument')
        error = .true.
        return
      endif
      call sic_r8(line,0,2,decd,.true.,error)
      if (error) return
      ! Frequency in GHz
      call sic_r8(line,0,3,freq,.false.,error)
      if (error) return
      call sic_ch (line,iopt_table,1,chain,nc,.true.,error)
      if (error) return
      call sic_parsef(chain,file,' ','.uvt')
      call map_message(seve%i,rname,"Initializing "//trim(file))
      config_count = 0       ! Reset line counter
      icount = 0      ! And date increment
      icolour = 0     ! Pen color    
    else if (sic_present(iopt_table,1)) then
      ! Append to an existing Table
      call sic_ch (line,iopt_table,1,chain,nc,.true.,error)
      if (error) return
      call sic_parsef(chain,file,' ','.uvt')
      call gildas_null(xtab,type='UVT')
      xtab%file = file
      call map_message(seve%i,rname,"Appending to "//trim(file))
      call gdf_read_header(xtab,error)
      if (error) return
      if (sic_narg(0).gt.1) then
        call map_message(seve%w,rname,"Specified Declination and Frequency ignored")
      endif
      ! Recover Declination and Frequency
      decd = xtab%gil%d0*180d0/pi
      freq = xtab%gil%freq*1d-3
      write(mess,'(A,f5 .1,A,f8.3,A)') "Declination ",decd,",  Frequency ",freq, " GHz"
      call map_message(seve%i,rname,mess)
      call gdf_close_image(xtab,error)
      !
    else if (len_trim(file).eq.0) then
      call map_message(seve%e,rname,'No previous Table')
      error = .true.
      return
    endif
    !
    if (do_plot) then
      call sic_r4 (line,iopt_frame,1,uvt%in%user_array,.false.,error)
      if (error) return
    endif
  else if (uvt%in%do_frame) then
    icolour = 0
    ! Option /FRAME
    do_plot = .true.
    ! Size
    uvt%in%user_array = 0.
    call sic_r4 (line,iopt_frame,1,uvt%in%user_array,.false.,error)
    if (error) return
  else
    icolour = icolour+1
  endif
  !
  uvt%in%do_all=.false.
  !
  ! /STATIONS
  n_stations = sic_narg(iopt_stations)
  if (n_stations.le.0) then
    uvt%in%do_all = .true.
    nstat_in = -1
  else if (n_stations.gt.mstat) then
    call map_message(seve%e,rname,'Too many stations entered')
    error=.true.
    return
  else if (by_number) then  ! Old code, by number
    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 map_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
  else      ! New code, by stations names
    stalis = ' '
    nc = 0
    ns = 0
    !
    do i=1, n_stations
      call sic_ke (line,iopt_stations,i,statn,l,.true.,error)
      if (error) return
      if (l.gt.0) then !! (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 map_message(seve%e,rname,'No stations')
      error = .true.
      return
    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.
  select case (obsname(1:4))
  case ('BURE','NOEM','PDBI')
    uvt%in%sizes(1) = 15.0
  case ('ALMA') 
    uvt%in%sizes(1) = 12.0
  case ('ACA ') 
    uvt%in%sizes(1) = 7.0
  case ('VLA ')
    uvt%in%sizes(1) = 25.0
  case ('SMA ')
    uvt%in%sizes(1) = 6.0
  case ('NGVL') 
    uvt%in%sizes(1) = 18.0
  case ('PARA','VLT ')
    ! 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
  case ('PTI ') 
    uvt%in%sizes(1) = 0.40
    throw = 76.0               ! 2 delay lines
    uvt%in%offset = 0.0
  case ('GI2T') 
    uvt%in%sizes(1) = 1.50
    throw = 6.0                ! 2 delay lines
    uvt%in%offset = 0.0
  case ('IOTA')
    uvt%in%sizes(1) = 0.45
    throw = 3.9                ! new iota small delay ?
    uvt%in%offset = 0.0
  case ('USER') 
    uvt%in%sizes(1) = diam
  end select
  ! 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 map_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 (mod(sic_narg(iopt_size),2).ne.0) then
      call map_message(seve%e,rname,'Option /SIZE requires an even number arguments')
      call map_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 map_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 map_message(seve%w,rname,'Antenna size unknown. No shadowing '//  &
    'warnings will be given.')
  endif
  !
  ! HORIZON option input  
  if (uvt%in%do_hori) then
    call sic_r4  (line,iopt_hori,1,hori,.true.,error)
    if (error) return
    if (hori.gt.90) then
      call map_message(seve%e,rname,'Sourve elevation cannot be higher than 90 degrees')
      hori = hori_min
      error=.true.
      return
    endif
    if (hori.lt.hori_min) then
      hori = hori_min 
      write (mess,'(a,1x,i2.0,1x,a)') 'Minimum elevation set to',hori_min,'degrees'
      call map_message(seve%w,rname,mess)
    endif
  endif
  uvt%in%horizon = hori
  !
  ! 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
  if (uvt%in%do_int) then
    call sic_r4 (line,iopt_int,1,integ_time,.true.,error)
    if (error) return
    if (integ_time.le.0) then
      call map_message(seve%e,rname,'integration time should be longer than 0')
      error=.true.
      return
    endif
  endif
  uvt%in%integ_time = integ_time
  write(mess,'(A,1PG10.3,A)') 'Integration time ',uvt%in%integ_time,' min'
  call map_message(seve%i,rname,mess)
  !
  inttime = uvt%in%integ_time*60. ! needed for atm computation in /weight, full mode
  !
  ! /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 map_message(seve%i,rname,'Weighting mode is '//name)
    if (name.eq.'FULL') then
      call sic_r4 (line,iopt_weight,4,taut,.false.,error)
      if (taut.lt.0.or.taut.gt.5) then
        write(mess,'(A,1PG10.2,A)') 'Invalid zenith opacity ',taut,'; reset to 0.05'
        call map_message(seve%w,rname,mess)
        taut = 0.05
      endif
      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
      !
      call astro_check_tsys ! Verify input parameters
    else
      if (sic_present(iopt_weight,2)) then
        call map_message(seve%e,rname,'Too many arguments for option /WEIGHT')
        error=.true.
        return
      endif
    endif
  else
    bandwidth = 1.0
  endif
  !
  ! END OF COMMAND PARSING
  !
  flag = 0
  !
  ! START OF WORK
  !
  ! 1. Check that source goes above the elevation limit and that 
  !    there is no problem with hour angle limits
  decs = decd*pi/180.d0
  latitud = lonlat(2)
  hmin = astro_lever(sngl(decs),latitud,uvt%in%horizon)
  if (hmin.ge.0) then
    call map_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 map_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 map_message(seve%w,rname,mess)
    endif
    uvt%in%h2=min(uvt%in%in_h2,hmax)
  endif
  !
  ! 2. Compute Hour angle range (and Time stamps)
  ! to allow any integration time
  frac = uvt%in%integ_time/60
  !
  nh = 0
  h = pi*uvt%in%h1/12.0           
  muv = abs(uvt%in%h2-uvt%in%h1)/frac + 2 ! Number of time stamps
  allocate(zch(muv),zsh(muv),stat=ier)
  !
  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)
    array = extr ! Update limit ?
    if (error) return
    oldlis = ' '
  else
    oldlis = stalis
  endif
  !
  ! Get and plot stations
  if (uvt%in%do_frame) then
    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
    do_station = .true.
  else
    do_station = .false.
  endif
  if (do_station) call gr_segm('ARRAY',error)
  ! Init found variable
  found = .false.
  ! 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)
  !
  ! 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 map_message(seve%e,rname,trim(mess))
    goto 998
  endif
  nfilled=0
  xvla = 0
  yvla = 0
  zvla = 0
  !
  do while (.true.)
    read(lun,'(a)',iostat=ier) clu
    if (ier.lt.0)  exit      ! EOF
    if (ier.ne.0)  then
      call map_message(seve%e,rname,'Troubles reading station coordinates')
      goto 998  ! Error reading line
    endif
    iline = iline+1
    if (clu(1:1).eq.'!')  then
      if (index(clu,'MODE').ne.0) then
        nlu = index(clu,'=')+2
        cmode = clu(nlu:nlu+4)
      endif
      cycle  ! ignore comments
    endif
    if (iline.le.nskip) cycle ! ignore first line - number depends on file format
    nlu = len_trim(clu)
    if (nlu.eq.0)  cycle     ! ignore empty lines
    !
    select case(obsname)
    case ('BURE','NOEMA','SMA') 
      ! BURE format: 4 columns
      read(clu(1:nlu),*,iostat=ier)  name,xx,yy,zz
      tt = 0.0
    case ('VLA','JVLA')  
      ! VLA format: antenna size in Col 4, name in Col 5
      read(clu(1:nlu),*,iostat=ier)  dx,dy,dz,tt,name
      !
      ! Refer to the Center N01
      xvla = -1601185.553970d0
      yvla = -5041978.191573d0
      zvla =  3554876.382645d0 
      dx = dx-xvla
      dy = dy-yvla
      dz = dz-zvla        
      !
      ! Convert these DX,DY,DZ to our required XX,YY,ZZ
      xx =  uvt%ang%sp * dy - uvt%ang%cp * dz
      yy = -dx
      zz =  uvt%ang%cp * dy + uvt%ang%sp * dz
    case ('USER')
      if (cmode.eq.'GEO ') then
        read(clu(1:nlu),*,iostat=ier)  dx,dy,dz,tt,name
        !
        ! Refer to First Station
        if (iline.eq.nskip+1) then
          xvla = dx 
          yvla = dy 
          zvla = dz
        endif
        dx = dx-xvla
        dy = dy-yvla
        dz = dz-zvla        
        !
        ! Convert these DX,DY,DZ to our required XX,YY,ZZ
        xx =  uvt%ang%sp * dy - uvt%ang%cp * dz
        yy = -dx
        zz =  uvt%ang%cp * dy + uvt%ang%sp * dz
      else
        read(clu(1:nlu),*,iostat=ier)  name,xx,yy,zz,tt
      endif
    case default
      ! ALMA format: at least 5 columns (antenna size in column 5)
      read(clu(1:nlu),*,iostat=ier)  name,xx,yy,zz,tt
    end select 
    if (ier.ne.0) then
      call map_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
      ntake = 0
      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
      if (do_station) then
        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
        xm(1) = yy
        ym(1) = zz*uvt%ang%cp-xx*uvt%ang%sp
        call gr4_marker(1,xm,ym,0.,-1.0)
      endif
    elseif (do_station) then     
      ! station not selected : only a square to mark the position
      call gr_set_marker(4,0,.1)
      xm(1) = yy
      ym(1) = zz*uvt%ang%cp-xx*uvt%ang%sp
      call gr4_marker(1,xm,ym,0.,-1.0)
    endif
  enddo  ! end of loop on station file lines
  !
  !
  close(unit=lun)
  call sic_frelun (lun)
  if (do_station) 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 map_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 map_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
  !
  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
  if (do_plot) then
    call gr_exec1('pen /colo '//char(ichar('0')+icolour))
    call astro_uv_legend (rname,freq,decs,& 
      & stalis,oldlis,delay_mess,uvt%n_stations, config_count,nc,nces,error)
    if (error) return
    !
    ! Plot coverage
    ! Consider setting marker size to equivalent dish size ?
    !   Too difficult for ALMA  (12 m for 12 km)
    ! 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)
  endif
  !
  uvt%stations(1)%t=uvt%stations(1)%t+uvt%in%offset
  nvis = 0
  table_ok = uvt%in%do_table
  if (table_ok) 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 (icount.eq.0) then
      write(mess,'(A,A,A,I0,A)')  &
        'Initialising ',trim(file),' with ',nvis,' (u,v) points'
      call map_message(seve%i,rname,mess)
      call astro_init_table(xtab,file,nvis,decs,freq,bandwidth,obsname,nfield,error)
    else
      write(mess,'(A,I0,A,A)')  &
        'Adding ',nvis,' (u,v) points to table ',trim(file)
      call map_message(seve%i,rname,mess)
      call astro_extend_table(xtab,file,nvis,decs,freq,error)
    endif
    if (error) then
      call map_message(seve%e,rname,'Cannot open output Table')
      call astro_close_table(xtab)
      return
    endif
    !
    allocate(myvisi(visi_size,nvis),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%w,rname,'Memory allocation failure for Table')
      call astro_close_table(xtab)
      error = .true.
      return
    endif
  else
    allocate(myvisi(1,1),stat=ier)    ! To avoid stride initialization warning
  endif
  !
  call jjdate(jnow_utc, date)
  call ndatec(date, d_chain, error)
  call gag_fromdate(d_chain,idate,error)
  idate = idate+icount
  rdate = float(idate)
  !
  ! OK, redo for good now!
  ivisi = 0
  ih = 1.0/12.0/frac   ! A coverage every 5 minutes
  do k = 1,nh
    uvt%ang%zsh=zsh(k)
    uvt%ang%zch=zch(k)
    do_shadow = (mod(k,ih).eq.1)    ! Print shadowing only every 5 minutes
    do_cover  = do_plot .and. do_shadow   ! and UV coverage too, for speed.
    !
    ! Check for stations
    complete(1:uvt%n_stations) = uvt%stations(1:uvt%n_stations)%found
    !
    ! 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 weight: 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
            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 (do_shadow) then
              if (.not.(complete(i))) then
                write(mess,'(A,I0,A,I0)') 'Antenna ',i,' is shadowed by ',j
                call map_message(seve%d,rname,mess)
              else if  (.not.(complete(j))) then
                write(mess,'(A,I0,A,I0)') 'Antenna ',j,' is shadowed by ',i
                call map_message(seve%d,rname,mess)
              endif
            endif
          endif
        enddo
      endif
    enddo
    !
    ! Fill the table now and Plot, Take in account max delay of Delay lines
    jf = 0
    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(uvt%stations(i)%asize*uvt%stations(j)%asize)*10/(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 (do_cover) then
              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
            endif
            !            
            uvmin = uvt%stations(i)%asize/2.+uvt%stations(j)%asize/2.
            if ((uk**2+vk**2).le.uvmin**2) then
              call map_message(seve%d,rname,'---- Y A UN PROBLEME ----')
            else
              if (table_ok.and.delay_ok) then
                ivisi = ivisi+1
                if (nfield.gt.1) then
                  jf = mod(k,nfield)+1
                  theoff = offs(:,jf) 
                endif
                call fill_table (uk,vk,wk,rdate,(uvt%in%integ_time*60*k),i,j,  &
                myvisi(:,ivisi),el,inttime,uvt%in%wkey,theoff)
              endif
              if (do_cover) then
                if (flag.eq.0) then
                  xm(1:2) = [uk,-uk]
                  ym(1:2) = [vk,-vk]
                  call gr4_marker(2,xm,ym,0.,-1.0)
                endif
                flag=0
              endif
            endif
          endif
        enddo
      endif
    enddo
    !
  enddo
  if (do_plot) then
    call gr_segm_close(error)
    call gr_pen(icolour=0,error=error)
  endif
  !
  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 imager_interfaces, except_this=>uv_do_baseline
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! ASTRO
  !
  ! 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       !! u,v,w coordinates
  logical, intent(inout) :: error               !! Logical error flag
  !
  ! Local ---
  real(kind=4) :: xx,yy,zz
  !
  ! Code ----
  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 imager_interfaces, except_this=>uv_check_shadow
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! ASTRO
  !
  ! 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        !! Shadow flags
  logical, intent(inout) :: error            !! Logical error flag
  !
  ! Local ---
  real(kind=4) :: xx,yy,zz,uk,vk,uvmin,test
  !
  ! Code ----
  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 happens, 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 imager_interfaces, except_this=>uv_check_delay
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! ASTRO
  !
  ! 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   !! Maximum allowed delay
  logical, intent(inout) :: delay_ok  !! Delay condition
  logical, intent(inout) :: error     !! Logical error flag
  !
  ! Local ---
  real(kind=4) :: xx,yy,zz,wkj,wki
  !
  ! Code ----
  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 imager_interfaces, except_this=>uv_match_station
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! ASTRO
  !
  ! 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   !! Match indicator
  logical, intent(inout) :: error   !! Logical error flag
  !
  ! Local ---
  character(len=256) :: chain
  character(len=3) :: sname
  !
  ! Code ----
  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 map_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 map_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 imager_interfaces, except_this=>uv_reset_plot
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! ASTRO
  !
  ! 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  !! Desired radius of displayed region - 0 means automatic
  real(kind=4), intent(inout) :: lextr  !! Radius of displayed region
  real(kind=8), intent(inout) :: ff     !! Unused
  logical, intent(inout) :: error       !! Logical error flag
  !
  ! 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 imager_interfaces, except_this=>uv_get_arraysize
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! ASTRO
  !
  ! 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         !! Radius of configuration
  integer(kind=4), intent(inout) :: nign     !! Number of lines to be ignored at beginning of file
  real(kind=4), intent(inout) :: off(4)      !! offset wrt to origin to plot positions of stations
  logical, intent(inout) :: error            !! Logical error flag
  !
  ! Local ---
  integer(kind=4) :: ier,lun,iequal,i
  character(len=256) :: mess,clu
  real(8) :: value
  !
  ! Code ----
  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 map_message(seve%e,rname,trim(mess))
    goto 998
  endif
  !
  select case(obsname)
  !
  case ('BURE','NOEMA','SMA') 
    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 map_message(seve%e,rname,mess)
      write (mess,'(a,1x,a)') 'Make sure this file is made for current observatory:',obsname
      call map_message(seve%e,rname,mess)
      goto 998
    endif
  case ('ALMA','ACA') 
    ! 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 map_message(seve%e,rname,mess)
        write (mess,'(a,1x,a)') 'Make sure this file is made for current observatory:',obsname
        call map_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 map_message(seve%e,rname,mess)
      write (mess,'(a,1x,a)') 'Make sure this file is made for current observatory:',obsname
      call map_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 map_message(seve%e,rname,mess)
      write (mess,'(a,1x,a)') 'Make sure this file is made for current observatory:',obsname
      call map_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
  case ('JVLA','VLA') 
    read (lun,*,iostat=ier) arr
    off = 0
    nign = 1
  case ('USER')
    read (lun,*,iostat=ier)    ! Skip line
    call obs_read_key(lun,'RADIUS',value,error)
    arr = value
    off = 0
    nign = 8 ! Skip 8 lines
  case default
    arr = 0
    off = 0
    nign = 0
  end select 
  close(unit=lun)
  call sic_frelun (lun)
  return
  !
  998   continue
  call putios('E-UV_TRACK, ',ier)
  close(unit=lun)
  call sic_frelun (lun)
  !
end subroutine uv_get_arraysize
!
subroutine astro_uv_legend(rname,freq,decs,stalis,oldlis,del_mess,nused, config_count, nc,nces,error)
  use gbl_message
  use gkernel_interfaces
  use imager_interfaces, except_this=>astro_uv_legend
  use phys_const
  !---------------------------------------------------------------------
  ! @ private
  !
  !*
  ! ASTRO
  !
  ! 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) :: config_count    !! Running number of configurations being drawn
  integer(kind=4), intent(in) :: nc          !! Length of STALIS
  logical, intent(inout) :: error            !! Logical error flag
  !
  ! Local ---
  real(kind=4) :: px
  logical :: err
  character(len=200) :: chain,stafile
  integer(kind=4) :: ier
  !
  ! Code ----
  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?
      config_count = config_count+2
      if (stalis.eq."ALL STATIONS") then
        chain = 'DRAW TEXT 1 1234 "'//stalis//'"   6 /user'
        write(chain(13:16),'(I4)') config_count
        call gr_exec1 (chain)
      else
        chain = 'DRAW TEXT 1 1234 "More than 12 antennas"   6 /user'
        write(chain(13:16),'(I4)') config_count
        call gr_exec1 (chain)
      endif
      config_count = config_count+1
      ier = sic_getlog('ASTRO_STATIONS',stafile)
      if (ier.ne.0) then
        call map_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)') config_count
      call gr_exec1 (chain)
    else if (nused.le.6) then !PDB = 1 line
      config_count = config_count+4
      chain = 'DRAW TEXT 1 1234 "'//stalis(1:nc) //'" 6 /user'
      write(chain(13:16),'(I4)') config_count
      call gr_exec1 (chain)
    else if (nused.le.12) then !NOEMA = 2 lines
      config_count = config_count+2
      chain = 'DRAW TEXT 1 1234 -"'//stalis(nces+1:nc) //'" 6 /user'
      write(chain(13:16),'(I4)') config_count
      call gr_exec1 (chain)
      config_count = config_count+1
      chain = 'DRAW TEXT 1 1234 "'//stalis(1:nces) //'" 6 /user'
      write(chain(13:16),'(I4)') config_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
  use gkernel_interfaces, only : gr_error
  !---------------------------------------------------------------------
  ! @ private
  !*
  !   ASTRO
  ! Draw a Box with Lengths in Meters and kWave
  !!
  !---------------------------------------------------------------------
  real(kind=4), intent(in) :: base    !! Baseline length (m)
  real(kind=8), intent(in) :: freq    !! Frequency (MHz)
  !
  ! Local ---
  real(kind=4) :: x
  character(len=80) :: chain
  !
  ! Code ----
  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, only : gdf_close_image
  !---------------------------------------------------------------------
  ! @ private
  !! ASTRO   Close the output table in UV_TRACK command
  ! 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    !! Header of table to be closed
  !
  ! 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
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !!  ASTRO   extend the UV table in UV_TRACK command
  !---------------------------------------------------------------------
  type(gildas),     intent(inout) :: x        !! UV Table header
  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
  !
  ! Code ----
  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 gdf_close_image(x,error)
  !
  ! Couple of checks
  if (abs(x%gil%dec-dec).gt.1d-6) then
    call map_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 map_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 map_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 map_message(seve%e,rname,'Table extension failed')
end subroutine astro_extend_table
!
subroutine astro_init_table(xima,name,nvis,dec,freq,band,obs,nfield,error)
  use gildas_def
  use image_def
  use gkernel_interfaces
  use gbl_format
  !---------------------------------------------------------------------
  ! @ private
  !! ASTRO  Initialize UV table in UV_TRACK command
  !---------------------------------------------------------------------
  type(gildas),     intent(inout) :: xima     !! 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
  integer(kind=4),  intent(in)    :: nfield   !! Number of fields
  logical,          intent(out)   :: error    !! Logical error flag
  !
  ! Local ---
  integer :: i, last
  real(kind=8) :: dummy(3)
  !
  call gildas_null(xima, type = 'UVT')
  error = .false.
  !
  xima%file = name
  xima%gil%blan_words = def_blan_words
  xima%gil%extr_words = def_extr_words
  xima%gil%desc_words = def_desc_words
  xima%gil%posi_words = def_posi_words
  xima%gil%proj_words = def_proj_words
  xima%gil%spec_words = def_spec_words
  xima%gil%reso_words = def_reso_words
  xima%gil%uvda_words = 2 ! Not Zero is enough
  !
  xima%gil%dim(2) = nvis
  !
  xima%gil%eval = 0.
  xima%gil%dim(2) = nvis            
  xima%gil%ref(2) = 0.
  xima%gil%inc(2) = 1.                 
  xima%gil%val(2) = 0.
  xima%gil%ndim = 2
  xima%char%unit = 'Jy'
  xima%char%syst = 'EQUATORIAL'
  xima%gil%ptyp = p_azimuthal
  xima%gil%pang = 0.0
  xima%gil%xaxi = 0
  xima%gil%yaxi = 0
  xima%gil%faxi = 1
  !
  xima%gil%dec = dec
  xima%gil%epoc = 2000.0
  xima%gil%a0 = xima%gil%ra
  xima%gil%d0 = xima%gil%dec
  xima%char%line = ' '
  xima%gil%fres = band
  if (freq.ne.0d0) then
    xima%gil%fima = (freq+12.0)*1d3
    xima%gil%freq = freq*1d3
  else
    xima%gil%fima = 102d3
    xima%gil%freq = 90d3
  endif
  xima%gil%val(1) = xima%gil%freq
  xima%gil%nchan = 1
  !
  ! Here define the order in which you want the extra "columns"
  xima%gil%column_pointer = 0
  xima%gil%column_size = 0
  xima%gil%column_pointer(code_uvt_u) = 1
  xima%gil%column_pointer(code_uvt_v) = 2
  xima%gil%column_pointer(code_uvt_w) = 3
  xima%gil%column_pointer(code_uvt_date) = 4
  xima%gil%column_pointer(code_uvt_time) = 5
  xima%gil%column_pointer(code_uvt_anti) = 6
  xima%gil%column_pointer(code_uvt_antj) = 7
  xima%gil%natom = 3
  xima%gil%nstokes = 1
  ! Extra columns
  xima%gil%fcol = 8
  last = xima%gil%fcol+xima%gil%natom * xima%gil%nchan 
  xima%gil%column_pointer(code_uvt_el) = last
  last = last+1
  xima%gil%column_pointer(code_uvt_int) = last
  if (nfield.gt.1) then
    last = last+1
    xima%gil%column_pointer(code_uvt_loff) = last
    last = last+1
    xima%gil%column_pointer(code_uvt_moff) = last
  endif
  do i=1,code_uvt_last
    if (xima%gil%column_pointer(i).ne.0) xima%gil%column_size(i) = 1
  enddo
  xima%gil%dim(1) = last
  !
  xima%gil%nvisi = nvis
  xima%gil%type_gdf = code_gdf_uvt
  call gdf_addteles(xima,'TELE',obs,dummy,error)
  call gdf_setuv (xima,error)
  xima%loca%size = xima%gil%dim(1) * xima%gil%dim(2)
  call gdf_create_image (xima,error)
end subroutine astro_init_table
!<FF>
!!subroutine newuvt_extend (xima,name,nvis,nn,ndobs,ndscan,error,lc)

!
subroutine fill_table (u,v,w,d,t,ideb,ifin,visi,el,time,wkey,offs)
!!subroutine fill_table (u,v,d,t,w,ideb,ifin,visi,e,dt,ph)
  use atm_params
  !---------------------------------------------------------------------
  ! @ private
  !! ASTRO  Add a visibility
  !---------------------------------------------------------------------
  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(:)   !! Visibility
  real(kind=8),    intent(in)  :: el        !! Elevation
  real(kind=4),    intent(in)  :: time      !! Integration time
  integer(kind=4), intent(in)  :: wkey      !! Code for Weights
  real(kind=4),    intent(in)  :: offs(2)   !! Offsets (radians)
  !
  ! 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
  visi(11) = el
  visi(12) = time
  if (ubound(visi,1).gt.12) visi(13:14) = offs
end subroutine fill_table
!
subroutine matmul(mat,a,b,n)
  !---------------------------------------------------------------------
  ! @ private
  !
  !! ASTRO  3x3 Matrix x Vector multiplication - N gives the matrix shape
  !
  ! 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)  !! Matrix
  real(kind=8),    intent(in)  :: a(3)      !! Vector
  real(kind=8),    intent(out) :: b(3)      !! Product
  integer(kind=4), intent(in)  :: n         !! Direction
  ! 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
  !
  !! ASTRO  provide transformation matrix from hour angle - dec into azimuth - elevation.
  !---------------------------------------------------------------------
  real(kind=8), intent(in)  :: obslat   !! iObservatory latitude 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 degrees, 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_check_tsys
  use atm_params
  use ast_astro
  use ast_telescope
  use gbl_message
  use imager_interfaces, only : map_message
  !
  character(len=*), parameter :: rname='UV_TRACK'
  character(len=120) :: mess
  ! integer :: ix
  !
  ! Approximate Tsys  -- 0.5 K per GHz at Zenith
  tsys = 0.5*freqs       ! Approximate Tsys at Zenith
  write(mess,'(A,F9.3,A)') 'Bandwidth    ',bandwidth,' MHz'
  call map_message(seve%i,rname,mess)
  write(mess,'(A,F9.3,A)') 'Frequency    ',freqs,' GHz '
  call map_message(seve%i,rname,mess)
  write(mess,'(A,F9.0,A)') 'Tsys zenith  ',tsys,' K'
  call map_message(seve%i,rname,mess)
  call astro_teles(freqs)
  jy_per_k = jypk 
  write(mess,'(A,F9.1,A)') 'Antenna gain ',jy_per_k,' Jy/K'
  call map_message(seve%i,rname,mess)
  ! ix = nint(inttime)
  ! write(mess,'(A,I9,A)')   'Integ.  Time ',ix,' s'
  ! call map_message(seve%i,rname,mess)
end subroutine astro_check_tsys
!
subroutine astro_setuv_weight(el)
  use gildas_def
  use gkernel_interfaces
  use atm_params
  !not here!  use atm_interfaces_public
  use ast_astro
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! ASTRO
  !   Provide empirical noise estimate for weights of visibilities
  !!
  !---------------------------------------------------------------------
  real(kind=8), intent(in) :: el  !! Elevation (in Radians)
  !
  real(4) :: w
  !
  airmass = 1./sin(el)
  !
  ! Approximate Tsys  -- 0.5 K per GHz at Zenith
  tsys = 0.5*freqs       ! Approximate Tsys at Zenith
  tsys = exp(taut*airmass)*tsys  ! As a function of Airmass
  !
  ! Need  Integration time (in Seconds)
  ! Need  Bandwidth        (in MHz)
  ! Need  Antenna Jy/K conversion factor
  ! Additional 60 % time efficiency due to overhead on total time
  w = jy_per_k*tsys/sqrt(bandwidth * 0.6 * inttime)
  uvweight = 1./w**2
end subroutine astro_setuv_weight
!
function astro_lever(d,d0,el)
  !---------------------------------------------------------------------
  ! @ private
  !   Heure de lever d'une etoile de declinaison D a latitude D0
  !   D Declination in radians
  !   D0  Latitude in degrees
  !   EL  elevation limit in degrees
  !   ASTRO_LEVER Hour angle in Hours
  !
  ! PI/2-D0+EL < D  Circumpolaire
  ! D0-PI/2+EL < D < PI/2-D0+EL H = ACOS (TAN(D)/TAN(D0-PI/2))
  ! D < D0-PI/2+EL  Toujours couchee...
  !
  ! Formule applicable a la partie visible du ciel en projection
  ! sur un plan
  !---------------------------------------------------------------------
  real(kind=4) :: astro_lever       ! intent(out)
  real(kind=4), intent(in) :: d                 !! Declination (radians)
  real(kind=4), intent(in) :: d0                !! Latitude (degrees)
  real(kind=4), intent(in) :: el                !! Elevation limit (degrees)
  ! Local
  real(kind=4) :: dd,d1,d2,ee
  real(kind=8) :: pi
  parameter (pi=3.14159265358979323846d0)
  !
  if (d0.lt.0.) then
    d2 = -d
    d1 = -d0*pi/180.0
  else
    d2 = d
    d1 = d0*pi/180.0
  endif
  dd = d1-pi*0.5d0
  ee = el*pi/180.
  astro_lever = (-sin(ee)+sin(d2)*cos(dd))/(cos(d2)*sin(dd))
  if (astro_lever.le.-1.0) then
    astro_lever = -12.0            ! Circumpolar
  elseif (astro_lever.ge.1.0) then
    astro_lever = 0.0              ! Not visible
  else
    astro_lever = -12.0/pi*acos(astro_lever)
  endif
end function astro_lever
!
subroutine astro_uv_fields(nfields, offs)
  use gildas_def
  use image_def
  use gkernel_types
  use gbl_message
  !
  use gkernel_interfaces
  use imager_interfaces, except_this => astro_uv_fields
  use iso_c_binding
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !*
  ! IMAGER    SIMULATE
  !
  !   Support command UV_TRACKS when a list of Offsets
  !   is available in Sim%Xoffset and Sim%Yoffset
  !!
  !---------------------------------------------------------------------
  integer, intent(inout) :: nfields  !! Number of fields
  real, allocatable, intent(inout) :: offs(:,:)  !! Offsets in radians (alpha,beta)
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  real(4), parameter :: rad_to_sec=180.*3600./pi
  character(len=*), parameter :: rname='UV_FIELDS'
  !
  character(len=64) :: coff_x, coff_y
  character(len=16) :: chain
  integer :: nf, ier, i
  real(kind=8), allocatable :: raoff(:), deoff(:), rapos(:), depos(:)
  real(kind=4), allocatable :: tmp(:)
  logical :: found
  type(sic_descriptor_t) :: desc_x,desc_y
  !
  character(len=20) :: c20
  character(len=80) :: c80
  integer :: next
  type(c_ptr) :: cptr
  real(4), pointer :: r1ptr(:)
  real(8), pointer :: d1ptr(:)
  logical :: error
  !
  ! Code:
  nfields = 0
  if (allocated(offs)) deallocate(offs)
  !
  coff_x = 'SIM%XOFFSET'
  call sic_descriptor(coff_x,desc_x,found)  
  if (.not.found) return
  !
  coff_y = 'SIM%YOFFSET'
  call sic_descriptor(coff_y,desc_y,found)  
  if (.not.found) then
    call map_message(seve%e,rname,'Y pointing variable '//trim(coff_y)//' does not exist')
  !    error = .true.
    return
  endif
  !
  ! Unit is either ABS or Angle Unit (R, D, M, S) - Not fully coded yet...
  chain = 'SEC'
  !
  error = .false.
  if (any(desc_x%dims.ne.desc_y%dims)) then
    call map_message(seve%e,rname,'Pointing variables '//trim(coff_x)// &
      & ' and '// trim(coff_y)//' do not match')
    error = .true.
  else if (desc_x%ndim.ne.1) then
    call map_message(seve%e,rname,'Pointing variables '//trim(coff_x)// &
      & ' and '// trim(coff_y)//' must be of Rank 1')
    error = .true.
  endif
  if (error) return
  !
  nf = desc_x%dims(1)
  !
  allocate (raoff(nf),deoff(nf),offs(2,nf),rapos(nf),depos(nf),tmp(nf),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  !
  ! these are offsets, as specified by user
  call adtoad(desc_x%addr,cptr,1)
  if (desc_x%type.eq.fmt_r4) then
    call c_f_pointer(cptr,r1ptr,[nf])
    raoff(:) = r1ptr
  else if (desc_x%type.eq.fmt_r8) then
    call c_f_pointer(cptr,d1ptr,[nf])
    raoff(:) = d1ptr
  else
    call map_message(seve%e,rname,'Offset Pointing variables must be Real or Double')
    error = .true.
    return
  endif
  !
  call adtoad(desc_y%addr,cptr,1)
  if (desc_x%type.eq.fmt_r4) then
    call c_f_pointer(cptr,r1ptr,[nf])
    deoff(:) = r1ptr
  else if (desc_x%type.eq.fmt_r8) then
    call c_f_pointer(cptr,d1ptr,[nf])
    deoff(:) = d1ptr
  else
    call map_message(seve%e,rname,'Offset Pointing variables must be Real or Double')
    error = .true.
    return
  endif
  !
  ! Scale with appropriate angular unit.
  select case (chain)
  case ('RAD')
    offs(1,:) = raoff
    offs(2,:) = deoff
  case ('DEG')
    offs(1,:) = raoff*pi/180.d0
    offs(2,:) = deoff*pi/180.d0
  case ('MIN')
    offs(1,:) = raoff*pi/180.d0/60.d0
    offs(2,:) = deoff*pi/180.d0/60.d0
  case ('SEC')
    offs(1,:) = raoff*pi/180.d0/3600.d0
    offs(2,:) = deoff*pi/180.d0/3600.d0
  case default
    call map_message(seve%e,rname,'Unknown offset units '//trim(chain))
    error = .true.
    return
  end select     
  !
  ! List the Offsets
  call map_message(seve%i,rname,'Offsets : ')
  next = 1
  do i=1,nf
    write(c20,'(A,F8.2,A,F8.2,A)') "(",offs(1,i)*rad_to_sec,',',offs(2,i)*rad_to_sec,')'
    c80(next:) = c20
    next = next+20
    if (next.ge.80) then
      write(*,'(A)') c80
      next = 1
    endif
  enddo
  if (next.gt.1) write(*,'(A)') c80(1:next-1)
  !
  nfields = nf
end subroutine astro_uv_fields
