!------------------------------------------------------------------------------
! these are astro-specific procedures called by x_newproject.
!------------------------------------------------------------------------------
begin procedure calibrators
   on error return
   define character psf*40
   if "&1?".eq."DEV?" then
      device xlandscape white
   endif
   observatory bure
   time
   @ create_catalog
   catalog 'proj'.sou
   if do_cal then
     catalog gag_astro:phase-pdb /alternate
     astro\source 'sourcename_1' 
     astro\frame eq ra|pi*12 dec|pi*180 45
     astro\source 'sourcename_1' /draw /sun
     greg1\set char 0.5 
     greg1\pencil 1 
     astro\source /draw f /alternate /flux 0.75 2.0 
     greg1\pencil 3 
     greg1\set char 0.6 
     astro\source /draw f /alternate /flux 2.0 50 
   endif
   greg1\pencil 0
   say   "calibrator" "dist." "flux" /format a22 a10 a10
   say   "----------" "-----" "----" /format a22 a10 a10
   for i 1 to calib_n
      say i 'calib_name[i]' calib_dist[i] calib_flux[i] -
             /format i2 a20 f10.3 f10.3
   next
   let psf 'proj'"-calibrators.ps" 
   sys "rm "'psf'
   hard 'psf'  /device  eps color
   let do_cal NO
end procedure calibrators
!------------------------------------------------------------------------------
begin procedure project_plot
   on error return
   define integer ir
   define character psf*40
   if "&2?".eq."DEV?" then
     device xlandscape white
   end if
   let ir &1
   if do_line then
      line /auto
      let do_line NO
   end if
   if line_c[ir].eq."*" then
      say "Receiver "'ir'" not used"
      return
   endif
   symb ssss 'line_f[ir]|1000 '" "'line_sb[ir]'" LOW 350 "'line_h[ir]'
   say "line" 'line_c[ir]' 'ssss'
   line 'line_c[ir]' 'ssss'
   delete /symbol ssss
   for i 1 to spec_n
      if spec_r[i].eq.ir then
         line /spectral 'i' 'spec_b[i]' 'spec_f[i]'
      endif
   next   
  let psf 'proj'"-receiver-"'ir'".ps" 
  sys "rm "'psf'
  hard 'psf'  /device  eps fast
end procedure project_plot
!------------------------------------------------------------------------------
begin procedure create_setup
   on error return
   define character text*80 
   @ calibrators
   @ project_plot 1 
   @ project_plot 2 
   sic user
   sic date
   sic out setup-'proj'.obs
   say "!---------------------------------------------------------------------"
   say "!   setup-"'proj'.obs
   say "!   Project setup created by " 'sys_info'  'sys_date'
   say "!   Sun Avoidance at" sun_limit " deg. limit: " 'sun_avoid' -
          /format a f5.1 a a
   say "!---------------------------------------------------------------------"
   say "set\end"
   say "@ pr:defaults"
   say "set\project "'proj'
   say "catalog phase inter_base:phase-newest.sou"
   say "catalog source "'proj'".sou"
   say "symbol go ""@ pr:observe-all "'proj'""""
   say "!"
   say "say ""project "'proj'" starting"""
   say "let receiver 2"
   say "let low_limit 15."
   say "!"
   say "symbol name " -
   """"'sourcename_1'" EQ 2000 "'ra2000_1' 'dec2000_1'" LSR "'vlsr_1'""""
   say "!"
   say "let n_sources "'n_sources'
   if (n_sources.gt.1) then                 !
      for i 1 to n_sources
         let text sourcename_'i' /format a80
         say "let name_source["'i'"] """'text'""""
         say "let n_scans_source["'i'"] .. ! fill in"
      next
   endif
   say "!"
   say "let n_subscans 60"
   say "let n_scans 20"
   say "!"
   say "let n_calibrators 2"
   say "let calibrator_1" 'calib_name[1]'
   say "let calibrator_2" 'calib_name[2]'
   say "let n_subs_cal 60"
   say "let n_scans_cal 2"
   say "!"
   say "let point_source_1" 'calib_name[1]'
   say "let point_source_2" 'calib_name[2]'
   say "!"
   say "let focus_source_1" 'calib_name[1]'
   say "let focus_source_2" 'calib_name[2]'
   say "!"
   say "let change_spectral .false."
   say "!"
   say "let n_mosaic "'nfield_1'
   if (nfield_1.gt.1) then   
      say "let x_mosaic[1:"'nfield_1'"] " 'xfield_1'
      say "let y_mosaic[1:"'nfield_1'"] " 'yfield_1'
      say "let t_mosaic[1:"'nfield_1'"] " 'tfield_1'
   endif
   say "!"
   for i 1 to 2
      if (line_c[i].ne."*") then
         say "line" 'line_c[i]' line_f[i]|1000 'line_sb[i]' -
         " low 350 " line_h[i]        /format a a13 f12.6 a4 a i3
      endif
   next
   say "!"
   for i 1 to 6
      say "spectral" i spec_b[i] spec_f[i] " /receiver " spec_r[i] -
          /format a i3 i4 f10.3 a i2
   next
   say "!"
   say "load /frequency"
   say "!"
   say "set show off"
   say "set\lock"
   say "!"
   say "type pr:clean.obs"
   say "!"
   say "! LSB-USB-DSB tunings are decided by the IRAM astronomer staff"
   say "! depending of the receiver properties"
   say "! "
   say "SAY ""Project "'proj'" Type: Mapping / Category: Dual frequency"""
   for i 1 to 2
      if (line_c[i].ne."*") then
         say "SAY """'proj'", Rec"'i'": " -
         "setup "'line_sb[i]'", tuning "'line_tun[i]'""""
      else
         say "SAY """'proj'", Rec"'i'": unused. """ 
      endif
   next
   say "SAY ""Frequency sent, receivers may be tuned """
   say "SAY ""Execute all observations by typing GO """ 
   say "!"
   say "let solve_point yes" 
   say "let solve_focus yes" 
   say "symbol proceed/inquire ""Type RETURN to remove this page"""
   say "set show on"
   sic out
end procedure create_setup 
!------------------------------------------------------------------------------
begin procedure create_catalog
   on error return
   define character sname*12 ra*16 dec*16 vlsr*10
   sic user
   sic date
   sic out 'proj'.sou
   say "!---------------------------------------------------------------------"
   say "!" 'proj'.sou
   say "!  Continuum project catalog created by " 'sys_info'  'sys_date'
   say "!---------------------------------------------------------------------"
   for i 1 to n_sources
      let sname sourcename_'i' /format a12
      let ra ra2000_'i' /format a15
      let dec dec2000_'i' /format a15
      let vlsr vlsr_'i' /format f10.3
      say 'sname' " EQ 2000 " 'ra' 'dec' " LSR " 'vlsr' -
        /format a12 a9 a16 a16 a5 a10
   next
   sic out
end procedure create_catalog