! GILDAS team
!   Author: S.Guilloteau
!--------------------------------------------------------------------
if pro%narg.lt.2.or.mod(pro%narg,2).ne.0 then
  say "I-VLA_TO_UVT: Usage"
  say "   @ fits_to_uvt uvfits_file uvtable_file [KEY Value [KEY Value ...]]]"
  say "   file names must have no extension "
  say "      Fits file will be .uvfits"
  say "      UV table will be .uvt"
  say "   Optional arguments are "
  say "   FREQUENCY  Rest_frequency_value   (in MHz)"
  !! say "   VELOCITY   Source_velocity_value  (in km/s)"
  say "   LINE       Line_name"
  return
endif
!
begin procedure say_sexa
   define double h m s tmp ent frac sign
   let h &1
   exa H
   if (h.lt.0) then
      let sign -1
      let h -h
   else
      let sign 1
   endif
   let tmp h
   let ent int(tmp)
   let frac tmp-ent
   let h ent*sign
   !
   let tmp 60*frac
   let ent int(tmp)
   let frac tmp-ent
   let m ent
   !
   let tmp 60*frac
   let ent int(tmp)
   let frac tmp-ent
   let s tmp
   !
   say h ":"  m ":" s /format I3 A I2 A F6.3
end procedure
!
! Step 1 : convert the AIPS UVFITS file to GILDAS UVT
!
vector\fits &1.uvfits to &2-tmp.uvt /style casa
!
! Step 2 : patch the Header for coordinates...
defin fits a &1.uvfits HEADER      ! Don't read the data so far
!
define integer nif
if exist(a%aips_fq%no_if)
  nif = a%aips_fq%no_if
endif
  defin header bgdf &2-tmp.uvt write   ! Don't change the data either...
!!endif
!
if exist(a%aips_su%col%raepo) then
  !
  ! This MAY signal we have been using a MultiSource UVFITS
  ! despite the rules...
  !
  define double ra dec  ra_h dec_d
  let ra_h a%aips_su%col%raepo*24.d0/360.d0
  let ra a%aips_su%col%raepo*pi/180
  if ra_h.lt.0 then
    let ra_h ra_h+24.d0
    let ra ra+2.d0*pi
  endif
  @ say_sexa 'ra_h'
  !
  let dec a%aips_su%col%decepo*pi/180
  let dec_d a%aips_su%col%decepo
  !
  @ say_sexa 'dec_d'
  !
  bgdf%ra = ra
  bgdf%dec = dec
  !
  ! This may happen with a MultiSource file
  if bgdf%system.eq." " then
    let bgdf%system EQUATORIAL
    let bgdf%a0 bgdf%ra
    let bgdf%d0 bgdf%dec
  else if (bgdf%a0.eq.0.and.bgdf%d0.eq.0) then
    if (bgdf%system.eq."EQUATORIAL") then
      let bgdf%a0 bgdf%ra
      let bgdf%d0 bgdf%dec
    else
      SAY "Phase center is 0,0 => please check source coordinates afterwards."
      PAUSE
    endif
  endif
else
  ! Assume RA & Dec from phase center
  if (bgdf%a0.eq.0.and.bgdf%d0.eq.0) then
    SAY "Phase center is 0,0 => please check source coordinates afterwards."
    PAUSE
  else
    bgdf%ra = bgdf%a0
    bgdf%dec = bgdf%d0
  endif
endif
!
if exist(a%aips_su%col%source) then
  bgdf%source = 'a%aips_su%col%source'
endif
delet /var a
!
define double r8 lightspeed x8
define character key*12
define integer j
let lightspeed = 299792.458d0
!
! Parse the other arguments
for i 3 to pro%narg by 2
  let KEY 'pro%arg[i]' /upper
  j = i+1
  !
  if key.eq."FREQUENCY" then
    let r8 'pro%arg[j]'
    ! Modifying the reference channel is not allowed without modifying
    ! the corresponding U,V lengths, as it is the "observed" frequency
    ! at which baseline lengths are defined.
    !NO!       bgdf%ref(1) = bgdf%ref(1)+(r8-bgdf%restfre)/bgdf%freqres
    ! So we must modify instead the velocity at this reference channel
    bgdf%veloff = bgdf%veloff+(r8-bgdf%restfre)/bgdf%restfre*lightspeed
    bgdf%velres = -lightspeed*bgdf%freqres/r8
    bgdf%restfre = r8
  else if key.eq."VELOCITY" then
    SAY "W-FITS_TO_UVT, MOdifying Velocity is not yet supported"
    !
    ! Bugged code kept here, but not accessible
    if (no) then
      let r8 'pro%arg[j]'
      ! As stated above, modifying the reference channel is not allowed
      ! without modifying the corresponding U,V lengths
      x8 = (r8-bgdf%veloff)/bgdf%velres  ! Shift of reference channel
      !
      ! We thus must also modify the effective frequency at the new
      ! reference channel, to preserve the Lambda/D spatial resolution.
      bgdf%convert[2,1] = x8*bgdf%convert[3,1]+bgdf%convert[2,1]
      bgdf%convert[1,1] = x8+bgdf%convert[1,1]
      bgdf%veloff = r8
    endif
  else if key.eq."LINE" then
    bgdf%source = pro%arg[j] /format a12
  else
    say "Keyword "'key'" ignored"
  end if
next
!
if bgdf%unit.eq."UNCALIB" then
  bgdf%unit = "Jy"
endif
!
dele /var bgdf
!
! Step 3 not yet fully debugged
!
! Step 3 : prepare the UV table for imaging in Gildas
begin data gag_scratch:uv_casa.init
  task\file   "Input multi-polarization UV Table" INPUT$ 'casa_name'-tmp.uvt
  task\file   "Output single polarization UV Table" OUTPUT$ 'casa_name'.uvt
  task\character  "Stokes parameter" STOKES$ NONE
  task\values   "First and last values of each valid range" RANGES$ 0 0
  task\character "Type of values" CTYPE$                    CHANNEL
  task\real      "Rejection Threshold" THRESHOLD$           5.0
  task\integer   "Print interval for modifications" PRINT$  5000
  task\logical   "Keep anomalous rescale" KEEP$             YES
  task\logical   "Trim flagged data" TRIM$                  NO
  task\integer   "Weight column to test flag"  WCOL$        0
  task\go
end data gag_scratch:uv_casa.init
!
	
begin data gag_scratch:uv_splitpolar.init
  task\file   "Input multi-polarization UV Table" INPUT$ 'casa_name'-tmp.uvt
  task\file   "Output single polarization UV Table" OUTPUT$ 'casa_name'.uvt
  task\character  "Stokes parameter" STOKES$ "NONE"
  task\go
end data gag_scratch:uv_splitpolar.init
!
if exist(casa_name)
  delete /var casa_name
endif
define character*256 casa_name /global
let casa_name &2
if nif.ne.0 then
  vector\run uv_splitpolar gag_scratch:uv_splitpolar.init /nowin
  defin fits a &1.uvfits  HEADER              ! Do not read the data again...
  !
  ! Now the complex stuff
  !
  ! Define a frequency for each IF
  define double the_freqs[nif] /global
  let the_freqs a%aips_fq%col%if_freq*1d-6
  sic output uv_vla_patchif.init
  say "TASK\FILE 	Input  INPUT$ " &2.uvt
  say "TASK\FILE 	Output  OUTPUT$ " &2-tmp.uvt
  say "TASK\INTEGER NumIF NIF$ " 'nif'
  say "TASK\REAL  Frequencies  FREQS$["'nif'"] " the_freqs
  say "TASK\GO"
  sic output
  vector\run uv_vla_patchif * /nowind
  delete /var the_freqs
  !
  sic delete &2.uvt
  sic rename &2-tmp.uvt &2.uvt
else
  vector\run uv_casa gag_scratch:uv_casa.init !! /nowind
endif
!
! Step 4: remove temporary file
sic delete &2-tmp.uvt
