!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin data gag_scratch:uvshort.init
  !
  task\character "Action to be performed" ACTION$ 'uvshort%action'
  task\character "Input UV table" NAME$ 'name'
  !
  SAY " "
  task\real "Tolerance for spectral consistency check" SPETOL$ 'uvshort%spetol'
  task\real "X-Y position tolerance for gridding" POSTOL$ 'uvshort%postol'
  !
  SAY " "
  task\real "Interferometer calibration factor" IPFAC$ 'uvshort%ipfac'
  !
  SAY " "
  task\character "Single dish unit" SDUNIT$ 'uvshort%unit'
  task\real "Single dish calibration factor" SDFAC$ 'uvshort%datfac'
  task\real "Single dish weighting   factor" SDWEI$ 'uvshort%weifac'
  !
  SAY " "
  task\real "Single dish UV truncation radius [m]" UVTRUNC$ 'uvshort%uvtrunc'
  task\real "Single dish beam diameter [sec]" SDBEAM$ 'uvshort%beam%sd'
  task\real "Single dish diameter [m]" SDDIAM$ 'uvshort%diam%sd'
  task\real "Interferometer primary beam [sec]" IPBEAM$ 'uvshort%beam%int'
  task\real "Interferometer diameter [m]" IPDIAM$ 'uvshort%diam%int'
  task\real "UV Step for binning weight densities [m]" UVSTEP$ 'uvshort%uvstep'
  !
  task\go
  !
end data gag_scratch:uvshort.init
!
begin data gag_scratch:average.init
  task\file "Name of input 2D image"         IMAGE$    'name'"."'type'
  task\file "Name of 1D azimuthal sum"       SUMMED$   'name'"-sum."'type'
  task\file "Name of 1D azimuthal average"   AVERAGED$ 'name'"-avg."'type'
  task\file "Plane number of the used image" NPLANE$   1
  task\go
end data gag_scratch:average.init
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure uvshort-init
  let uvshort%names%inter  'name'
  let uvshort%names%short  'name'"-short"
  let uvshort%names%merged 'name'"-merged"
end procedure uvshort-init
!
begin procedure uvshort-run
  on error return base
  vector\run uv_short gag_scratch:uvshort.init /nowindow
end procedure uvshort-run
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure uvshort-plot-fields
  !
  gtvl\clear
  !
  ! Get single dish data
!!$  if (diam%sd.eq.diam%int) then
!!$     define header head 'uvshort%setup%sd%name'".vlm" read
!!$     define double sdt[2,'head%dim[2]*head%dim[3]'] xpos['head%dim[2]']
!!$     let xpos[ix] (ix-head%convert[1,2])*head%convert[3,2]+head%convert[2,2]
!!$     define integer first last
!!$     let last 0
!!$     for iy 1 to head%dim[3]
!!$        let first last+1
!!$        let last first+head%dim[2]-1
!!$        let sdt[1,'first':'last'] xpos
!!$        let sdt[2,'first':'last'] (iy-head%convert[1,3])*head%convert[3,3]+head%convert[2,3]
!!$     next iy
!!$     delete /var head
!!$  else
  ! Show mosaic setup
  greg1\set system EQUATORIAL ! uvt%equinox
  greg2\projection 'setup%int%cent%sex[1]' 'setup%int%cent%sex[2]' /type azimuthal
  !
  define real xmin xmax ymin ymax mymajor
  define character filename*512
  let filename 'name'".tab"
  ! Define box
  if (file(filename)) then
     define image sdt 'filename' read
     ! *** JP: Here we should reproject the SD offsets...
     sic\compute xmin min sdt[1,]
     sic\compute xmax max sdt[1,]
     sic\compute ymin min sdt[2,]
     sic\compute ymax max sdt[2,]
     let mymajor sdt%major
  else
     let filename 'name'"-short.lmv"
     if (file(filename)) then
        define real x1 xn y1 yn
        define header head 'filename' read
        let x1 (1-head%convert[1,1])*head%convert[3,1]+head%convert[2,1]
        let xn (head%dim[1]-head%convert[1,1])*head%convert[3,1]+head%convert[2,1]
        let y1 (1-head%convert[1,2])*head%convert[3,2]+head%convert[2,2]
        let yn (head%dim[2]-head%convert[1,2])*head%convert[3,2]+head%convert[2,2]
        let xmin min(x1,xn)
        let xmax max(x1,xn)
        let ymin min(y1,yn)
        let ymax max(y1,yn)
        define integer npt myfirst mylast
        let npt head%dim[1]*head%dim[2]
        define real sdt[2,npt] myx['head%dim[1]']
        let myfirst 1
        let myx[ix] (ix-head%convert[1,1])*head%convert[3,1]+head%convert[2,1]
        for iy 1 to head%dim[2]
           let mylast myfirst+head%dim[1]-1
           let sdt[1,myfirst:mylast] myx
           let sdt[2,myfirst:mylast] (iy-head%convert[1,2])*head%convert[3,2]+head%convert[2,2]
           let myfirst mylast+1
        next iy
        let mymajor head%major
     else
        message e uvshort "Files not found: "'name'".tab and "'filename'
        return base
     endif
  endif
  !
  greg1\limits xmax+20*sec xmin-20*sec ymin-40*sec ymax+20*sec
  greg1\set box match
  greg1\box /unit sec
  !
  ! Show single dish data and single dish beam
  greg1\set marker 4 1 0.4 45
  greg1\points sdt[1,] sdt[2,]
  greg1\pencil 3
  greg1\draw relocate 2 1.5 /box 1
  greg2\ellipse 'mymajor/2'
  greg1\draw text 2 1.8 "SD" /box 1
  greg1\draw text 2 1.2 "beam" /box 1
  !
  greg1\pencil 1
  greg1\set marker 4 3 0.4 0
  greg1\draw marker 0 0 /user
  greg1\draw marker 0 1 /box 2
  greg1\draw text 0.5 1 "Mosaic phase center" 6 /box 2
  for ifield 1 to setup%int%nf
     greg1\draw relocate setup%int%xoff%rad[ifield] setup%int%yoff%rad[ifield] /user
     !ellipse 'fields%primary/2'
     greg2\ellipse 'setup%int%hppb/2'
  next ifield
  greg1\pencil 0
  !
end procedure uvshort-plot-fields
!
begin procedure uvshort-setup
  @ p_setup.map inter
  @ uvshort-plot-fields
  @ uvshort-run
end procedure uvshort-setup
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure uvshort-weight-sub
  !
  define integer ifield
  let ifield &1
  !
  ! Compute the Single-Dish weight scaling factor used as uv_merge input
  ! so that final weight density of the SD data is equal to the weight density
  ! of the closest ring of interferometer data. Use only the first field
  ! in case of a mosaic.
  !
  ! First circularly average the interferometric and single dish data
  ! (Visibility are averaged => Weights are added!)
!  let uvcirc%step '1.5*diam%int'
  let uvcirc%step '1.25*diam%int'
  let uvcirc%min 'uvcirc%step' ! => Skip first one...
  let uvcirc%max 0 ! => Up to maximum
  let name 'uvshort%setup%int%names[ifield]' ! Interferometric data
  @ p_uvcirc.map
!!$  let name 'uvshort%names%short[ifield]' ! Single dish data
!!$  let uvcirc%min 0 ! => From 0
!!$  @ p_uvcirc.map
  !
  ! Get the first radius value for the single dish data (ie sum of weight from 0 to 1.25D)
  ! and the second radius value for the single dish data (ie sum of weight from 1.25D to 2.5D)
  ! In all cases use the central velocity channel
  define integer weicol
  define uvtable uvt 'uvshort%setup%int%names[ifield]'"-circ.uvt" read
  let weicol 7+3*int((uvshort%setup%int%first+uvshort%setup%int%last)/2)
  let uvshort%wdens%int[ifield] uvt[weicol,1]
  delete /var uvt
!!$  define image uvt 'uvshort%names%short[ifield]'"-circ.uvt" read
!!$  let weicol 7+3*int((uvshort%setup%sd%first+uvshort%setup%sd%last)/2)
!!$  let uvshort%wdens%sd[ifield] uvt[weicol,1]
!!$  delete /var uvt weicol
  !
  define uvtable sd_uvt 'uvshort%names%short[ifield]'".uvt" read
  sic\compute uvshort%wdens%sd[ifield] sum sd_uvt[weicol,]
  delete /var sd_uvt
  !
  ! Normalized to get weight density
  let uvshort%wdens%int[ifield] uvshort%wdens%int[ifield]/(3.0*pi*uvcirc%step^2)
  let uvshort%wdens%sd[ifield]  uvshort%wdens%sd[ifield]/(pi*uvcirc%step^2)
  !
  ! Compute single dish weight scaling factor
  if (uvshort%wdens%sd[ifield].le.0) then
     message e uvshort "Negative or zero SD weight density: "'uvshort%wdens%sd[ifield]'
     return base
  else if (uvshort%wdens%int[ifield].le.0) then
     message e uvshort "Negative or zero UV weight density: "'uvshort%wdens%int[ifield]'
     return base
  else
     let uvshort%wei_fac%def[ifield] 'uvshort%wdens%int[ifield]/uvshort%wdens%sd[ifield]'
     say " "
     message i uvshort "Computed weight scaling factor (field #"'ifield'"): "'uvshort%wei_fac%def[ifield]'
     say " "
  endif
  !
end procedure uvshort-weight-sub
!
begin procedure uvshort-weight
  !
  if exist(uvshort%wdens) then
     delete /var uvshort%wdens
  endif
  if exist(uvshort%wei_fac%def) then
     delete /var uvshort%wei_fac%def
  endif
  define structure uvshort%wdens /global
  define double uvshort%wdens%int[uvshort%setup%int%nf] uvshort%wdens%sd[uvshort%setup%int%nf] /global
  define double uvshort%wei_fac%def[uvshort%setup%int%nf] /global
  !
  for ifield 1 to uvshort%setup%int%nf
     @ uvshort-weight-sub 'ifield'
  next ifield
  !
end procedure uvshort-weight
!
begin procedure uvshort-plot-weight
  !
  greg1\set /def
  gtvl\clear
  !
  define uvtable uvt 'uvshort%setup%int%names[1]'"-circ.uvt" read
  define real uvt_dens uvt_rad /like uvt[1,]
  define integer weicol
  let weicol 7+3*int((uvshort%setup%int%first+uvshort%setup%int%last)/2)
  let uvt_rad  sqrt(uvt[1,]^2+uvt[2,]^2)
  let uvt_dens uvt[weicol,]
!!$  let uvt_dens[irad] uvt_dens/((2*irad+1)*pi*uvcirc%step^2)
  for irad 1 to uvt%dim[2]
     let uvt_dens[irad] uvt_dens[irad]/((2*irad+1)*pi*uvcirc%step^2)
  next irad
  !
  greg1\pencil 0
  greg1\limits /var uvt_rad uvt_dens
  if (uvshort%setup%int%uvmax.lt.200) then
     greg1\limits -0.05*uvshort%setup%int%uvmax 1.05*uvshort%setup%int%uvmax = =
  else
     greg1\limits -0.05*200 1.05*200 = =
  endif
  greg1\set box 4 28 2.5 10
  greg1\histogram uvt_rad uvt_dens
  greg1\pencil 1
  greg1\draw relo 0 uvshort%wei_fac%def[1]*uvshort%wdens%sd[1] /user
  greg1\draw line uvcirc%step uvshort%wei_fac%def[1]*uvshort%wdens%sd[1] /user
  greg1\pencil 1 /dash 3
  greg1\draw relo uvshort%uvtrunc user_ymin /user
  greg1\draw line uvshort%uvtrunc user_ymax /user
  greg1\pencil 1 /dash 1
  greg1\pencil 0
  greg1\box
  greg1\label "UV radius" /x
  greg1\label "Weight Density" /y
  !
end procedure uvshort-plot-weight
!
begin procedure uvshort-pseudo
  @ uvshort-run
  ! Plot weight densities
!  @ uvshort-plot-weight
end procedure uvshort-pseudo
!
!!$begin procedure uvshort-zero
!!$  import class
!!$  las\file in 'uvshort%setup%sd%name'".vlm"
!!$  las\find
!!$  define header head 'uvshort%setup%sd%name'".vlm" read
!!$  las\set match '0.5*abs(head%convert[3,3])/sec'
!!$  las\set weight equal
!!$  las\show match weight
!!$  delete /var head
!!$  for ifield 1 to uvshort%setup%int%nf
!!$     las\find /off 'uvshort%setup%int%xoff%sec[ifield]' 'uvshort%setup%int%yoff%sec[ifield]'
!!$     if (found.eq.0) then
!!$        message e uv_zero "No matching observation found"
!!$        return base
!!$     else
!!$        las\average
!!$        exp\uv_zero 'uvshort%names%short[ifield]'
!!$     endif
!!$  next ifield
!!$end procedure uvshort-zero
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure uvshort-plot-beam-one
  if ("&1none".eq."none") then
     message e uvshort-plot-beam "One argument needed"
     return base
  else
     define integer order
     let order '&1'
  endif
  if (order.eq.2) then
     gtvl\clear
  endif
  !
  @ window_tools.greg
  let inter 0.5 0.25
  !
  clean\read uv 'name'
!!$ Following code makes a segfault under ifort14 serial
!!$  uv_map /fields 'uvshort%ifield'
!!$  define image mybeam "*" real /like beam[1]
!!$  let mybeam% beam%
!!$  let mybeam beam
  clean\uv_map
  define image mybeam "*" real /like beam[1]
  let mybeam% beam%
  let mybeam beam[uvshort%ifield]
  define real cut1['mybeam%dim[1]',2] cut2['mybeam%dim[2]',2]
  for i 1 to mybeam%dim[1]
     let cut1[i,1] (i+1-mybeam%convert[1,1])*mybeam%convert[3,1]+mybeam%convert[2,1]
  next
  let cut1[1] cut1[1]/sec
  let cut1[2] mybeam['mybeam%dim[2]/2+1']
  for i 1 to mybeam%dim[2]
     let cut2[i,1] (i+1-mybeam%convert[1,2])*mybeam%convert[3,2]+mybeam%convert[2,2]
  next
  let cut2[1] cut2[1]/sec
  let cut2[2] mybeam['mybeam%dim[1]/2+1',]
  !
!!$  run azimuth_average gag_scratch:average.init /nowindow
!!$  define image average 'name'"-avg."'type' read
!!$  define real avrg['average%dim[1]',2]
!!$  !
!!$  let avrg[i,j] (i+1-average%convert[1,1])*average%convert[3,1]+average%convert[2,1]
!!$  let avrg[1] avrg[1]/sec
!!$  let avrg[2] average
  !
  @ window_xy 2 2 'order'
  greg2\rgdata mybeam /var
  greg1\limits /rgdata
  greg2\plot /scaling linear -0.25 1.0
  greg2\levels 0 to 1 by 0.2
  greg2\rgmap quiet
  greg1\box /unit sec
  greg2\wedge /level
  !
  if (order.eq.1) then
     greg1\draw text 0 1 "Interferometer Only" 5 0 /char 8
  else
     greg1\draw text 0 1 "Interferometer + Single Dish" 5 0 /char 8
  endif
  !
  @ window_xy 2 2 'order+2'
  greg1\limits * * * * /var cut1[1] cut1[2]
  greg1\limits < > < > /var cut2[1] cut2[2]
  greg1\pencil 1
  greg1\connect cut1[1] cut1[2]
  greg1\pencil 2
  greg1\connect cut2[1] cut2[2]
  greg1\pencil 0
  greg1\box
  !
end procedure uvshort-plot-beam-one
!
begin procedure uvshort-plot-beams
  if ((uvshort%ifield.lt.1).or.(setup%int%nf.lt.uvshort%ifield)) then
     message e uvshort "Request beam ("'uvshort%ifield'") out of useful range [1,"'setup%int%nf'"]"
     return base
  endif
  let name 'uvshort%names%merged'
  @ uvshort-plot-beam-one 2
  let name 'uvshort%names%inter'
  @ uvshort-plot-beam-one 1
end procedure uvshort-plot-beams
!
begin procedure uvshort-merge
  @ uvshort-run
  @ uvshort-plot-beams
  !
!!$  ! User feedback
!!$  say " "
!!$  say "Factors applied to the SD uv table during merge:"
!!$  say " "
!!$  say "  * Weight scaling factor:"
!!$  if (uvshort%setup%int%mosaic) then
!!$        say "     Field      User         Computed   Total (computed*user)"
!!$     for ifield 1 to uvshort%setup%int%nf
!!$        say "      " 'ifield' "      " 'uvshort%wei_fac%user' "      " 'uvshort%wei_fac%def[ifield]' -
!!$            "      " 'uvshort%wei_fac%def[ifield]*uvshort%wei_fac%user' /format a6 i2 a6 e9.2 a6 e9.2 a6 e9.2
!!$     next ifield
!!$  else
!!$     say "      - User:                  "'uvshort%wei_fac%user'
!!$     say "      - Computed:              "'uvshort%wei_fac%def[1]'
!!$     say "      - Total (computed*user): "'uvshort%wei_fac%def[1]*uvshort%wei_fac%user'
!!$  endif
!!$  say " "
!!$  say "  * Amplitude scaling factor:  "
!!$  say "      - User:                  "'uvshort%dat_fac%user'
!!$  say "      - Computed:              1"
!!$  say "      - Total (computed*user): "'uvmerge%dat_fac'
!!$  say " "
  !
end procedure uvshort-merge
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure uvshort-clean
  !
  sic delete 'uvshort%names%short'".lmv"
  sic delete 'uvshort%names%inter'".beam"
  sic delete 'uvshort%names%inter'".lmv"
  sic delete 'uvshort%names%merged'".beam"
  sic delete 'uvshort%names%merged'".lmv"
  !
  let name 'uvshort%names%merged'
  message i uvshort "NAME variable set to "'name'
  !
end procedure uvshort-clean
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
if ("&1none".ne."none") then
   let uvshort%action "&1" /lower
else
   let uvshort%action "all"
endif
!
@ uvshort-init
if (uvshort%action.eq."all") then
   ! Pipeline mode (This is the default...)
   @ uvshort-setup
   @ uvshort-pseudo
   @ uvshort-merge
   @ uvshort-clean
else if (uvshort%action.eq."setup") then
   @  uvshort-setup
else if ((uvshort%action.eq."pseudo").or.(uvshort%action.eq."merge").or.(uvshort%action.eq."clean")) then
   @ uvshort-setup
   @ uvshort-'uvshort%action'
else
   message e uvshort "Unknown action: "'uvshort%action'
   return base
endif
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
