!------------------------------------------------------------------------ 
! P_ARRAY.MAP 
! 
! Plot array configurations fro .cfg files
!
! Derived from a eneral Procedure to plot multiple contour maps 
! of spectral line images 
!
! Extra Option
!	DO_ARRAY        plot array configuration
! Basic	Options:	
!	DO_CONTOUR	do/not draw contours 
!	DO_BIT		do/not plot bitmap 
!	DO_NICE		do/not make a nice truncation for beam 
!	DO_MASK		do/not mask some part for text 
! 
! Global variables defined in DEFINE.MAP 
! 
! Calls 
!	P_LOAD.GREG    (to load images) 
!       P_HEADER.GREG  (to plot header information) 
!       P_LEVELS.GREG  (to compute automatic contour levels) 
!       P_SCALE.GREG   (to compute scaling for bitmaps) 
!       P_BEAM.GREG    (to plot the clean beam, if any) 
!
!------------------------------------------------------------------------ 
sic copy 'array'-'config'.cfg configuration.cfg
destroy all
def real x2 dx y2 aamin aamax xm ym
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 do_array
let do_clean beam_type.eq."CLEAN" 
let do_dirty beam_type.eq."DIRTY" 
let do_coverage uvrange.ne.0
let do_array yes
! 
on error return 
sic\@ p_load.greg aaa        ! Load image & compute extrema if needed 
! 
sic\@ p_level.greg aaa       ! Compute levels 
sic\@ p_scale.greg aaa       ! Compute scaling 
sic\@ p_header.greg aaa      ! Draw header 
sic\if do_color then 
  sic\@ p_color.greg      ! Setup nice colour table 
endif 
! 
rgdata aaa /variable 
if (aaa%angle.ne.0) then 
  symbol option "/UNIT SEC" 
else 
  symbol option "/ABSOLUTE" 
endif 
if size[1].eq.0 then 
  limits /rgdata 
else if (size[1].gt.0) then 
  limits size[1]|2 -size[1]|2 -size[1]|2 size[1]|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 box_aspect ratio 
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 aaa%dim[3] 
else 
  let n2 last 
endif 
let nmap n2-n1+1 
let nadd 0
if (do_array) then
  let nadd nadd+1  ! Add array layout 
endif
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) 
! 
delete /variable mbox nbox ubox 
define integer mbox nbox /global 
define integer k istep 
if (step.lt.0) then 
  let istep -1 
  let k n2+1 
else 
  let istep 1 
  let k n1-1 
endif 
let mbox m 
let nbox n 
define real ubox[5,nbox,mbox] /global 
on error break 
for j 1 to m 
  for i 1 to n 
    if (do_tree) then 
      gtvl\change directory <greg 
      gtvl\create directory p'i'-'j' 
      gtvl\change directory p'i'-'j' 
    endif 
                                ! 
    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+istep 
    if ((k.gt.aaa%dim[3]).or.(k.gt.n2).or.(k.lt.n1)) then 
      let ubox[5,i,j] 0 
      if do_clean then 
        box n n 'option' 
        ellipse 0.5*aaa%major 0.5*aaa%minor 90-180*aaa%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 
                                ! Plot the beam 
        define image lob 'name'.beam read 
        levels -0.5 to -0.1 by 0.1 0.1 to 0.5 by 0.1 
        rgdata lob /var 
        if (do_bit) then 
          plot lob /scaling linear -0.5 1.0 
        endif 
        if (do_contour) then 
          rgmap quiet 
        endif 
        box n n 'option' 
        draw text -0.2 0.2 "Dirty Beam" 7 /box 3 
        let do_dirty = .false. 
        delete /var lob 
      else if do_coverage then 
        limits -uvrange uvrange -uvrange uvrange
        box p n 
        axis yr /label o 
                                ! 
                                ! Check dates 
        define integer uvt__date tuv__date 
        compute uvt__date date 'name'.uvt 
	define character ctest*40
        let ctest 'name'.tuv 
        if (file(ctest)) then 
          compute tuv__date date 'name'.tuv 
        else 
          let tuv__date = -1 
        endif 
        delete /var ctest
        if (tuv__date.le.uvt__date) then 
          vector\transpose 'name'.uvt 'name'.tuv 21
        endif 
        define uvtable uvt 'name'.tuv read 
        set expand min(3.|n,1.) 
        points uvt[1] uvt[2] 
        limits uvrange -uvrange uvrange -uvrange
        points uvt[1] uvt[2] 
        draw text -0.2 0.2 "UV Coverage" 7 /box 3 
        let do_coverage = .false. 
        delete /variable uvt uvt__date tuv__date 
      else if do_array then
	col x 6 y 7 z 1 /file configuration.cfg
	compute xm max x
	compute ym max y
	let ym max(xm,ym)
	compute xm min x
	let xm -xm
	let ym max(xm,ym)
	compute xm min y
	let xm -xm
	let ym 1.2*max(xm,ym)
	limi -ym ym -ym ym
	box n n
	axis xl
	axis yl
	axis yr 
	for ii 1 to nxy
	   ellipse 6.0 /user x[ii] y[ii]
	next
!	value
	let do_array no
      else 
        set expand 1.0 
        change directory <greg 
        return 
      endif 
    else 
      let ubox[5,i,j] 1.0*k 
      if (aaa%ndim.le.2) then 
        rgdata aaa /variable 
      else if (aaa%ndim.eq.3) then 
        rgdata aaa[k] /variable 
      else 
        rgdata aaa[k,1] /variable 
      endif 
      if (do_bit) then          ! Plot the RGDATA array... 
        plot /scaling linear true_scale[1] true_scale[2] 
      endif 
      if (do_grey) then 
        rgmap quiet /abs 1.0 /grey 
      endif 
                                ! Now the graphic 
      let xmark aaa%convert[2,3]+(k-aaa%convert[1,3])*aaa%convert[3,3] 
      if (mark.eq."FREQUENCY") then 
        let imark nint((-(xmark-aaa%veloff)*aaa%restfre|299792.458+aaa%restfre)*1e3) 
        let xmark 1d-6*imark 
      else if (mark.eq."CHANNEL") then 
        let xmark 1.0*k 
      else 
        if (mark.ne."NONE") then 
          let mark "VELOCITY" 
          let imark nint(xmark*100.) 
          let xmark 1d-2*imark 
        endif 
      endif 
      if (do_contour) then 
        rgmap quiet /abs 1.0 
      endif 
      if (cross.ne.0) then 
        dra relo 0 cross*sec /user 
        dra line 0 -cross*sec /user 
        dra relo cross*sec 0 /user 
        dra line -cross*sec 0 /user 
      endif 
      if (do_nice) then 
        @ p_beam.greg aaa 
      endif 
      if i.eq.1 then ! .and.(j.eq.m) then               !  K+N.GT.N2) THEN 
        box 'option' 
      else 
        box n n 'option' 
      endif 
      if (exist(do_mask)) then 
        if (do_mask) then 
          @ p_mask.greg 7 0.3 0.15 
        endif 
      endif 
      set coord box 
      let cmark 'xmark' 
      if (mark.ne."NONE") then 
        dra text 0.2 -0.1 'cmark' 3 /box 7 
      endif 
    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 
change directory <greg 
set box last_box[1] last_box[2] last_box[3] last_box[4] 

