! r.neri on August 2nd, add colors to identify uv_tables. A max of 7 data 
! samples is made out by means of 7 different colors. The uv samples are 
! made out by "time_step", the minimum time gap in hours between two samples.
!
!SET MARKER 0 0 .1 
clear plot 
set box /def 
define integer ii ir iw ic nc k n n1 n2 imark nmap nadd 
define character xtext*30 ytext*30 atext*30 atype*8 fitext*12 cmark*12 
define real l1 l2 l3 l4 ll1 ll2 ll3 ll4 real x1 dx y1 dl
define double xmark 
define logical docurve 
!
begin procedure uv_ident
 define real val
 define inte nval nmin nnew 
 compute val max uv_time
 let nval nint(val)
 let nmin nold-nval
 let nnew nval+1
 let nval max(nval,1)
 if (.not.exist(uvn)) then
   define real uvn[nmin,2] /global
   let uvn[1:nmin,nkax] uv[nnew:nold,nkax]          
  else
   let uvn[1:nmin,nkax] uv[nnew:nold,nkax] 
   let uv_time[nval:nval] 0
   let nold nval
 endif
end procedure uv_ident

if (name.eq." ") then 
  say "Please enter UV file name (without extension) " 
  let name 
endif 
! 
define integer new$date 
define logical change transp 
! 
let xtype 'xtype' /upper
let ytype 'ytype' /upper
sic\sic search 'name'.tuv 
let transp .not.sic$exist 
let change name.ne.tuv$name 
if (.not.change) then 
  sic\compute new$date date 'name'.uvt 
  let transp new$date.gt.tuv$date 
else 
! Must change file. Compare date of .UVT with date of .TUV 
  if (.not.transp) then 
    sic\compute new$date date 'name'.uvt 
    sic\compute tuv$date date 'name'.tuv 
    let transp new$date.gt.tuv$date 
  endif 
endif 
if (transp) then 
  say 'name'.uvt ('new$date') "is younger than " 'name'.tuv ('tuv$date') 
  image /close 
  say "Transposing " 'name'.uvt "..." 
  vector\transpose 'name'.uvt 'name'.tuv 213 
  sic\compute tuv$date date 'name'.tuv 
  let change yes 
else 
  say 'name'.uvt ('new$date') "is older than " 'name'.tuv ('tuv$date') 
endif 
if (change) then 
  say "Changing to new or updated file " 'name'.tuv 
  image 'name'.tuv 
  let nz g_dim[1] /new integer 
  let tuv$name 'name' 
  on error continue 
  delete /variable uv 
  delete /variable num 
  on error 
  define real uv[nz,2] num[nz] /global 
else 
  image 'name'.tuv 
endif 
let nc (g_dim[2]-7)|3 
@ p_uvheader.graphic 
! 
let x1 box_xmin 
let y1 box_ymin 
if first.eq.0 then 
  let n1 1 
else 
  let n1 first 
endif 
if last.eq.0 then 
  let n2 nc 
else 
  let n2 last 
endif 
if first.gt.last then 
  let last first 
  let n2 n1 
endif 
let nmap n2-n1+1 
let n int(sqrt(nmap+1)) 
if (n**2.lt.nmap) then 
  let n = n+1 
endif 
set expand min(3.|n,1.) 
let dx (box_xmax-x1)|n 
let dx min((box_ymax-y1)|n,dx) 
! 
! first pass to get limits 
if (limits.eq." ") then 
  say "... Finding limits ..." 
  let k n1-1 
  let l1 1e30 
  let l2 -1e30 
  let l3 l1 
  let l4 l2 
  for ik n1 to n2 
    let ir 5+3*ik 
    let ii 6+3*ik 
    let iw 7+3*ik 
    for kax 1 to 2 
      if (kax.eq.1) then 
        let atype 'xtype' 
      else if (kax.eq.2) then 
        let atype 'ytype' 
      endif 
      if (atype.eq."U") then 
        let uv[kax] rg[1] 
      else if (atype.eq."V") then 
        let uv[kax] rg[2] 
      else if (atype.eq."ANGLE") then 
        let uv[kax] 180|pi*atan2(rg[2],rg[1]) 
      else if (atype.eq."RADIUS") then 
        let uv[kax] sqrt(rg[1]**2+rg[2]**2) 
      else if (atype.eq."TIME") then 
        let uv[kax] 24.0d0*(rg[4]-rg[1,4])+rg[5]|3600.d0 
      else if (atype.eq."DATE") then 
        let uv[kax] rg[4]-rg[1,4]               ! +RG[5]|86400.D0 
      else if (atype.eq."SCAN") then 
        let uv[kax] rg[3] 
      else if (atype.eq."NUMBER") then 
        let num[i] i 
        let uv[kax] num 
      else if (atype.eq."AMP") then 
        let uv[kax] sqrt(rg[ir]**2+rg[ii]**2) 
      else if (atype.eq."PHASE") then 
        let uv[kax] 180|pi*atan2(rg[ii],rg[ir]) 
      else if (atype.eq."REAL") then 
        let uv[kax] rg[ir] 
      else if (atype.eq."IMAG") then 
        let uv[kax] rg[ii] 
      else if (atype.eq."WEIGHT") then 
        let uv[kax] rg[iw] 
      else 
        say "E-UVPLOT,  Type not supported " 'atype' 
      endif 
    next 
    compute ll1 min uv[1]
    compute ll2 max uv[1]
    compute ll3 min uv[2]
    compute ll4 max uv[2]
    let l1 min(ll1,l1)
    let l2 max(ll2,l2)
    let l3 min(ll3,l3)
    let l4 max(ll4,l4)
  next
  if (l1.ne.l2) then
    let dl 0.025*(l2-l1)
    let l1 l1-dl
    let l2 l2+dl
    if (l3.ne.l4) then
      let dl 0.025*(l4-l3)
      let l3 l3-dl
      let l4 l4+dl
      symbol alimits 'l1'" "'l2'" "'l3'" "'l4'
    else
      symbol alimits 'l1'" "'l2'" -1 1"
    endif
  else
    let dl 0.025*(l4-l3)
    let l3 l3-dl
    let l4 l4+dl
    if (l3.ne.l4) then
      symbol alimits "-1 1 "'l3'" "'l4'
    else	
      SAY "Only NULL data found"
      return
    endif	
  endif
else
    symbol alimits 'limits'
endif
! 
if (exist(uv_time)) then
  del /var uv_time
endif
if (exist(uvn)) then
  del /var uvn
endif
if (exist(nold)) then
  del /var nold
endif
if (exist(nkax)) then
  del /var nkax
endif
define real rnzn
define real uv_time /like rg[1] /global
define inte nold nkax /global
define inte nzn nm nst 
let uv_time[i] i
compute rnzn max uv_time 
let nzn nint(rnzn)
let nm nzn-1
let uv_time 24.0d0*(rg[4]-rg[1,4])+rg[5]|3600
let uv_time[1:nm] uv_time[1:nm]-uv_time[2:nzn]
let uv_time[nzn:nzn] 0
let uv_time abs(uv_time)
let uv_time 0 /where uv_time.lt.time_step
let uv_time 1 /where uv_time.ne.0
compute rnzn mean uv_time
let nst nint(rnzn*nzn)+1
if (nst.gt.7.or.time_step.eq.0) then
  let nst 1
  let uv_time 0
 else
  let uv_time[i] i /where uv_time.ne.0
  let uv_time[1:1] 1
endif
define real copy_time /like uv_time
let copy_time uv_time
!
! SECOND PASS TO PLOT 
let k n1-1 
for j 1 to n 
  for i 1 to n 
    set box x1+(i-1)*dx x1+i*dx y1+(n-j)*dx y1+(n+1-j)*dx 
    let k k+1 
    if ((k.gt.nc).or.(k.gt.n2)) then 
      set expand 1.0 
      return 
    else 
      let xmark g_veloff+(k-g_convert[1,2])*g_velres 
      if (mark.eq."FREQUENCY") then 
        let imark nint((-(xmark-g_veloff)*g_restfre|299792.458+g_restfre)*1e3) 
        let xmark 1d-6*imark 
      else if (mark.eq."CHANNEL") then 
        let xmark k 
      else 
        let mark "VELOCITY" 
        let imark nint(xmark*10.) 
        let xmark 1d-1*imark 
      endif 
                                ! 
      let ir 5+3*k 
      let ii 6+3*k 
      let iw 7+3*k 
      let nold nzn
      let uv_time copy_time
      for mmm 1 to nst
       for kax 1 to 2 
        if (kax.eq.1) then 
          let atype 'xtype' 
        else if (kax.eq.2) then 
          let atype 'ytype' 
        endif 
	let nkax kax
        if (atype.eq."U") then 
          let uv[kax] rg[1] 
          let atext "U (meters)" 
	  @ uv_ident
        else if (atype.eq."V") then 
          let uv[kax] rg[2] 
          let atext "V (meters)" 
	  @ uv_ident
        else if (atype.eq."ANGLE") then 
          let uv[kax] 180|pi*atan2(rg[2],rg[1]) 
          let atext "UV position angle (degrees)" 
	  @ uv_ident
        else if (atype.eq."RADIUS") then 
          let uv[kax] sqrt(rg[1]**2+rg[2]**2) 
          let atext "UV radius (meters)"
	  @ uv_ident
        else if (atype.eq."TIME") then 
          let uv[kax] 24.0d0*(rg[4]-rg[1,4])+rg[5]|3600.d0 
          let atext "Time (hours)" 
	  @ uv_ident
        else if (atype.eq."DATE") then 
          let uv[kax] rg[4]-rg[1,4]             ! +RG[5]|86400.D0 
          let atext "Date (days)" 
	  @ uv_ident
        else if (atype.eq."SCAN") then 
          let uv[kax] rg[3] 
          let atext "Scan number" 
	  @ uv_ident
        else if (atype.eq."NUMBER") then 
          let num[i] i 
          let uv[kax] num 
          let atext "Visibility number" 
	  @ uv_ident
        else if (atype.eq."AMP") then 
          let uv[kax] sqrt(rg[ir]**2+rg[ii]**2) 
          let atext "Amplitude (Janskys)" 
	  @ uv_ident
        else if (atype.eq."PHASE") then 
          let uv[kax] 180|pi*atan2(rg[ii],rg[ir]) 
          let atext "Phase (degrees)" 
	  @ uv_ident
        else if (atype.eq."REAL") then 
          let uv[kax] rg[ir] 
          let atext "Real part (Janskys)" 
	  @ uv_ident
        else if (atype.eq."IMAG") then 
          let uv[kax] rg[ii] 
          let atext "Imaginary part (Janskys)" 
	  @ uv_ident
        else if (atype.eq."WEIGHT") then 
          let uv[kax] rg[iw] 
          let atext "Relative Weight" 
	  @ uv_ident
        else 
          say "E-UVPLOT,  Type not supported " 'atype' 
        endif 
        if (kax.eq.1) then 
          let xtext 'atext' 
        else if (kax.eq.2) then 
          let ytext 'atext' 
        endif 
      next 
      if (xtype.eq."U").and.(ytype.eq."V") then 
	if (nst.gt.1) then
          limits 450 -450 450 -450 
	  pen 0 /col 'mmm'-1
          point uvn[1] uvn[2] 
          limits -450 450 -450 450 
          point uvn[1] uvn[2] 
	  pen 0 /col 0
	  del /var uvn
	 else
          limits 450 -450 450 -450 
          point uv[1] uv[2] 
          limits -450 450 -450 450 
          point uv[1] uv[2] 
	endif
      else 
        greg1\limits 'alimits' /variable uv[1] uv[2] 
	if (nst.gt.1) then
	  pen 0 /col 'mmm'-1
	  point uvn[1] uvn[2]
	  pen 0 /col 0
	  del /var uvn
	 else
          point uv[1] uv[2] 
	endif
        @ p_errorbars.graphic 'g_dim[1]' 'iw' 
        if fit.ne." " then 
          if k.lt.10 then 
            let fitext 'fit'00'k' 
          else if k.lt.100 then 
            let fitext 'fit'0'k' 
          else 
            let fitext 'fit''k' 
          endif 
          let docurve .true. 
          on error let docurve .false. 
          col x 1 y 2 /file 'name'.'fitext' 
          on error 
          if docurve then 
            curve 
          endif 
        endif 
      endif 
      if i.eq.1.and.(k+n.gt.n2) then 
        box 
        label 'xtext' /x 
        label 'ytext' /y 
      else 
        box n n 
      endif 
      set coord box 
      let cmark 'xmark' 
      dra text 0.1 -0.1 'cmark' 3 /box 7 
     next
    endif 
  next 
next 
set expand 1.