program uv_track
  use gildas_def
  use image_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! Task to create a UV table from Station Coordinates and Observation
  ! parameters.
  !
  ! Does not include proper noise estimate for the time being
  !---------------------------------------------------------------------
  ! Global
  real :: a_lever
  include 'gbl_pi.inc'
  ! Local
  type(gildas) :: xima
  integer :: mstat, nstat, muv, ier, nc
  parameter (mstat=100, muv=10000)
  real, allocatable :: zch(:), zsh(:)
  real :: x(mstat), xx, yy, zz, sd, cd, sp, cp, h, sh, ch, phn(mstat)
  real :: y(mstat), z(mstat), extr, hlim(2)
  real :: hmin, hmax, array, uk, vk, horizon, phase, ph
  real :: uvmin, uvmin2, uv_spacing, diameter
  real*8 :: decs,freq,latitud,amat(9),bvec(3),az,el,avec(3),bandwidth
  integer :: i, j, k, kh, nh, lun, count, nvis, nshadow, nfill, ip, ff
  character(len=132) :: chain, file, fstation
  logical :: error,new,complete(mstat),ok
  real :: integ_time, frac, test, date, time, bandw
  real :: trec, tsys, tau, jpk, weight, total
  real :: step_time
  parameter (step_time=180.0)
  logical :: first
  integer :: next
  !------------------------------------------------------------------------
  nshadow = 0
  trec = 50.0
  tau = 0.1
  first = .true.
  total = 0.0
  ! Code:
  call gildas_open
  call gildas_dble('DECLINATION$',decs,1)
  call gildas_dble('FREQUENCY$',freq,1)
  call gildas_logi('NEW$',new,1)
  call gildas_char('UV_TABLE$',file)
  call gildas_char('STATION_FILE$',fstation)
  call gildas_real('UV_SPACING$',uv_spacing,1)
  call gildas_real('DIAMETER$',diameter,1)
  call gildas_real('HORIZON$',horizon,1)
  call gildas_dble('LATITUDE$',latitud,1)
  call gildas_real('HOUR$',hlim,2)
  call gildas_real('INTEGRATION$',integ_time,1)
  call gildas_real('BANDWIDTH$',bandw,1)
  !
  call gildas_real('TREC$',trec,1)
  call gildas_real('TAU$',tau,1)
  call gildas_real('PHASE$',phase,1)
  call gildas_close
  !
  decs = decs*pi/180.0
  !
  chain = file
  nc = lenc(chain)
  call sic_parsef(chain,file,' ','.uvt')
  call gagout('W-UV_TRACK,  Table name '   &
     &    //file(1:lenc(file)))
  !
  ! Use all stations in station file
  chain = fstation
  ier = sic_getlog(chain)
  call sic_parsef (chain,fstation,' ','.dat')
  !
  ! Antenna Diameter and Min UV spacing
  if (diameter.eq.0) then
    call gagout ('W-UV_TRACKS,  Antenna size unknown. '//   &
     &      'No shadowing warnings will be given.')
    jpk = 1.0
  else
    !
    ! Jy/K for 70 % Aperture efficiency
    jpk = 2.0*1.38e3*4.0/(pi*diameter**2)/0.70
    print *,'Using ',jpk,' Jansky/K'
  endif
  !
  ! Hour angle coverage
  horizon = max(3.0,min(horizon,90.0))
  !
  ! Observatory coordinates
  call amset(latitud,amat)     ! Hour-Dec to Az-El matrix
  !
  hmin = a_lever(sngl(decs),sngl(latitud),horizon)
  if (hmin.ge.0) then
    write(6,*) 'Dec. ',decs
    write(6,*) 'Latitude ',latitud
    write(6,*) 'E-UV_TRACK,  Source is not visible'
    call sysexi(fatale)
  endif
  sd = sin(decs)
  cd = cos(decs)
  !
  ! Hour angle range
  hmax = -hmin
  if (hlim(1).ne.0.0) then
    if (hlim(1).lt.hmin) then
      write(6,*) 'W-UV_TRACK,  Source rises only at ',hmin
    else
      hmin = hlim(1)
    endif
  endif
  if (hlim(2).ne.0.0) then
    if (hlim(2).gt.hmax) then
      write(6,*) 'W-UV_TRACK,  Source already sets at ',hmax
    else
      hmax = hlim(2)
    endif
  endif
  !
  ! Open Station Main List; Get best coverage from First Line
  ier = sic_getlun (lun)
  open (unit=lun,file=fstation(1:lenc(fstation)),status='OLD',   &
     &    iostat=ier,err=998)
  read (lun,'(A)',iostat=ier,end=998,err=998) chain
  !
  ! Handle various formats.
  array = 0.0
  ok = chain(1:1).eq.'!'
  if (ok) then
    do while(ok)
      read(lun,'(A)',iostat=ier) chain
      ok = chain(1:1).eq.'!'
    enddo
  else
    read(lun,'(A)',iostat=ier) chain
  endif
  array = array**2
  !
  ! Read X,Y,Z coordinates from station file
  nstat = 0
  xx = 0.
  yy = 0.
  zz = 0.
  ok = .true.
  do while (ok)
    nstat = nstat+1
    i = 1
    do while(chain(i:i).eq.' ')
      i = i+1
    enddo
    ip = index(chain(i:),' ')+i
    read(chain(ip:),*,iostat=ier) x(nstat),y(nstat),z(nstat)
    xx = xx+x(nstat)
    yy = yy+y(nstat)
    zz = zz+z(nstat)
    read(lun,'(A)',iostat=ier) chain
    ok = ier.eq.0
  enddo
  close(unit=lun)
  call sic_frelun(lun)
  xx = xx/nstat
  yy = yy/nstat
  zz = zz/nstat
  array = 0.0
  do i=1,nstat
    array = max(array,(x(i)-xx)**2+   &
     &      (y(i)-yy)**2+(z(i)-zz)**2)
  enddo
  array = 2.0*sqrt(array)
  write(6,*) 'I-UV_TRACKS, Array size is ',array
  !
  ! Get integration time in seconds
  ! FG 05.01.01 : force use of INTEG_TIME if given
  !
  if (integ_time.eq.0) then
    integ_time = 24.*3600.*uv_spacing/(4.*pi*array)
  endif
  integ_time = nint(integ_time)
  if (integ_time.gt.step_time) integ_time = step_time
  write(6,*) 'I-UV_TRACKS, Integration time ',integ_time,' sec.'
  frac = integ_time/3600.
  !
  ! Convert the phase noise into radian
  phase = pi*phase/180.0
  !
  ! Precompute the coordinates
  nh = nint((hmax-hmin)/frac)+2
  write(6,*) 'Number of time dump ',nh
  allocate (zch(nh),zsh(nh),stat=ier)
  nh = 0
  h = pi*hmin/12.0
  do while (h.lt.(pi*hmax/12.0))
    ch = cos(h)
    sh = sin(h)
    nh = nh + 1
    zch(nh) = ch
    zsh(nh) = sh
    h = h+pi*frac/12.0
  enddo
  write(6,*) 'Number of time dump ',nh
  !
  ! Bandwidth (in MHz)
  bandwidth = bandw            ! single -> double precision
  if (bandwidth.eq.0) then
    bandwidth = 8000.
  endif
  !
  ! Create or open table
  nvis = nh*nstat*(nstat-1)/2
  write(6,*) 'Number of visibilities ',nvis
  if (new) then
    xima%gil%inc(2) = integ_time
    call init_table (xima,file,nvis,decs,freq,bandwidth,error)
  else
    call extend_table (xima,file,nvis,decs,freq,bandwidth,error)
  endif
  if (error) then
    write(6,*) 'W-UV_TRACK,  Cannot open output Table'
    call sysexi(fatale)
  endif
  if (new) then
    allocate (xima%r2d(xima%gil%dim(1), xima%gil%dim(2)), stat=ier)
  else
    allocate (xima%r2d(xima%gil%dim(1), xima%trc(2)-xima%blc(2)+1), stat=ier)
  endif
  if (error) then
    write(6,*) 'W-UV_TRACK,  Cannot allocate output Table'
    call sysexi(fatale)
  endif
  count = 1
  !
  ! Shadowing
  uvmin2 = diameter**2
  h = pi*hmin/12.0
  next = 0
  nfill = 0
  !
  do k = 1,nh
    !
    ! Reset shadowing
    do i=1,nstat
      complete(i) = .true.
    enddo
    !
    ! Check for shadowing
    do i=1,nstat-1
      if (complete(i)) then
        do j=i+1,nstat
          if (complete(j)) then
            xx = x(i)-x(j)
            yy = y(i)-y(j)
            zz = z(i)-z(j)
            uk = zsh(k)*xx + zch(k)*yy
            vk = sd*(-zch(k)*xx+zsh(k)*yy)+cd*zz
            if ((uk**2+vk**2).le.uvmin2) then
              test = (xx*zch(k) - yy*zsh(k))*cd + zz*sd
              if (test.gt.0.0) then
                complete(j) = .false.
                ff = j
              else
                complete(i) = .false.
                ff = i
              endif
              !!                        PRINT *,'U2+V2',UK**2+VK**2,UK,VK,UVMIN2,I,J,FF
            endif
          endif
        enddo
      endif
    enddo
    !
    ! Fill the table now
    date = float(count)        ! In days
    time = k*frac*3600.0       ! In seconds
    !
    ! Compute source elevation
    avec(1) = zch(k)*cd
    avec(2) = zsh(k)*cd
    avec(3) = sd
    call matmul(amat,avec,bvec,1)
    call dangle(az,el,bvec)
    ! Compute Tsys
    call atmos(trec,tsys,tau,el)
    if (first) then
      print *,'Tsys ',tsys
      first = .false.
    endif
    ! Compute Weight
    weight= 2*bandwidth*integ_time/(jpk*tsys)**2
    total = total+weight
    !
    ! Generate phase noise
    call phase_sinus (phase,phn,nstat,h)
    !
    do i=1,nstat-1
      do j=i+1,nstat
        ph = phn(i)-phn(j)
        xx = x(i)-x(j)
        yy = y(i)-y(j)
        zz = z(i)-z(j)
        uk = zsh(k)*xx + zch(k)*yy
        vk = sd*(-zch(k)*xx+zsh(k)*yy)+cd*zz
        next = next+1
        if (complete(i).and.complete(j)) then
          call fill_table (uk,vk,date,time,   &
     &            weight,i,j,xima%r2d(1,next),el,   &
     &            integ_time,ph)
          total = total+weight
          nfill = nfill+1
        else
          call fill_table (uk,vk,date,time,   &
     &            0.0,i,j,xima%r2d(1,next),el,   &
     &            integ_time,ph)
          nshadow = nshadow+1
        endif
      enddo
    enddo
    h = h+pi*frac/12.0
  enddo
  write(6,*) 'Wrote ',nfill,' Visibilities (',nshadow,' shadowed)'
  call gdf_write_data(xima,xima%r2d,error)
  call cut_table(xima,file,0,error)
  !
  ! Write estimate noise
  total = 1e-3/sqrt(total)
  write(6,*) 'I-UV_TRACK,  Expected noise ',total,' Jy/beam'
  stop
  !
  998   write(6,*) 'E-UV_TRACK,  Trouble with ASTRO_STATIONS'
  print *,fstation(1:lenc(fstation))
  call putios('E-UV_TRACK, ',ier)
  close(unit=lun)
  call sic_frelun (lun)
end program uv_track
!
!!subroutine newuvt_init (xima,name,nvis,error)
subroutine init_table (xima,name,nvis,dec,freq,bandwidth,error)
  use image_def
  use gkernel_interfaces
  use gbl_format
  !---------------------------------------------------------------------
  ! Creates the output table header in X (the significant header parameters
  ! have already been defned in clic_table)
  !---------------------------------------------------------------------
  type (gildas), intent(inout) :: xima  ! UV data file
  character(len=*), intent(in) :: name  ! desired file name
  integer, intent(in) :: nvis           ! Number of visibilities
  logical, intent(out) :: error         ! Error flag
  real(8), intent(in) :: dec                         !
  real(8), intent(in) :: freq                        !
  real(8), intent(in) :: bandwidth                   !
  ! Local
  integer :: i, last
  !
  ! Do not nullify X header here: it has already been partly computed before.
  !
  error = .false.
  !
  xima%file = name
  xima%gil%blan_words = def_blan_words
  xima%gil%extr_words = def_extr_words
  xima%gil%desc_words = def_desc_words
  xima%gil%posi_words = def_posi_words
  xima%gil%proj_words = def_proj_words
  xima%gil%spec_words = def_spec_words
  xima%gil%reso_words = def_reso_words
  xima%gil%uvda_words = 2 ! Not Zero is enough
  !
  xima%gil%eval = 0.
  xima%gil%dim(2) = nvis              ! +1 ! = add the dummy uv = 7.5 m point
  xima%gil%ref(2) = 0.
  xima%gil%inc(2) = 1.                  ! needed to avoid crash in GRAPHIC
  xima%gil%val(2) = 0.
  xima%gil%ndim = 2
  xima%char%unit = 'Jy'
  xima%char%syst = 'EQUATORIAL'
  xima%gil%ptyp = p_azimuthal
  xima%gil%pang = 0.0
  xima%gil%xaxi = 0
  xima%gil%yaxi = 0
  xima%gil%faxi = 1
  !
  xima%gil%dec = dec
  xima%gil%epoc = 2000.0
  xima%gil%a0 = xima%gil%ra
  xima%gil%d0 = xima%gil%dec
  xima%char%line = ' '
  xima%gil%fres = bandwidth
  if (freq.ne.0d0) then
    xima%gil%fima = (freq+12.0)*1d3
    xima%gil%freq = freq*1d3
  else
    xima%gil%fima = 102d3
    xima%gil%freq = 90d3
  endif
  xima%gil%val(1) = xima%gil%freq
  !
  ! Here define the order in which you want the extra "columns"
  xima%gil%column_pointer = 0
  xima%gil%column_size = 0
  xima%gil%column_pointer(code_uvt_u) = 1
  xima%gil%column_pointer(code_uvt_v) = 2
  xima%gil%column_pointer(code_uvt_w) = 3
  xima%gil%column_pointer(code_uvt_date) = 4
  xima%gil%column_pointer(code_uvt_time) = 5
  xima%gil%column_pointer(code_uvt_anti) = 6
  xima%gil%column_pointer(code_uvt_antj) = 7
  xima%gil%natom = 3
  xima%gil%nstokes = 1
  ! Extra columns
  xima%gil%fcol = 8
  last = xima%gil%fcol+xima%gil%natom * xima%gil%nchan
  xima%gil%column_pointer(code_uvt_el) = last
  last = last+1
  xima%gil%column_pointer(code_uvt_int) = last
!  if (scan) then
!    xima%gil%column_pointer(code_uvt_scan) = last
!    last = last+1
!  endif
!
!  if (positions) then
!    xima%gil%column_pointer(code_uvt_loff) = last
!    xima%gil%column_pointer(code_uvt_moff) = last
!    last = last+2
!  endif
  do i=1,code_uvt_last
    if (xima%gil%column_pointer(i).ne.0) xima%gil%column_size(i) = 1
  enddo
  !
  xima%gil%nvisi = nvis
  xima%gil%type_gdf = code_gdf_uvt
  call gdf_setuv (xima,error)
  xima%loca%size = xima%gil%dim(1) * xima%gil%dim(2)
  print *, 'Into newuvt_init ',xima%gil%nvisi, xima%gil%nchan, xima%gil%dim(1:2)
  print *, 'Into newuvt_init UVDA_WORDS', xima%gil%uvda_words
  call gdf_create_image (xima,error)
  print *, 'Done newuvt_init '
end subroutine init_table
!<FF>
!!subroutine newuvt_extend (xima,name,nvis,nn,ndobs,ndscan,error,lc)
subroutine extend_table (xima,name,nvis,dec,freq,bandwidth,error)
  use image_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! Open a Table to extend it.
  !---------------------------------------------------------------------
  type (gildas), intent(inout) :: xima  ! UV data file
  character(len=*), intent(in) :: name  ! desired file name
  integer, intent(in) :: nvis           ! Number of visibilities
  logical, intent(out) :: error         ! Error flag
  real(8), intent(in) :: dec                         !
  real(8), intent(in) :: freq                        !
  real(8), intent(in) :: bandwidth                   !
!  integer, intent(in) :: nn             !
!  integer, intent(in) :: ndobs(nn)      !
!  integer, intent(in) :: ndscan(nn)     !
!  logical, intent(in) :: lc             ! Check table before
  ! Local
  integer(kind=size_length) :: mvis
  integer :: ier
  character(len=60) :: chain
  !-----------------------------------------------------------------------
  !
  call gdf_read_gildas(xima, name, '.uvt', error, data=.false.)
  if (.not.error) then
    if (abs(xima%gil%dec-dec).gt.1d-6) then
      write(6,*) 'W-ASTRO_UV,  Different declinations'
      error = .true.
    endif
    if (freq.ne.0.0 .and. (abs(freq-xima%gil%freq*1d-3).gt.1d-6)) then
      write(6,*) 'W-ASTRO_UV,  Different frequencies'
      error = .true.
    endif
    if (abs(bandwidth-xima%gil%fres).gt.1d-6) then
      write(6,*) 'W-ASTRO_UV, Different bandwidth'
      error = .true.
    endif
  endif
  if (error) return
  !
  ! Compute new size, and remember there may be more preallocated data
  ! than used in the table to be appended
  write(chain,1001) xima%gil%dim(2),nvis
1001 format('Old table size ',i8,' Adding ',i8)
  call gagout('I-EXTEND_TABLE,  '//chain)
  !
  mvis = xima%gil%dim(2)+nvis
  !
  print *,'Lead Trail ',xima%gil%nlead, xima%gil%ntrail
  call gdf_extend_image (xima,mvis,error)
  print *,'Lead Trail ',xima%gil%nlead, xima%gil%ntrail
  if (error) then
    call gagout('I-EXTEND_TABLE,  Table extension failed')
    return
  endif
  !
  ! Map only new region
  xima%blc(1) = 1
  xima%blc(2) = xima%gil%dim(2)+1-nvis
  xima%trc(1) = xima%gil%dim(1)
  xima%trc(2) = xima%gil%dim(2)
  print *, 'Done newuvt_extend '
end subroutine extend_table
!
subroutine cut_table (xima,name,ncut,error)
  use image_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! Update the number of visibilities
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: xima !
  character(len=*) :: name          !
  integer, intent(in) :: ncut         ! Number of missing visibilities
  logical :: error                    !
  !
  ! Local
  character(len=80) :: chain
  !----------------------------------------------------------------------
  !
  xima%gil%nvisi = xima%gil%dim(2) - ncut
  write(chain,1001) xima%gil%dim(2), xima%gil%nvisi
  xima%gil%dim(2) = xima%gil%nvisi
  call gagout('I-CUT_TABLE,  '//chain)
  call gdf_update_header(xima,error)
  print *, 'Done newuvt_cut ',xima%gil%nchan
  !
1001 format('Old size ',i8,' New ',i8)
end subroutine cut_table
!<FF>
subroutine fill_table (u,v,d,t,w,ideb,ifin,visi,e,dt,ph)
  !---------------------------------------------------------------------
  ! 7 Parametres :
  ! U, V, W=0, Date, Temps, Ant1, Ant2
  ! 3 values
  ! Reel, Imag, Poids
  ! 1.0,  0.0, 1.0
  !---------------------------------------------------------------------
  real :: u                         !
  real :: v                         !
  real :: d                         !
  real :: t                         !
  real :: w                         !
  integer :: ideb                   !
  integer :: ifin                   !
  real :: visi(*)                   !
  real :: e                         !
  real :: dt                        !
  real :: ph                        !
  !
  visi(1) = u
  visi(2) = v
  visi(3) = 0.0
  visi(4) = d
  visi(5) = t
  visi(6) = ideb
  visi(7) = ifin
  visi(8) = cos(ph)
  visi(9) = sin(ph)
  visi(10) = w
  visi(11) = e
  visi(12) = dt
end
!<FF>
function a_lever(d,d0,el)
  !---------------------------------------------------------------------
  ! Lever d'une etoile de declinaison D a latitude D0
  ! Ce code est different de "lever" de GreG, donc je l'appelle A_LEVER
  ! (sinon big problemes,...GD, 8-10-1992)
  ! D Declination in radians
  ! D0  Latitude in degrees
  !   EL  elevation limit in degrees
  ! LEVER Hour angle in Hours
  !
  ! PI/2-D0+EL < D  Circumpolaire
  ! D0-PI/2+EL < D < PI/2-D0+EL H = ACOS (TAN(D)/TAN(D0-PI/2))
  ! D < D0-PI/2+EL  Toujours couchee...
  !
  ! Formule applicable a la partie visible du ciel en projection
  ! sur un plan
  !---------------------------------------------------------------------
  real :: a_lever                   !
  real :: d                         !
  real :: d0                        !
  real :: el                        !
  ! Local
  real :: dd,d1,d2,ee
  real*8 :: pi
  parameter (pi=3.14159265358979323846d0)
  !
  if (d0.lt.0.) then
    d2 = -d
    d1 = -d0*pi/180.0
  else
    d2 = d
    d1 = d0*pi/180.0
  endif
  dd = d1-pi*0.5d0
  ee = el*pi/180.
  a_lever = (-sin(ee)+sin(d2)*cos(dd))/(cos(d2)*sin(dd))
  if (a_lever.le.-1.0) then
    a_lever = -12.0            ! Circumpolar
  elseif (a_lever.ge.1.0) then
    a_lever = 0.0              ! Not visible
  else
    a_lever = -12.0/pi* acos(a_lever)
  endif
end
!<FF>
subroutine amset(obslat,amat)
  !---------------------------------------------------------------------
  !   subroutine to provide transformation matrix from hour angle - dec
  !       into azimuth - elevation.
  !---------------------------------------------------------------------
  real*8 ::  obslat                 ! in degrees
  real*8 ::  amat(9)                !
  ! Global
  include 'gbl_pi.inc'
  ! Local
  real*8 ::  x1,y1,z1
  !
  x1=pi/180d0*obslat
  y1=dsin(x1)
  z1=dcos(x1)
  amat(1)=-y1
  amat(2)=0.d0
  amat(3)=z1
  amat(4)=0.d0
  amat(5)=-1.d0
  amat(6)=0.d0
  amat(7)=z1
  amat(8)=0.d0
  amat(9)=y1
end
!<FF>
subroutine dangle(along,alat,a)
  !---------------------------------------------------------------------
  ! version 1.0  mpifr cyber edition  22 may 1977.
  ! see nod 2 manual page m 9.1
  ! c.g haslam       mar  1972.
  ! this routine recovers the longitude and latitude angles, along
  ! (0 - 360) and alat ( +.- 180) in deg_to_radrees, which correspond to the
  ! vector a.
  !---------------------------------------------------------------------
  real*8 ::   along                 !
  real*8 ::   alat                  !
  real*8 ::   a(3)                  !
  ! Global
  include 'gbl_pi.inc'
  ! Local
  real*8 ::   aa
  !
  aa     = a(1)*a(1)+a(2)*a(2)
  aa     = dsqrt(aa)
  alat   = pi/2d0
  if (aa.ge.0.000001d0) then
    aa = a(3)/aa
    alat = datan(aa)           ! latitude in Radian
  endif
  !
  if (a(2).ne.0.d0 .or. a(1).ne.0.d0) then
    along=datan2(a(2),a(1))    ! longitude in Radian
  else
    along = 0.d0
  endif
end
!<FF>
subroutine dcosin(along,alat,a)    ! direction cosinus
  !---------------------------------------------------------------------
  ! version 1.0  mpifr cyber edition  22 may 1977.
  ! see nod 2 manual page m 9.1
  ! c.g haslam       mar  1972.
  ! this routine computes the vector a for the angles, along and alat,
  ! which should be specified in deg_to_radrees.
  !---------------------------------------------------------------------
  real*8 ::   along                 !
  real*8 ::   alat                  !
  real*8 ::   a(3)                  !
  ! Global
  include 'gbl_pi.inc'
  ! Local
  real*8 ::   x,y,z
  !
  x    = along                 ! x in radians
  y    = alat                  ! y in radians
  z    = dcos(y)
  a(1) = dcos(x)*z
  a(2) = dsin(x)*z
  a(3) = dsin(y)
end
!<FF>
subroutine matmul(mat,a,b,n)
  !---------------------------------------------------------------------
  ! version 1.0  mpifr cyber edition  22 may 1977.  G.Haslam
  ! version 2.0  iram
  !
  ! this routine provides the transformation of vector a to vector b
  ! using the n dimensional direction cosine array, mat.
  !---------------------------------------------------------------------
  real*8 ::    mat(3,3)             !
  real*8 ::    a(1)                 !
  real*8 ::    b(1)                 !
  integer ::   n                    !
  ! Local
  integer ::   i,j
  !
  if (n.gt.0) then
    do i=1,3
      b(i) = 0.d0
      do j=1,3
        b(i) = b(i)+mat(i,j)*a(j)
      enddo
    enddo
  else
    do i=1,3
      b(i) = 0.d0
      do j=1,3
        b(i) = b(i)+mat(j,i)*a(j)
      enddo
    enddo
  endif
end
!<FF>
subroutine atmos(trec,tsys,tau0,el)
  real :: trec                      !
  real :: tsys                      !
  real :: tau0                      !
  real*8 :: el                      !
  ! Local
  real :: tau,tatm,feff,tcab
  feff = 0.93
  tatm = 240.0
  tcab = 300.0
  !
  tau = tau0/sin(el)
  tsys = feff*(1.-exp(-tau))*tatm + (1.0-feff)*tcab + trec
  tsys = exp(tau)/feff*tsys
end
!<FF>
subroutine phase_sinus(phase,phn,n,h)
  real :: phase                     !
  integer :: n                      !
  real :: phn(n)                    !
  real :: h                         !
  ! Local
  integer :: i
  real :: rangau
  !
  ! A simple sinusoid variation
  do i = 1,n
    phn(i) = phase * sin(i*h)
  enddo
  ! Print *,'Phases ',phn
end
