!-----------------------------------------------------------------------
! Support file for loading and plotting the Tsys and opacity tables
! created by command NOEMAOFFLINE\TSYS.
!
! Public procedures are:
!
!   @ noema-continuum-table-load
!     Load the Tsys binary table (name found in logical name
!     GAG_NOEMA_CONTINUUM) in memory in structure noema%cont%tab%
!
!   @ noema-continuum-table-dump  ASCIITableName
!     Dump the structure noema%continuum%tab% to ASCII file (for debugging only)
!
!   @ noema-continuum-table-plot [/MIN] [/AVERAGE] [/MAX]
!     Plot the content of the noema%cont%tab% structure. The plot adapts
!     itself to the current plot page (portrait|landscape|other).
!     Optionally plot the min, average, max Tsys if present (plot all 3
!     if absent).
!
!   @ noema-continuum-table-interpolate W|S Freq Water Elevation
!     Interpolate Tsys from table and save result in noema%cont%done%
!
!-----------------------------------------------------------------------
!
begin procedure define-struct-continuum
  !
  if .not.exist(noema) then
    define structure noema                  /global
  endif
  if exist(noema%cont) then
    delete /var noema%cont
  endif
  !
  define structure noema%cont                /global
  define structure noema%cont%tab            /global
  define char*64   noema%cont%tab%file       /global
  define integer   noema%cont%tab%version    /global
  define real      noema%cont%tab%pressure   /global
  define real      noema%cont%tab%gaini      /global
  define integer   noema%cont%tab%nelem      /global
  define integer   noema%cont%tab%nlof       /global
  define integer   noema%cont%tab%nairmass   /global
  define integer   noema%cont%tab%nwater     /global
  define integer   noema%cont%tab%ntemp      /global
  !
  define structure noema%cont%done           /global
  define integer   noema%cont%done%iwater    /global
  define real      noema%cont%done%airmass   /global
  define real      noema%cont%done%tsys_min  /global
  define real      noema%cont%done%tsys_aver /global
  define real      noema%cont%done%tsys_max  /global
  !
end procedure define-struct-continuum
!
begin procedure exa0-to-file
  !---------------------------------------------------------------------
  !   Same as EXAMINE command, except that it can be redirected to a
  ! file if SIC OUTPUT was used before.
  !   Generic engine which takes a 1D flattened array as argument.
  !---------------------------------------------------------------------
  define integer n1 ncol
  let n1 'pro%arg[2]'
  let ncol 'pro%arg[3]'
  define alias array 'pro%arg[1]'
  !
  if ncol.eq.3 then
    define integer i j k
    for i1 1 to n1 by ncol
      let i i1
      let j i1+1
      let k i1+2
      if k.le.n1 then
        say 'array[i]' 'array[j]' 'array[k]' -
          /format 1pg14.7 1pg14.7 1pg14.7
      else if j.eq.n1 then
        say 'array[i]' 'array[j]' -
          /format 1pg14.7 1pg14.7
      else if i.eq.n1 then
        say 'array[i]' -
          /format 1pg14.7
      endif
    next i1
  else
    define integer i j k l m
    for i1 1 to n1 by 5
      let i i1
      let j i1+1
      let k i1+2
      let l i1+3
      let m i1+4
      if m.le.n1 then
        say 'array[i]' 'array[j]' 'array[k]' 'array[l]' 'array[m]' -
          /format 1pg14.7 1pg14.7 1pg14.7 1pg14.7 1pg14.7
      else if l.eq.n1 then
        say 'array[i]' 'array[j]' 'array[k]' 'array[l]' -
          /format 1pg14.7 1pg14.7 1pg14.7 1pg14.7
      else if k.eq.n1 then
        say 'array[i]' 'array[j]' 'array[k]' -
          /format 1pg14.7 1pg14.7 1pg14.7
      else if j.eq.n1 then
        say 'array[i]' 'array[j]' -
          /format 1pg14.7 1pg14.7
      else if i.eq.n1 then
        say 'array[i]' -
          /format 1pg14.7
      endif
    next i1
  endif
  !
  delete /var array
end procedure exa0-to-file
!
begin procedure exa1-to-file
  !---------------------------------------------------------------------
  !   Same as EXAMINE command, except that it can be redirected to a
  ! file if SIC OUTPUT was used before.
  !   1D version
  !---------------------------------------------------------------------
  define integer n1
  let n1 'pro%arg[2]'
  say ""
  say 'pro%arg[1]'" is a real array of dimension "'n1'
  @ exa0-to-file 'pro%arg[1]' 'pro%arg[2]' 5
end procedure exa1-to-file
!
begin procedure exa5-to-file
  !---------------------------------------------------------------------
  !   Same as EXAMINE command, except that it can be redirected to a
  ! file if SIC OUTPUT was used before.
  !   5D version
  !---------------------------------------------------------------------
  define integer n1 n2 n3 n4 n5
  let n1 'pro%arg[2]'
  let n2 'pro%arg[3]'
  let n3 'pro%arg[4]'
  let n4 'pro%arg[5]'
  let n5 'pro%arg[6]'
  say ""
  say 'pro%arg[1]'" is a real array of dimension "'n1'" "'n2'" "'n3'" "'n4'" "'n5'
  !
  ! Can not define a 1D-reshaped alias. Use a copy instead...
  define integer nt
  let nt n1*n2*n3*n4*n5
  define real array5[nt] /global
  let array5 'pro%arg[1]'
  @ exa0-to-file array5 'nt' 3
  delete /var array5
end procedure exa5-to-file
!
begin procedure noema-continuum-table-load
  !---------------------------------------------------------------------
  ! Load the whole continuum table in memory in the structure
  ! "noema%cont%tab%"
  ! Arguments:
  !  Table file name (optional, default is logical `gag_noema_tsys`)
  !---------------------------------------------------------------------
  !
  @ define-struct-continuum
  if pro%narg.ge.1 then
    let noema%cont%tab%file 'pro%arg[1]'
  else
    let noema%cont%tab%file `gag_noema_continuum`
  endif
  define integer nskip
  let nskip 1
  !
  ! Read version
  accept noema%cont%tab%version /bin 'noema%cont%tab%file' 'nskip*4'
  let nskip nskip+1
  !
  ! Read context
  define real params[2]
  accept params /bin 'noema%cont%tab%file' 'nskip*4'
  let noema%cont%tab%pressure params[1]
  let noema%cont%tab%gaini params[2]
  let nskip nskip+2
  !
  ! Read dimensions
  define integer n[5]
  accept n /bin 'noema%cont%tab%file' 'nskip*4'
  let noema%cont%tab%nelem n[1]
  let noema%cont%tab%nlof n[2]
  let noema%cont%tab%nairmass n[3]
  let noema%cont%tab%nwater n[4]
  let noema%cont%tab%ntemp n[5]
  let nskip nskip+5
  !
  define real noema%cont%tab%lof[noema%cont%tab%nlof] -
              noema%cont%tab%airmass[noema%cont%tab%nairmass] -
              noema%cont%tab%water[noema%cont%tab%nwater] -
              noema%cont%tab%temp[noema%cont%tab%ntemp] -
              noema%cont%tab%trec[noema%cont%tab%nlof] -
              noema%cont%tab%feff[noema%cont%tab%nlof] /global
  ! Read frequencies
  accept noema%cont%tab%lof /bin 'noema%cont%tab%file' 'nskip*4'
  let nskip nskip+noema%cont%tab%nlof
  ! Read airmasses
  accept noema%cont%tab%airmass /bin 'noema%cont%tab%file' 'nskip*4'
  let nskip nskip+noema%cont%tab%nairmass
  ! Read waters
  accept noema%cont%tab%water /bin 'noema%cont%tab%file' 'nskip*4'
  let nskip nskip+noema%cont%tab%nwater
  ! Read temperatures
  accept noema%cont%tab%temp /bin 'noema%cont%tab%file' 'nskip*4'
  let nskip nskip+noema%cont%tab%ntemp
  ! Read Trec
  accept noema%cont%tab%trec /bin 'noema%cont%tab%file' 'nskip*4'
  let nskip nskip+noema%cont%tab%nlof
  ! Read Feff
  accept noema%cont%tab%feff /bin 'noema%cont%tab%file' 'nskip*4'
  let nskip nskip+noema%cont%tab%nlof
  !
  ! Read Tsys
  define real noema%cont%tab%tsys[noema%cont%tab%nelem,noema%cont%tab%nlof,noema%cont%tab%nairmass,noema%cont%tab%nwater,noema%cont%tab%ntemp] /global
  accept noema%cont%tab%tsys /bin 'noema%cont%tab%file' 'nskip*4'
  !
end procedure noema-continuum-table-load
!
begin procedure noema-continuum-table-water
  !---------------------------------------------------------------------
  ! Find the water index according to input pwv (mm). Result is stored
  ! in noema%cont%done%iwater
  !  Arguments:
  !   pro%arg[1]: Water vapour [mm] (must be on grid)
  !---------------------------------------------------------------------
  !
  define real water
  let water 'pro%arg[1]'
  !
  define integer wloca[2]
  compute wloca location noema%cont%tab%water water
  !
  ! Water: no interpolation, the exact value must be found
  define integer iwater1 iwater2
  let iwater1 wloca[1]
  let iwater2 wloca[2]
  if abs(noema%cont%tab%water[iwater1]-water).lt.1e-5 then
    let noema%cont%done%iwater iwater1
  else if abs(noema%cont%tab%water[iwater2]-water).lt.1e-5 then
    let noema%cont%done%iwater iwater2
  else
    message e noema-continuum-table-interpolate "Water value "''" not found in table"
    return base
  endif
  !
end procedure noema-continuum-table-water
!
begin procedure noema-continuum-table-dump
  !---------------------------------------------------------------------
  ! Dump the contents of the structure "noema%cont%tab%" to the named
  ! ASCII file.
  ! Arguments:
  !   pro%arg[1]: output file name
  !---------------------------------------------------------------------
  !
  if pro%narg.ne.1 then
    message e noema-tsys-table "Missing output ASCII table name as argument"
    return base
  endif
  !
  sic output 'pro%arg[1]' new
  !
  ! Dump version
  say "Version = "'noema%cont%tab%version'
  say ""
  !
  ! Dump context
  say "Pressure = "'noema%cont%tab%pressure'
  say "Image gain = "'noema%cont%tab%gaini'
  say ""
  !
  ! Dump dimensions
  say "Nelem = "'noema%cont%tab%nelem'
  say "nlof = "'noema%cont%tab%nlof'
  say "Nairmass = "'noema%cont%tab%nairmass'
  say "Nwater = "'noema%cont%tab%nwater'
  say "Ntemp = "'noema%cont%tab%ntemp'
  !
  ! Dump vectors
  @ exa1-to-file noema%cont%tab%lof     noema%cont%tab%nlof
  @ exa1-to-file noema%cont%tab%airmass noema%cont%tab%nairmass
  @ exa1-to-file noema%cont%tab%water   noema%cont%tab%nwater
  @ exa1-to-file noema%cont%tab%temp    noema%cont%tab%ntemp
  @ exa1-to-file noema%cont%tab%trec    noema%cont%tab%nlof
  @ exa1-to-file noema%cont%tab%feff    noema%cont%tab%nlof
  !
  ! Dump data
  @ exa5-to-file noema%cont%tab%tsys noema%cont%tab%nelem noema%cont%tab%nlof -
    noema%cont%tab%nairmass noema%cont%tab%nwater noema%cont%tab%ntemp
  !
  sic output
  !
end procedure noema-continuum-table-dump
!
begin procedure noema-continuum-table-plot
  !---------------------------------------------------------------------
  ! Plot the contents of the noema%cont%tab% structure
  !---------------------------------------------------------------------
  !
  ! Parsing
  sic\parse /min /average /max
  define logical domin doaver domax
  let domin  pro%parse%min%narg.ge.0
  let doaver pro%parse%average%narg.ge.0
  let domax  pro%parse%max%narg.ge.0
  if (.not.domin).and.(.not.doaver).and.(.not.domax) then
    let domin yes
    let doaver yes
    let domax yes
  endif
  !
  g\clear
  g\set mark 4 1 0.06 45
  g\set char 0.45
  g\tickspace 0. 0. 0. 0.
  !
  ! Grey out the regions out-of-bands
  g\set box_loc box_xmin box_xmax 'page_y*0.07' 'page_y*0.93'
  g\limits noema%cont%tab%lof[1]  noema%cont%tab%lof[noema%cont%tab%nlof] -
           0                      1                                       -
           /margin 5 10 0 0
  define real b1min b1max b2min b2max b3min b3max  ! Band limits
  let b1min 82
  let b1max 110
  let b2min 136
  let b2max 172
  let b3min 208
  let b3max 268
  g\pen /col grey
  define real poly[4,2]
  let poly[,1] user_xmin b1min b1min user_xmin
  let poly[,2] user_ymin user_ymin user_ymax user_ymax
  g\poly poly /var /hatch /plot
  let poly[,1] b1max b2min b2min b1max
  let poly[,2] user_ymin user_ymin user_ymax user_ymax
  g\poly poly /var /hatch /plot
  let poly[,1] b2max b3min b3min b2max
  let poly[,2] user_ymin user_ymin user_ymax user_ymax
  g\poly poly /var /hatch /plot
  let poly[,1] b3max user_xmax user_xmax b3max
  let poly[,2] user_ymin user_ymin user_ymax user_ymax
  g\poly poly /var /hatch /plot
  g\pen /col foreground
  !
  ! Trec box
  define real tmin tmax
  compute tmin min noema%cont%tab%trec /blank 1e4
  compute tmax max noema%cont%tab%trec /blank 1e4
  g\set box_loc box_xmin box_xmax 'page_y*0.07' 'page_y*0.20'
  g\limits noema%cont%tab%lof[1]  noema%cont%tab%lof[noema%cont%tab%nlof] -
           tmin                   tmax                                    -
           /margin 5 10 30 30
  g\box
  g\label "LO Frequency [GHz]" /X
  g\label "Trec [K]"   /Y
  g\pen /col web_green
  g\point noema%cont%tab%lof noema%cont%tab%trec
  g\pen /col foreground
  !
  ! Feff box
  g\set box_loc box_xmin box_xmax 'page_y*0.20' 'page_y*0.33'
  g\limits noema%cont%tab%lof[1]  noema%cont%tab%lof[noema%cont%tab%nlof] -
           noema%cont%tab%feff[1] noema%cont%tab%feff[noema%cont%tab%nlof] -
           /rev y /margin 5 10 30 30
  g\box n o
  g\label "Feff"   /Y
  g\pen /col magenta
  g\point noema%cont%tab%lof noema%cont%tab%feff
  g\pen /col foreground
  !
  ! Tsys box
  g\set box_loc box_xmin box_xmax 'page_y*0.33' 'page_y*0.93'
  define real ymin ymax
  let ymin 50
  let ymax 300
  g\limits noema%cont%tab%lof[1] noema%cont%tab%lof[noema%cont%tab%nlof] -
           ymin ymax -
           /margin 5 10 0 0
  g\box n o
  g\label "Continuum Tsys [K]" /Y
  define integer iairmass itemperature iwater
  let iairmass 2
  let itemperature 2
  let iwater 2
  let noema%cont%tab%tsys -1000.0 /where noema%cont%tab%tsys.gt.1e5
  g\set blank -1000 0
  if domin then
    g\pen /col blue
    g\connect noema%cont%tab%lof noema%cont%tab%tsys[1,,iairmass,iwater,itemperature]
  endif
  if doaver then
    g\pen /col dark_orange
    g\connect noema%cont%tab%lof noema%cont%tab%tsys[2,,iairmass,iwater,itemperature]
  endif
  if domax then
    g\pen /col red
    g\connect noema%cont%tab%lof noema%cont%tab%tsys[3,,iairmass,iwater,itemperature]
  endif
  g\pen /col foreground
!   g\draw text noema%cont%tab%lof[noema%cont%tab%nfreq] -
!               noema%cont%tab%tsys[noema%cont%tab%nfreq,iairmass,iwater,1] -
!               " "'noema%cont%tab%water[iwater]'" mm" 6 /user
  !
  ! Legend
  define character*16 val val2
  define real ypos
  let ypos 0
  !
  let ypos ypos+0.7
  let val noema%cont%tab%temp[itemperature] /format f0.1
  g\draw text -0.5 ypos "Temperature "'val' 4 /box 3
  !
  let ypos ypos+0.7
  let val 'noema%cont%tab%water[2]-noema%cont%tab%water[1]' /format f3.1
  g\draw text -0.5 ypos "Pwv "'noema%cont%tab%water[iwater]'" mm (available "'noema%cont%tab%water[1]'" to "'noema%cont%tab%water[noema%cont%tab%nwater]'" by "'val'")" 4 /box 3
  !
  let ypos ypos+0.7
  let val noema%cont%tab%airmass[iairmass] /format f3.1
  g\draw text -0.5 ypos "Airmass "'val'" (available "'noema%cont%tab%airmass[1]'" to "'noema%cont%tab%airmass[noema%cont%tab%nairmass]'")" 4 /box 3
  !
  let ypos ypos+0.7
  let val '(noema%cont%tab%lof[2]-noema%cont%tab%lof[1])*1e3' /format f0.0
  g\draw text -0.5 ypos "Freq step "'val'" MHz" 4 /box 3
  !
  let ypos ypos+0.7
  let val noema%cont%tab%gaini /format f5.3
  g\draw text -0.5 ypos "Image gain "'val' 4 /box 3
  !
  let ypos ypos+0.7
  let val noema%cont%tab%pressure /format f0.1
  g\draw text -0.5 ypos "Local pressure "'val'" HPa" 4 /box 3
  !
  if domin then
    let ypos ypos+0.7
    g\pen /col blue
    g\draw relo -0.5 ypos /box 3
    g\draw line -1.5 ypos /box 3
    g\pen /col foreground
    g\draw text -1.8 ypos "Min" 4 /box 3
  endif
  !
  if doaver then
    let ypos ypos+0.7
    g\pen /col dark_orange
    g\draw relo -0.5 ypos /box 3
    g\draw line -1.5 ypos /box 3
    g\pen /col foreground
    g\draw text -1.8 ypos "Average" 4 /box 3
  endif
  !
  if domax then
    let ypos ypos+0.7
    g\pen /col red
    g\draw relo -0.5 ypos /box 3
    g\draw line -1.5 ypos /box 3
    g\pen /col foreground
    g\draw text -1.8 ypos "Max" 4 /box 3
  endif
  !
  ! Title
  g\draw text 0 1 'noema%cont%tab%file'                 5 /box 8
  !
end procedure noema-continuum-table-plot
!
begin procedure noema-continuum-table-interpolate
  !---------------------------------------------------------------------
  ! Compute a Tsys value from input frequency and pwv. This is done
  ! by interpolating the Tsys and opacity found in the Tsys table
  ! currently loaded.
  !  Arguments:
  !   pro%arg[1]: WINTER or SUMMER [keyword]
  !   pro%arg[2]: Frequency        [GHz] (free value)
  !   pro%arg[3]: Water vapour     [mm]  (must be on grid)
  !   pro%arg[4]: Elevation        [deg] (free value)
  ! Results are stored in:
  !   noema%cont%done%tsys_min
  !   noema%cont%done%tsys_aver
  !   noema%cont%done%tsys_max
  !---------------------------------------------------------------------
  !
  define char*1 season
  define real lof water elevation
  let season 'pro%arg[1]' /upper
  let lof 'pro%arg[2]'
  let water 'pro%arg[3]'
  let elevation 'pro%arg[4]'
  !
  ! Season: if Winter, use the lowest temperature. If Summer, use the highest. No
  ! assumption on which order they come in the binary table.
  define integer ilow ihigh
  if noema%cont%tab%temp[1].lt.noema%cont%tab%temp[noema%cont%tab%ntemp] then
    let ilow 1
    let ihigh noema%cont%tab%ntemp
  else
    let ilow noema%cont%tab%ntemp
    let ihigh 1
  endif
  define integer iseason
  if season.eq."W" then
    let iseason ilow
  else if season.eq."S" then
    let iseason ihigh
  else
    message E noema-continuum-table-interpolate "Invalid season """'pro%arg[1]'""""
    return base
  endif
  !
  ! Water: find the corresponding water index
  @ noema-continuum-table-water 'water'
  !
  ! Bilinear interpolation in the space [freq,airmass]. See formula in
  !  https://fr.wikipedia.org/wiki/Interpolation_bilin%C3%A9aire
  !
  ! Frequency
  define integer floca[2] ilof1 ilof2
  compute floca location noema%cont%tab%lof lof
  let ilof1 floca[1]
  let ilof2 floca[2]
  define real lof1 lof2 ffact
  let lof1 noema%cont%tab%lof[ilof1]
  let lof2 noema%cont%tab%lof[ilof2]
  let ffact (lof-lof1)/(lof2-lof1)
  !
  ! Airmass
  let noema%cont%done%airmass 1./sin(elevation*pi/180)
  define integer aloca[2] iairmass1 iairmass2
  compute aloca location noema%cont%tab%airmass noema%cont%done%airmass
  let iairmass1 aloca[1]
  let iairmass2 aloca[2]
  define real airmass1 airmass2 afact
  let airmass1 noema%cont%tab%airmass[iairmass1]
  let airmass2 noema%cont%tab%airmass[iairmass2]
  let afact (noema%cont%done%airmass-airmass1)/(airmass2-airmass1)
  !
  ! Get Tsys at the 4 nearest points. We interpolate at the same time
  ! the 3 elements i.e. min, aver, and max.
  define real tsys_f1a1[3] tsys_f1a2[3] tsys_f2a1[3] tsys_f2a2[3]
  let tsys_f1a1 noema%cont%tab%tsys[,ilof1,iairmass1,noema%cont%done%iwater,iseason]
  let tsys_f1a2 noema%cont%tab%tsys[,ilof1,iairmass2,noema%cont%done%iwater,iseason]
  let tsys_f2a1 noema%cont%tab%tsys[,ilof2,iairmass1,noema%cont%done%iwater,iseason]
  let tsys_f2a2 noema%cont%tab%tsys[,ilof2,iairmass2,noema%cont%done%iwater,iseason]
  !
  ! Interpolate
  define real delta_tsys_a[3] delta_tsys_f[3] delta_tsys_af[3]
  let delta_tsys_f  tsys_f2a1-tsys_f1a1
  let delta_tsys_a  tsys_f1a2-tsys_f1a1
  let delta_tsys_af tsys_f1a1+tsys_f2a2-tsys_f2a1-tsys_f1a2
  !
  define real result[3]
  let result -
    tsys_f1a1+delta_tsys_f*ffact+delta_tsys_a*afact+delta_tsys_af*ffact*afact
  !
  let noema%cont%done%tsys_min result[1]
  let noema%cont%done%tsys_aver result[2]
  let noema%cont%done%tsys_max result[3]
  !
end procedure noema-continuum-table-interpolate
