!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin data gag_scratch:uv_casa.init
  task\file 	  "Input multi-polarization UV Table"         INPUT$     'name'"-tmp.uvt"
  task\file 	  "Output single polarization UV Table"       OUTPUT$    'name'".uvt"
  task\character  "Stokes parameter"                          STOKES$    NONE
  task\values     "First and last values of each valid range" RANGES$    20 -20
  task\character  "Type of values"                            CTYPE$     CHANNEL
  task\real       "Rejection Threshold"                       THRESHOLD$ 5.0
  task\integer    "Print interval for modifications"          PRINT$     500
  task\logical    "Keep anomalous rescale"                    KEEP$      NO
  task\logical    "Trim flagged data"                         TRIM$      YES
  task\integer    "Weight column to test flag"                WCOL$      0
  task\go
end data gag_scratch:uv_casa.init
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure casa2uvt-setup
  if .not.exist(casa) then
     define structure casa /global
     define character casa%name*256 /global
     define logical casa%mosaic /global
     define integer casa%nfield /global
  endif
  let casa%name "&1"
  ! Search for obs kind (single field or mosaic) and number of field
  define character filename*256
  let filename 'casa%name'".uvfits"
  if (file(filename)) then
     ! This is a single field, not a mosaic!
     let casa%mosaic no
     let casa%nfield 1
  else
     ! Maybe this is a mosaic
     let filename 'casa%name'"-[0-9]*.uvfits" ! sh-compatible
     sic find 'filename'
     if (dir%nfile.ne.0) then
        ! This definitely is a mosaic
        let casa%mosaic yes
        let casa%nfield dir%nfile
        for ifield 1 to casa%nfield
           let filename 'casa%name'"-"'ifield'".uvfits"
           if .not.(file(filename)) then
              message e casa2uvt "Missing file: "'filename'
              return base
           endif
        next ifield
     else
        message e casa2uvt "Do not find file either "'name'".uvfits or " 'name'"-*.uvfits"
        return base
     endif
  endif
end procedure casa2uvt-setup
!
begin procedure casa2uvt-uvfits2uvt
  vector\fits 'casa%name'".uvfits" to 'name'"-tmp.uvt" /style casa
end procedure casa2uvt-uvfits2uvt
!
begin procedure casa2uvt-patch-xycoord
  define fits fitshead 'casa%name'".uvfits" header
  !
  if (uvthead%system.eq." ") then
     let uvthead%system "EQUATORIAL"
     message i casa2uvt "Patched coordinate system to EQUATORIAL 2000"
  endif
  if exist(fitshead%aips_su%col%raepo) then
     ! This MAY signal we have been using a MultiSource UVFITS
     ! despite the recommandations
     message e casa2uvt "MultiSource UVFITS?"
     return base
  else
     ! Assume RA & Dec from phase center
     if ((uvthead%a0.eq.0).and.(uvthead%d0.eq.0)) then
        message w casa2uvt "Phase center is at (0,0) => Can't patch the source coordinates"
     else
        message i casa2uvt "Patched source coordinates to phase center"
        let uvthead%ra  uvthead%a0
        let uvthead%dec uvthead%d0
     endif
  endif
  if exist(fitshead%aips_su%col%source) then
     let uvthead%source 'uvhead%aips_su%col%source'
     message i casa2uvt "Patched source name to "'uvhead%source'
  endif
  let uvthead%blank[2] 0
  message i casa2uvt "Patched blanking eval to 0"
end procedure casa2uvt-patch-xycoord
!
begin procedure casa2uvt-patch-fvcoord
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  ! Important comments:
  !   1. At this point, the frequency and velocity axes are consistent.
  !      However they are different from what the standard astronomer
  !      expects, i.e., the rest frequency corresponding to the
  !      Vlsr velocity of the source. Instead, the rest frequency
  !      corresponds to a 0 km/s Vlsr velocity. So the user must provide
  !      the Vlsr velocity of the source.
  !   2. In a wide bandwidth spectrum, there is no privileged frequencies
  !      as there can be many lines in the bandwidth. So the user must also
  !      provide the frequency of the line he wants to privileged.
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !
  if (casa%pro%frequency%narg.ge.0) then
    ! /FREQUENCY is present
    if casa%pro%frequency%narg.ne.2 then
      message e modify "Option /FREQUENCY takes 2 arguments"
      return base
    endif
    sic\modify uvthead /frequency 'casa%pro%frequency%arg[1]' 'casa%pro%frequency%arg[2]'
  endif
  if (casa%pro%velocity%narg.ge.0) then
    ! /VELOCITY is present
    if casa%pro%velocity%narg.ne.1 then
      message e modify "Option /VELOCITY takes 1 argument"
      return base
    endif
    sic\modify uvthead /velocity 'casa%pro%velocity%arg[1]'
  endif
  !
end procedure casa2uvt-patch-fvcoord
!
begin procedure casa2uvt-patch-coord
  ! Here we are careful to only work on the headers as the data may be bigs!
  if exist(uvthead) delete /var uvthead
  define header uvthead 'name'"-tmp.uvt" write /global
  @ casa2uvt-patch-xycoord
  @ casa2uvt-patch-fvcoord
  delete /var uvthead
  vector\header 'name'"-tmp.uvt"
end procedure casa2uvt-patch-coord
!
begin procedure casa2uvt-uvcasa
  vector\run uv_casa gag_scratch:uv_casa.init /nowind
  vector\header 'name'".uvt"
end procedure casa2uvt-uvcasa
!
begin procedure casa2uvt-clean
  sic delete 'name'"-tmp.uvt"
end procedure casa2uvt-clean
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
@ casa2uvt-setup &1
!
! Argument parsing
sic\parse /velocity /frequency
if exist(casa%pro) delete /var casa%pro
define structure casa%pro /like pro /global
let casa%pro% pro%
!
if (casa%mosaic) then
   define character mycasaname*256
   let mycasaname 'casa%name'
   for ifield 1 to casa%nfield
     let casa%name 'mycasaname'"-"'ifield'
     let name "&2-"'ifield'
     message i casa2uvt "Name set to "'name'
     @ casa2uvt-uvfits2uvt
     @ casa2uvt-patch-coord
     @ casa2uvt-uvcasa
     @ casa2uvt-clean
   next ifield
   let name "&2"
   message i casa2uvt "Name set to "'name'
else
   let name "&2"
   message i casa2uvt "Name set to "'name'
   @ casa2uvt-uvfits2uvt
   @ casa2uvt-patch-coord
   @ casa2uvt-uvcasa
   @ casa2uvt-clean
endif
delete /var casa
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
