!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Original ideas from R.Lucas and R.Neri
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure fitheader
  !
  if (.not.do_header) return
  !
  on error return base
  def character text*120
  !
  ! Choose the header position and draw char
  let aspect_ratio no
  @ header_position
  @ window_xy 1 1 1
  greg1\box n n n
  !
  greg1\set expand 1.0
  let text 'name'.uvfit
  greg1\draw text .5 -1 'text' 6 /box 7
  !
  greg1\set expand 0.8
  let text "\\iSource:\\i "'&1%source'
  greg1\draw text .5 -2 'text' 6 /box 7
  !
  let text "\\iLine:\\i "'&1%line'
  greg1\draw text .5 -3 'text' 6 /box 7
  !
  let text "\\iFrequency:\\i "'1d-6*nint(&1%restfre*1000)'" GHz"
  greg1\draw text .5 -4 'text' 6 /box 7
  !
  if ((first.eq.0).and.(last.eq.0)) then
    if ((&2.eq.1).and.(&3.eq.&4)) then
      let text "\\iAll Channels"
    else
      let text "\\iFitted Channels: &2 to &3"
    endif
  else
    let text "\\iChannels:\\I "'first'" to "'last'
  endif
  greg1\draw text .5 -5 'text' 6 /box 7
  !
  if (uvf%mod.ne." ") then
    let text "\\iFitted model:\\i "'uvf%mod'
    greg1\draw text .5 -8 'text' 6 /box 7
  endif
  !
  sic date
  greg1\draw text 0.0 2.0 "'SYS_INFO'" 5 /box 2
  greg1\draw text 0.0 1.0 "'SYS_DATE'" 5 /box 2
  !
end procedure fitheader
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
gtvl\destroy all
@ window_tools.greg
!
let uvf%nx min(uvf%nx,size(uvf%xtype))
let uvf%ny min(uvf%ny,size(uvf%ytype))
!
define integer kx kmodel ex ky ey nchan i1 i2 ni nj iorder kc kz
define character xtext*30 ytext*30 ztext*30 atext*30 atype*8
!
define character fxtype*12[uvf%nx] fxrange_u*24[uvf%nx] fxrange_l*24[uvf%nx] dummy*12[3]
define character fytype*12[uvf%ny] fyrange_u*24[uvf%ny] fyrange_l*24[uvf%ny]
for ix 1 to uvf%nx
  symbol mytype 'uvf%xtype[ix]'
  let dummy 'mytype'
  let fxtype[ix] 'dummy[1]'
  let fxrange_l[ix] 'dummy[2]'
  let fxrange_u[ix] 'dummy[3]'
  delete /symbol mytype
next ix
for iy 1 to uvf%ny
  symbol mytype 'uvf%ytype[iy]'
  let dummy 'mytype'
  let fytype[iy] 'dummy[1]'
  let fyrange_l[iy] 'dummy[2]'
  let fyrange_u[iy] 'dummy[3]'
  delete /symbol mytype
next iy
delete /var dummy
!
define character*16 ActiveFit
!
if pro%narg.eq.0 then
  if exist(f) then
    delete /var f
  endif
  if (name.ne." ") then
    !
    ! This was a non-standard file type GILDAS_UVFIT until Feb 2009
    ! so turn off strict checking
    !
    define log define_strict
    let define_strict sic%define_strict
    let sic%define_strict no
    define image f 'name'.uvfit read /global
    let sic%define_strict define_strict
    !
    let ActiveFit f
  else
    say "No UV_FIT variable or data file"
    return error
  endif
else if exist(&1) then
  let ActiveFit &1
else
  say "No UV_FIT variable or data file"
  return error
endif
!
! The number of parameters has changed from mpin = 6 to 7
! and there is 3 + 2*mpin value per function
! plus 4 general columns
!
define integer nlength ilength
nlength = 'ActiveFit'%dim[2]-4
if (mod(nlength,15).eq.0) then
  ilength = 15 ! Old uvfit format
else if (mod(nlength,17).eq.0) then
  ilength = 17 ! New uvfit format
endif
let uvf%nf nlength/ilength
!
let nchan 'ActiveFit'%dim[1]
let i1 0
let i2 0
for ichan 1 to nchan
  if ('ActiveFit'[ichan,1].ne.0.and.i1.eq.0) then
    let i1 ichan
  endif
next ichan
for ichan nchan to 1 by -1
  if ('ActiveFit'[ichan,1].ne.0.and.i2.eq.0) then
    let i2 ichan
  endif
next ichan
let i1 max(first,i1)
if (last.eq.0) then
  let i2 min(nchan,i2)
else
  let i2 min(last,i2)
endif
!
greg1\set blanking 'ActiveFit'%blank[1] 'ActiveFit'%blank[1]*0.1
define real x[nchan] y[nchan] zx[nchan] zy[nchan] atmp
!
@ fitheader 'ActiveFit' 'i1' 'i2' 'nchan'
!
! Definition of box characteristics.
!
let aspect_ratio no  ! Do not respect aspect ratio to maximize use of place
let fixed_trc no     ! Top right corner is free
let inter 0.0 0.0    ! No interspace between individual boxes (unit: % of box sizes)
@ plot_position      ! Definition of total available plotting place
!
define integer nxybox[2]
let nxybox uvf%nx uvf%ny
@ find_size_margin 'nxybox[1]' 'nxybox[2]' ! Compute individual box size and margin needed to keep aspect
greg1\set expand min(6.0/(nxybox[1]+nxybox[2]),1.)
!
for fy 1 to uvf%ny
  let fytype[fy] 'fytype[fy]' /lower
  if (fytype[fy].eq."velo") then
    let ky 4
    let ey 0
    let ytext "Velocity (km/s)"
  else if (fytype[fy].eq."freq") then
    let ky -1
    let ey 0
    let ytext "Frequency (MHz)"
  else if (fytype[fy].eq."channel") then
    let ky 0
    let ey 0
    let ytext "Channel"
  else if (fytype[fy].eq."rms") then
    let ky 1
    let ey 0
    let ytext "r.m.s."
  else if (fytype[fy].eq."ra") then
    let ky 8
    let ey 9
    let ytext "R.A. Offset"
  else if (fytype[fy].eq."dec") then
    let ky 10
    let ey 11
    let ytext "Dec. offset"
  else if (fytype[fy].eq."flux") then
    let ky 12
    let ey 13
    let ytext "Flux"
  else if (fytype[fy].eq."width".and.kmodel.ge.3) then
    let ky 14
    let ey 15
    let ytext "Full width"
  else if (fytype[fy].eq."major".and.kmodel.eq.2) then
    let ky 14
    let ey 15
    let ytext "Major axis"
  else if (fytype[fy].eq."minor".and.kmodel.eq.2) then
    let ky 16
    let ey 17
    let ytext "Minor axis"
  else if (fytype[fy].eq."major".and.kmodel.eq.5) then
    let ky 14
    let ey 15
    let ytext "Outer Diameter"
  else if (fytype[fy].eq."minor".and.kmodel.eq.5) then
    let ky 16
    let ey 17
    let ytext "Inner Diameter"
  else if (fytype[fy].eq."angle".and.kmodel.eq.2) then
    let ky 18
    let ey 19
    let ytext "Position angle"
  else
    say "Unknown FYTYPE: " 'fytype[fy]'
    return
  endif
  for fx 1 to uvf%nx
    @ find_window_position 'fx' 'fy'
    let kmodel nint('ActiveFit'[i1,6])
    greg1\set mark 4 0 .2
    let fxtype[fx] 'fxtype[fx]' /lower
    if (fxtype[fx].eq."velo") then
      let kx 4
      let ex 0
      let xtext "Velocity (km/s)"
    else if (fxtype[fx].eq."freq") then
      let kx -1
      let ex 0
      let xtext "Frequency (MHz)"
    else if (fxtype[fx].eq."channel") then
      let kx 0
      let ex 0
      let xtext "Channel"
    else if (fxtype[fx].eq."rms") then
      let kx 1
      let ex 0
      let xtext "r.m.s."
    else if (fxtype[fx].eq."ra") then
      let kx 8
      let ex 9
      let xtext "R.A. Offset"
    else if (fxtype[fx].eq."dec") then
      let kx 10
      let ex 11
      let xtext "Dec. offset"
    else if (fxtype[fx].eq."flux") then
      let kx 12
      let ex 13
      let xtext "Flux (Jy)"
    else if (fxtype[fx].eq."width".and.kmodel.ge.3) then
      let kx 14
      let ex 15
      let xtext "Full width"
    else if (fxtype[fx].eq."major".and.kmodel.eq.2) then
      let kx 14
      let ex 15
      let xtext "Major axis"
    else if (fxtype[fx].eq."minor".and.kmodel.eq.2) then
      let kx 16
      let ex 17
      let xtext "Minor axis"
    else if (fxtype[fx].eq."angle".and.kmodel.eq.2) then
      let kx 18
      let ex 19
      let xtext "Position angle"
    else
      say "Unknown FXTYPE: " 'fxtype[fx]'
      return
    endif
    let y 'ActiveFit'%blank[1]
    greg1\set blank 'ActiveFit'%blank[1] 'ActiveFit'%blank[2]
    !
    for iplot 1 to uvf%np
      let iorder uvf%order[iplot]
      for ichan i1 to i2
        if (ky.gt.4) then
          let kc ky+(iorder-1)*ilength
          let y[ichan] 'ActiveFit'[ichan,kc]
        else if (ky.gt.0) then
          let y[ichan] 'ActiveFit'[ichan,ky]
        else if (ky.eq.0) then
          let y[ichan] ichan
        else if (ky.eq.-1) then
          let y[ichan] -('ActiveFit'[ichan,4]-'ActiveFit'%veloff)*'ActiveFit'%restfre/299792.458+'ActiveFit'%restfre
        endif
        if (kx.gt.4) then
          let kc kx+(iorder-1)*ilength
          let x[ichan] 'ActiveFit'[ichan,kc]
        else if (kx.gt.0) then
          let x[ichan] 'ActiveFit'[ichan,kx]
        else if (kx.eq.0) then
          let x[ichan] ichan
        else if (kx.eq.-1) then
          let x[ichan] -('ActiveFit'[ichan,4]-'ActiveFit'%veloff)*'ActiveFit'%restfre/299792.458+'ActiveFit'%restfre
        endif
!        if (kz.gt.4) then
!          let kc kz+(iorder-1)*ilength
!          let z[ichan] 'ActiveFit'[ichan,kc]
!        else if (kz.gt.0) then
!          let z[ichan] 'ActiveFit'[ichan,kz]
!        else if (kz.eq.0) then
!          let z[ichan] ichan
!        else if (kz.eq.-1) then
!          let z[ichan] -('ActiveFit'[ichan,4]-'ActiveFit'%veloff)*'ActiveFit'%restfre/299792.458+'ActiveFit'%restfre
!        endif
      next ichan
      !
      if (ex.ne.0) then
        let kc ex+(iorder-1)*ilength
        let zx 'ActiveFit'[kc] 
      else
        let zx abs(x)
        compute atmp max zx /blank 'ActiveFit'%blank[1] 'ActiveFit'%blank[2]
        if atmp.eq.0 let atmp 5
        let zx 0.05*atmp
      endif
      if (ey.ne.0) then
        let kc ey+(iorder-1)*ilength
        let zy 'ActiveFit'[kc] 
      else
        let zy abs(y)
        compute atmp max zy /blank 'ActiveFit'%blank[1] 'ActiveFit'%blank[2]
        if atmp.eq.0 let atmp 5
        let zy 0.05*atmp
      endif
      !
      if (iplot.eq.1) then
        if (nchan.le.1) then
          atmp = 1.5*abs(zx[1])
          if (fxrange_l[fx].eq."*") let fxrange_l[fx] 'x[1]-atmp'
          if (fxrange_u[fx].eq."*") let fxrange_u[fx] 'x[1]+atmp'        
          atmp = 1.5*abs(zy[1])
          if (fyrange_l[fy].eq."*") let fyrange_l[fy] 'y[1]-atmp'
          if (fyrange_u[fy].eq."*") let fyrange_u[fy] 'y[1]+atmp'        
          greg1\limits 'fxrange_l[fx]' 'fxrange_u[fx]'  'fyrange_l[fy]' 'fyrange_u[fy]'
        else
          symbol mylimits 'fxrange_l[fx]'" "'fxrange_u[fx]'" "'fyrange_l[fy]'" "'fyrange_u[fy]'
          greg1\limits 'mylimits'
          delete /symbol mylimits
        endif
      endif
      greg1\pencil iplot
      if (uvf%bars) then
        if (ex.ne.0) then
          greg1\errorbar x x y zx
        endif
        if (ey.ne.0) then
          greg1\errorbar y x y zy 
        endif
      endif
      greg1\points
      greg1\connect
    next iplot
    !
    ! draw box and labels
    greg1\pencil 0
    if (fx.eq.1.and.fy.eq.1) then
      greg1\box
      greg1\label 'ytext' /y
      greg1\label 'xtext' /x
    else if (fx.eq.1) then
      greg1\box n o
      greg1\label 'ytext' /y
    else if (fy.eq.1) then
      greg1\box p n
      greg1\label 'xtext' /x
    else
      greg1\box n n
    endif
  next fx
next fy
!
if (ActiveFit.eq."f") delete /var 'ActiveFit'
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
