!------------------------------------------------------------------------ 
! p_color.map
! Procedure to plot multiple contour maps of spectral line images 
! overlaid on the bitmap. 
! Global variables defined in DEFINE.GRAPHIC 
! Calls p_header.greg  (to plot header information) 
! and p_levels.greg    (to compute automatic contour levels) 
! S.Guilloteau 15-Oct-1992 
!------------------------------------------------------------------------ 
on error return 
! 
clear plot 
def real x2 dx y2 
def double xmark ratio 
def integer m n n1 n2 imark nmap nadd 
def character cmark*12 
def logical do_clean do_dirty do_coverage 
let do_clean beam_type.eq."CLEAN" 
let do_dirty beam_type.eq."DIRTY" 
let do_coverage extra.eq."COVERAGE" 
! 
!create directory <IMAG 
@ p_level.greg &1 
@ p_header.greg &1 
rgdata &1 /variable 
if size.eq.0 then 
  limits /rgdata 
else if (size.gt.0) then 
  limits size|2 -size|2 -size|2 size|2 seconds 
endif 
if (aspect.eq.0) then 
  let ratio abs((user_xmax-user_xmin)|(user_ymax-user_ymin)) 
else 
  let ratio aspect 
endif 
let x2 box_xmax 
let y2 box_ymax 
if first.eq.0 then 
  let n1 1 
else 
  let n1 first 
endif 
if last.eq.0 then 
  let n2 &1%dim[3] 
else 
  let n2 last 
endif 
let nmap n2-n1+1 
let nadd 0 
if (do_clean.or.do_dirty) then 
  let nadd nadd+1 
endif 
if (do_coverage) then 
  let nadd nadd+1 
endif 
if ratio.gt.1.d0 then           ! M > N 
  let m int(sqrt((nmap+nadd)*ratio+1)) 
  let n nint(m|ratio) 
  if (m*n.lt.(nmap+nadd)) then 
    let m = m+1 
    if (m*n.lt.(nmap+nadd)) then 
      let n n+1 
    endif 
  endif 
else 
  let n int(sqrt((nmap+nadd)|ratio+1)) 
  let m nint(n*ratio) 
  if (m*n.lt.(nmap+nadd)) then 
    let n = n+1 
    if (m*n.lt.(nmap+nadd)) then 
      let m m+1 
    endif 
  endif 
endif 
set expand min(6.0|(m+n),1.) 
let dx (x2-box_xmin)|n|ratio 
let dx min((y2-box_ymin)|m,dx) 
let k n1-1 /new integer 
! 
delete /variable mbox nbox ubox 
define integer mbox nbox /global 
let mbox m 
let nbox n 
define real ubox[5,nbox,mbox] /global 
for j 1 to m 
  for i 1 to n 
    gtvl\change directory <greg 
    gtvl\create directory p'i'-'j' 
    gtvl\change directory p'i'-'j' 
                                ! 
    let ubox[1,i,j] x2+(i-n-1)*dx*ratio 
    let ubox[2,i,j] x2+(i-n)*dx*ratio 
    let ubox[3,i,j] y2-j*dx 
    let ubox[4,i,j] y2+(1-j)*dx 
    set box x2+(i-n-1)*dx*ratio x2+(i-n)*dx*ratio y2-j*dx y2+(1-j)*dx 
    let k k+1 
    if ((k.gt.&1%dim[3]).or.(k.gt.n2)) then 
      let ubox[5,i,j] 0 
      if do_clean then 
        box n n /abs 
        ellipse 0.5*&1%major 0.5*&1%minor 90-180*&1%pa|pi /box dx|2 dx|2 
        draw text -0.2 0.2 "Clean Beam" 7 /box 3 
        let do_clean = .false. 
      else if do_dirty then 
        load beam 
        levels -0.5 to -0.1 by 0.1 0.1 to 0.5 by 0.1 
        rgdata &1 /var 
        if (do_bit) then 
          plot &1 
        endif 
        if (do_contour) then 
          rgmap quiet 
          box n n /abs 
        endif 
        draw text -0.2 0.2 "Dirty Beam" 7 /box 3 
        let do_dirty = .false. 
      else if do_coverage then 
        limits -300 300 -300 300 
        set expand 1.0 
        box p n 
        axis yr /label o 
        if file.eq."NEW" then   ! RL 17-JUL-1991 
                                !		VECTOR\TRANSPOSE 'NAME'.UVT 'NAME'.TUV 213 
        else 
          sic\sic search 'name'.tuv 
          if (.not.sic$exist) then 
                                !		    VECTOR\TRANSPOSE 'NAME'.UVT 'NAME'.TUV 213 
          endif 
        endif 
        define image uvt 'name'.tuv read 
        set expand min(3.|n,1.) 
        points uvt[1] uvt[2] 
        limits 300 -300 300 -300 
        points uvt[1] uvt[2] 
        draw text -0.2 0.2 "UV Coverage" 7 /box 3 
        let do_coverage = .false. 
        delete /variable uvt 
      else 
        set expand 1.0 
        gtvl\change dir <greg 
        return 
      endif 
    else 
      let ubox[5,i,j] 1.0*k 
      if (&1%ndim.le.2) then 
        rgdata &1 /variable 
      else if (&1%ndim.eq.3) then 
        rgdata &1[k] /variable 
      else 
        rgdata &1[k,1] /variable 
      endif 
                                ! Plot the RGDATA array... 
      if (do_bit) then 
        plot /scaling linear &1%min &1%max 
      endif 
                                ! Now the graphic 
      let xmark &1%convert[2,3]+(k-&1%convert[1,3])*&1%convert[3,3] 
      if (mark.eq."FREQUENCY") then 
        let imark nint((-(xmark-&1%veloff)*&1%restfre|299792.458+&1%restfre)*1e3) 
        let xmark 1d-6*xmark 
      else if (mark.eq."CHANNEL") then 
        let xmark 1.0*k 
      else 
        let mark "VELOCITY" 
        let imark nint(xmark*10.) 
        let xmark 1d-1*imark 
      endif 
      if (do_contour) then 
        if i.eq.1.and.(k+n.gt.n2) then 
          box /abs 
        else 
          box n n /abs 
        endif 
        rgmap quiet /abs 1.0 
      endif 
      set coord user 
      dra relo 0 1e-5 
      dra line 0 -1e-5 
      dra relo 1e-5 0 
      dra line -1e-5 0 
      set coord box 
      let cmark 'xmark' 
      dra text 0.1 -0.1 'cmark' 3 /box 7 
    endif 
  next 
next 
set expand 1.0 
define real last_box[4] 
let last_box[1] box_xmin 
let last_box[2] box_xmax 
let last_box[3] box_ymin 
let last_box[4] box_ymax 
gtvl\change dir <greg 
set box last_box[1] last_box[2] last_box[3] last_box[4]