if exist(kepler_show) return
!
define structure kepler_show /global
define double kepler_show%v[2] kepler_show%r[2] kepler_show%t[2] kepler_show%f[2] kepler_show%dv /global
define log kepler_show%spec kepler_show%prof kepler_show%pv kepler_show%layout /global
!
! Fitting function
if .not.function(f_gauss) then
  ! 1.66510922 = 2*sqrt(log(2))
  define function f_gauss(X,amp,pos,wid) amp*exp(-((X-pos)*1.66510922/wid)^2)
endif
!
! Fit intermediate arrays
if exist(g_) delet /var g_
define structure g_ /global
define double g_%amp g_%pos g_%width g_%tau /global
define logical g_%hfs /global
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure kepler-drawlines
  if preview%nfound.eq.0 return
  !
  ! Draw Identified Spectral Lines on an integrated spectrum
  !
  define real ypos[2]
  define double vrange[2] f_scale
  let vrange user_xmin user_xmax
  !
! Unclear in this context - Ignore so far...
!  ! Allow for a global Redshift by introducing a scale factor
!  ! on frequencies f_scale
!  if exist(redshift) then
!    f_scale = 1.d0+redshift
!  else
!    f_scale = 1.d0
!  endif
  greg1\limits &1 &2 = =
  define real cspectre /like kepler_spectrum[1]
  let cspectre kepler_spectrum[1] ! Trial
  compute ypos[1] min cspectre
  let ypos[1] max(0.,ypos[1])
  let ypos[2] user_ymin+0.95*(user_ymax-user_ymin)
  greg1\pencil 1
  for klines 1 to preview%nfound
    greg1\draw relo preview%found%freq[klines] user_ymin /user
    greg1\draw line preview%found%freq[klines] ypos[1] /user
    greg1\draw text preview%found%freq[klines] ypos[2] 'preview%found%lines[klines]' 4 90 /user
  next
  ! Restore limits
  greg1\limits vrange[1] vrange[2] = =
  greg1\pencil 0
end procedure kepler-drawlines
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure kepler_dofit
  ! 
  ! Compute the line fit from &1  (usually KEPLER_SPECTRUM)
  !
  ! Uses Hyperfine Structure if defined
  !
  ! Results variables
  if exist(kepler_fit) delet /var kepler_fit
  define structure kepler_fit /global
  define real kepler_fit%r[5] kepler_fit%e[5] /global
  let kepler_fit%r 0
  let kepler_fit%e 0
  define char*12 kepler_fit%n[5] /global
  let kepler_fit%n "Peak Flux" "Velocity" "Width" "Inte. Flux" "Opacity"
  !
  ! Temporary arrays or aliases
  define alias yy &1[2] /global
  if exist(ksfit) delet /var ksfit
  define alias ksfit &1 /global
  !
  define double zz /like &1[1]
  define logical do_tau
  let do_tau no
  let g_%hfs exist(hfs)
  if (g_%hfs) then
    let do_tau hfs%tau.lt.0
    let g_%tau hfs%tau
  else
    let g_%tau 0
  endif
  let kepler_fit%r g_%amp g_%pos g_%width 0 abs(g_%tau)
  !
  if (kepler_usevdisk) then
    !
    ! Disk velocity is specified
    let g_%pos kepler_vdisk
    let zz &1[2] /where &1[1].eq.g_%pos
    compute g_%amp max zz
    if (g_%hfs) let g_%amp g_%amp/g_%tau ! Hum ?
    !
    if (do_tau) then
      let g_%tau abs(g_%tau)
      ! Also attempt to fit the Opacity
      if (kepler_show%dv.eq.0) then
        ! Compute Amplitude and Width
        adjust\adjust yy  "@ kepler_diff" /start 'g_%amp' 0.5 'g_%tau' -
          /par g_%amp g_%width g_%tau /root ADJ /STEP 0.05 0.05 0.2 /METHOD POWELL /QUIET
        let g_%amp adj%par[1]
        let g_%width adj%par[2]
        let g_%tau adj%par[3]
        let kepler_fit%r[5] adj%par[3]
        let kepler_fit%r[1:2] adj%par[1:2]
        let kepler_fit%e[5] adj%errors[3]
        let kepler_fit%e[1:2] adj%errors[1:2]
      else
        ! Compute Amplitude since line width is specified
        let g_%width kepler_show%dv
        adjust\adjust yy  "@ kepler_diff" /start 'g_%amp' 'g_%tau'
          /par g_%amp g_%tau /root ADJ /STEP 0.05 0.2  /METHOD POWELL /QUIET
        let g_%amp adj%par[1]
        let g_%tau adj%par[2]
        let kepler_fit%r[5] adj%par[3]
        let kepler_fit%r[1] adj%par[1]
        let kepler_fit%e[5] adj%errors[2]
        let kepler_fit%e[1] adj%errors[1]
      endif 
    else
      if (kepler_show%dv.eq.0) then
        ! Compute Amplitude and Width
        adjust\adjust yy  "@ kepler_diff" /start 'g_%amp' 0.5 -
          /par g_%amp g_%width /root ADJ /STEP 0.05 0.05 /METHOD POWELL /QUIET
        let g_%amp adj%par[1]
        let g_%width adj%par[2]
        let kepler_fit%r[3] adj%par[2]
        let kepler_fit%r[1] adj%par[1]
        let kepler_fit%e[3] adj%errors[2]
        let kepler_fit%e[1] adj%errors[1]
      else
        ! Compute Amplitude since line width is specified
        let g_%width kepler_show%dv
        adjust\adjust yy  "@ kepler_diff" /start 'g_%amp' -
          /par g_%amp /root ADJ /STEP 0.05 /METHOD POWELL /QUIET
        let g_%amp adj%par[1]
        let kepler_fit%r[1] adj%par[1]
        let kepler_fit%e[1] adj%errors[1]
      endif
    endif
  else
    !
    ! Derive disk velocity from maximum of Integrated Spectrum
    compu g_%amp max &1[2]
    let zz &1[1] /where &1[2].eq.g_%amp
    compute g_%pos max zz
    !
    if (do_tau) then
      let g_%tau abs(g_%tau)
      SAY "Adjusting opacity, guess "'g_%tau'
      ! Fit opacity also
      if (kepler_show%dv.eq.0) then
        ! Compute Amplitude, Position and Width
        let g_%width 0.6
        adjust\adjust yy  "@ kepler_diff" /start 'g_%amp' 'g_%pos' 'g_%width' 'g_%tau' -
          /par g_%amp g_%pos g_%width g_%tau /root ADJ /STEP 0.05 0.01 0.01 0.2 /METHOD ROBUST /QUIET
        let g_%amp adj%par[1]
        let g_%pos adj%par[2]
        let g_%width adj%par[3]
        let g_%tau adj%par[4]
        let kepler_fit%r[1:3] adj%par[1:3]
        let kepler_fit%e[1:3] adj%errors[1:3]
        let kepler_fit%r[5] adj%par[4]
        let kepler_fit%e[5] adj%errors[4]
      else
        ! Width is specified: Get Amplitude and Position
        let g_%width kepler_show%dv
        adjust\adjust yy  "@ kepler_diff" /start 'g_%amp' 'g_%pos' 'g_%tau' -
          /par g_%amp g_%pos g_%tau /root ADJ /STEP 0.05 0.01 0.2 /METHOD ROBUST /QUIET
        let kepler_fit%r[1:2] adj%par[1:2]
        let kepler_fit%e[1:2] adj%errors[1:2]
        let kepler_fit%r[5] adj%par[3]
        let kepler_fit%e[5] adj%errors[3]
        let g_%amp adj%par[1]
        let g_%pos adj%par[2]
        let g_%tau adj%par[3]
      endif
    else
      SAY "Using fixed opacity "'g_%tau'
      if (kepler_show%dv.eq.0) then
        ! Compute Amplitude, Position and Width
        let g_%width 0.6
        adjust\adjust yy  "@ kepler_diff" /start 'g_%amp' 'g_%pos' 'g_%width' -
          /par g_%amp g_%pos g_%width /root ADJ /STEP 0.05 0.01 0.01 /METHOD ROBUST /QUIET
        let g_%amp adj%par[1]
        let g_%pos adj%par[2]
        let g_%width adj%par[3]
        let kepler_fit%r[1:3] adj%par[1:3]
        let kepler_fit%e[1:3] adj%errors[1:3]
      else
        ! Width is specified: Get Amplitude and Position
        let g_%width kepler_show%dv
        adjust\adjust yy  "@ kepler_diff" /start 'g_%amp' 'g_%pos' -
          /par g_%amp g_%pos /root ADJ /STEP 0.05 /METHOD ROBUST /QUIET
        let g_%amp adj%par[1]
        let g_%pos adj%par[2]
        let kepler_fit%r[1:2] adj%par[1:2]
        let kepler_fit%e[1:2] adj%errors[1:2]
      endif
    endif
  endif
  if (g_%hfs) then   
    ! g%_amp will be the T*Tau of CLASS
    define double tau  /like &1[1]
    define double velo
    let tau 0
    for i 1 to hfs%nhyp
      let velo g_%pos+hfs%velocity[i]
      let tau  tau+g_%tau*f_gauss(&1[1],hfs%ratio[i],velo,g_%width)
    next
    let zz g_%amp*(1-exp(-tau))
    !
    ! Convert to AMP * TAU
    let adj%par[1] adj%par[1]*g_%tau
    let adj%errors[1] adj%errors[1]*g_%tau
    let kepler_fit%r[1] adj%par[1]
    let kepler_fit%e[1] adj%errors[1]
    !
  else  
    let zz f_gauss(&1[1],g_%amp,g_%pos,g_%width)
  endif
  !
  define real theflux
  let theflux g_%amp*g_%width*sqrt(pi/4/log(2)) 
  if (g_%hfs) let theflux theflux*abs(g_%tau)   ! The specified opacity...
  let kepler_fit%r[4]  theflux
  let kepler_fit%e[4]  theflux*kepler_fit%e[1]/kepler_fit%r[1]
  !
  if exist(g_%fit) delet /var g_%fit 
  define double g_%fit /like zz /global
  let g_%fit zz
  delete /var yy ksfit
end procedure kepler_dofit
!
begin procedure kepler_diff
  let adj%res 0
  if (g_%hfs) then
    ! g%_amp will be the T*Tau of CLASS
    define double tau prof /like ksfit[1]
    define double velo
    let tau 0
    for i 1 to hfs%nhyp
      let velo g_%pos+hfs%velocity[i]
      let tau  tau+g_%tau*f_gauss(ksfit[1],hfs%ratio[i],velo,g_%width)
    next
    let prof g_%amp*(1-exp(-tau))
    if exist(kepler_pv) then
      let ADJ%res ksfit[2]-prof /where ksfit[2].ne.kepler_pv%blank[1]
    else
      let ADJ%res ksfit[2]-prof 
    endif
  else
    if exist(kepler_pv) then
      let ADJ%res ksfit[2]-f_gauss(ksfit[1],g_%amp,g_%pos,g_%width) /where ksfit[2].ne.kepler_pv%blank[1]
    else
      let ADJ%res ksfit[2]-f_gauss(ksfit[1],g_%amp,g_%pos,g_%width) 
    endif
  endif
end procedure kepler_diff
!
