!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Original ideas from R.Lucas and R.Neri
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure fitheader
  !
  if (.not.do_header) then
     return
  endif
  !
  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 "'f%source'
  greg1\draw text .5 -2 'text' 6 /box 7
  !
  let text "\\iLine:\\i "'f%line'
  greg1\draw text .5 -3 'text' 6 /box 7
  !
  let text "\\iFrequency:\\i "'1d-6*nint(f%restfre*1000)'" GHz"
  greg1\draw text .5 -4 'text' 6 /box 7
  !
  if ((first.eq.0).and.(last.eq.0)) then
     if ((&1.eq.1).and.(&2.eq.&3)) then
        let text "\\iAll Channels"
     else
        let text "\\iFitted Channels: &1 to &2"
     endif
  else
     let text "\\iChannels:\\I "'first'" to "'last'
  endif
  greg1\draw text .5 -5 'text' 6 /box 7
  !
  if (uvfit%mod.ne." ") then
     let text "\\iFitted model:\\i "'uvfit%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
gtvl\clear alpha
@ window_tools.greg
!
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
!!$if .not.exist(fztype) then
!!$   define character fztype*20 /global
!!$   def real r0 z0 /global
!!$   let z0 1
!!$   let r0 1
!!$endif
!
define character fxtype*12[uvfit%nx] fxrange*24[uvfit%nx] dummy*12[3]
define character fytype*12[uvfit%ny] fyrange*24[uvfit%ny]
for ix 1 to uvfit%nx
   symbol mytype 'uvfit%xtype[ix]'
   let dummy 'mytype'
   let fxtype[ix] 'dummy[1]'
   let fxrange[ix] 'dummy[2]'" "'dummy[3]'
   delete /symbol mytype
next ix
for iy 1 to uvfit%ny
   symbol mytype 'uvfit%ytype[iy]'
   let dummy 'mytype'
   let fytype[iy] 'dummy[1]'
   let fyrange[iy] 'dummy[2]'" "'dummy[3]'
   delete /symbol mytype
next iy
delete /var dummy
!
if (name.eq." ") then
   say "Please enter name of uvfit file (without extension)"
   let name
endif
if exist(f) then
   delete /var f
endif
!
! 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
!
! 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 = f%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
exa ILENGTH
!
let nchan f%dim[1]
let i1 0
let i2 0
for ichan 1 to nchan
   if (f[ichan,1].ne.0.and.i1.eq.0) then
      let i1 ichan
   endif
next ichan
for ichan nchan to 1 by -1
   if (f[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 f%blank[1] f%blank[1]*0.1
define real x[nchan] y[nchan] z[nchan]
!
@ fitheader '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 uvfit%nx uvfit%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.)
!
!!$let fztype 'fztype' /lower
!!$if (fztype.eq."rms") then
!!$   let kz 1
!!$   let ztext "r.m.s."
!!$else if (fztype.eq."flux") then
!!$   let kz 12
!!$   let ztext "Flux"
!!$else if (fztype.eq."width".and.kmodel.ge.3) then
!!$   let kz 14
!!$   let ztext "Full width"
!!$else if (fztype.eq."major".and.kmodel.eq.2) then
!!$   let kz 14
!!$   let ztext "Major axis"
!!$else if (fztype.eq."minor".and.kmodel.eq.2) then
!!$   let kz 16
!!$   let ztext "Minor axis"
!!$endif
!
for fy 1 to uvfit%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 uvfit%nx
      @ find_window_position 'fx' 'fy'
      let kmodel nint(f[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 f%blank[1]
      greg1\set blank f%blank[1] f%blank[2]
      !
      for iplot 1 to uvfit%np
         let iorder uvfit%order[iplot]
         for ichan i1 to i2
            if (ky.gt.4) then
               let kc ky+(iorder-1)*ilength
               let y[ichan] f[ichan,kc]
            else if (ky.gt.0) then
               let y[ichan] f[ichan,ky]
            else if (ky.eq.0) then
               let y[ichan] ichan
            else if (ky.eq.-1) then
               let y[ichan] -(f[ichan,4]-f%veloff)*f%restfre/299792.458+f%restfre
            endif
            if (kx.gt.4) then
               let kc kx+(iorder-1)*ilength
               let x[ichan] f[ichan,kc]
            else if (kx.gt.0) then
               let x[ichan] f[ichan,kx]
            else if (kx.eq.0) then
               let x[ichan] ichan
            else if (kx.eq.-1) then
               let x[ichan] -(f[ichan,4]-f%veloff)*f%restfre/299792.458+f%restfre
            endif
            if (kz.gt.4) then
               let kc kz+(iorder-1)*ilength
               let z[ichan] f[ichan,kc]
            else if (kz.gt.0) then
               let z[ichan] f[ichan,kz]
            else if (kz.eq.0) then
               let z[ichan] ichan
            else if (kz.eq.-1) then
               let z[ichan] -(f[ichan,4]-f%veloff)*f%restfre/299792.458+f%restfre
            endif
         next ichan
         if (iplot.eq.1) then
            symbol mylimits 'fxrange[fx]'" "'fyrange[fy]'
            greg1\limits 'mylimits'
            delete /symbol mylimits
         endif
         greg1\pencil iplot
         if (uvfit%bars) then
            if (ex.ne.0) then
               let kc ex+(iorder-1)*ilength
               greg1\errorbar x x y f[kc]
            endif
            if (ey.ne.0) then
               let kc ey+(iorder-1)*ilength
               greg1\errorbar y x y f[kc]
            endif
         endif
!!$         if (fztype.ne." ") then
!!$            for ichan i1 to i2 by step
!!$               if (abs(z[ichan]).gt.z0) then
!!$                  draw text x[ichan] y[ichan] '0.1*nint(10.*f[ichan,4])' 9 /user
!!$                  ellipse r0*sqrt(abs(z[ichan]/z0)) /user x[ichan] y[ichan]
!!$               endif
!!$            next ichan
!!$         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
!
delete /var f
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
