!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
if exist(emcee_loaded) return
!
begin data gag_scratch:table_density.init
  TASK\CHARACTER "Input Table"  NAME_IN$ 's_%name'
  TASK\INTEGER "X and Y columns" COLS$[2] 's_%x' 's_%y'
  TASK\CHARACTER "Output Image"  NAME_OUT$ 's_%density'
  TASK\INTEGER "Image size" DIMS$[2] 's_%xy' 's_%xy'
  TASK\CHARACTER "Output Table"  TABLE_OUT$ 's_%table'
  TASK\REAL "Threshold (in %)" PERCENT$ 30
  TASK\GO
end data
!
symbol emcee_result "@ emcee-error"
!
! Caution: no indentation here, as Python is sensitive...
begin data pickle-get.py
import pickle
import sys
if sys.version_info[:1] == (2,):
  input = open('emcee-chain.pkl', 'r')
  samples = pickle.load(input)
else:
  input = open('emcee-chain.pkl', 'rb')
  samples = pickle.load(input,encoding='latin1')
  
input.close()
print(samples.shape)
#
# Import pysic to avoid caller s program dependencies
import pysic
g = pysic.gdict
g.pkl.walkers = samples.shape[0]
g.pkl.length = samples.shape[1]
g.pkl.params = samples.shape[2]
Sic.comm('define image pkl%chain[pkl%length,pkl%walkers,pkl%params] emcee-chain.tab real /global')
for i in range(g.pkl.params):
  for j in range(g.pkl.walkers):
    g.pkl.chain[i,j,:] = samples[j,:,i]
end data pickle-get.py
!
begin procedure emcee-pickle
  !
  if (exist(pkl)) delete /var pkl
  !
  define structure pkl /global
  define integer pkl%params pkl%walkers pkl%length /global
  !
  ! patch bug
  if sic%verify then
    sic verif off
    python pickle-get.py
    sic verify on
  else
    python pickle-get.py
  endif
  !
  if (exist(s_)) delete /var s_
  @ emcee-args.greg 'pkl%params'
end procedure
!
begin procedure emcee-append
  sic rename &1-chain.tab &1-previous.tab
  define imag a &1-previous.tab read
  define imag b &1-current.tab read
  define integer length params walkers n
  let params a%dim[3]
  let walkers a%dim[2]
  let length a%dim[1]+b%dim[1]
  define image c[length,walkers,params] &1-chain.tab real
  let n a%dim[1]
  let c[1:n,,] a
  let n n+1
  let c[n:,,]  b
  delete /var c
end procedure
!
begin procedure emcee-auto
  !
  ! @ emcee-auto [Length] [/BURN Burn]
  !
  ! Compute the autocorrelation length for each parameter
  !     Burnout Optional burnout region length
  !
  parse /burn /split
  !
  defin integer my_burn
  if pro%parse%burn%narg.gt.0
    let my_burn 'pro%parse%burn%arg[1]'
  else
    let my_burn 50
  endif
  !
  define integer pkl_case
  if file("emcee-chain.tab") then
    SAY "Using chain data from Gildas Table file"
    let pkl_case 1
    !
    if (exist(pkl)) delete /var pkl
    !
    define structure pkl /global
    define integer pkl%params pkl%walkers pkl%length /global
    define image pkl%chain emcee-chain.tab read /global
    let pkl%length  pkl%chain%dim[1]
    let pkl%walkers pkl%chain%dim[2]
    let pkl%params  pkl%chain%dim[3]
    !
    if (exist(s_)) delete /var s_
    define structure s_ /global
    !
  else if file("emcee-chain.pkl") then
    SAY "Reloading data from Pickle file"
    @ emcee-pickle
    let pkl_case -1
    !
  else if file("emcee-samples.tab") then
    SAY "Using existing sample data, burnout region not redefined"
    !
    if (exist(s_)) delete /var s_
    define structure s_ /global
    let pkl_case 0
  else
    say "No EMCEE data found..."
    return error
  endif
  !
  if (pkl_case.ne.0) then
    define integer pkl%plot pkl%burn pkl%samples /global
    !
    ! Trim the burn-out region
    let pkl%burn my_burn+1
    !
    let pkl%samples (pkl%length-pkl%burn+1)*pkl%walkers
    define table pkl%data[pkl%samples,pkl%params] emcee-samples.tab real /global
    let pkl%data pkl%chain[pkl%burn:,,]
    !
    delete /var pkl
    !
  endif
  !
  ! Common code...
  define char s_%name*128 /global
  let s_%name emcee-samples  ! A default value ...
  define image t 's_%name'.tab read
  !
  ! Retrieve parameter names
  if (pkl_case.ge.0) then
    if file("emcee-args.greg") then
      @ emcee-args.greg 't%dim[2]'
    endif
  endif
  !
  define real s_%work /like t[1] /global
  define real s_%auto /global
  define character s_%string*128 /global
  define character trail*4 sigm*5
  define real aerr
  define integer code
  !
  !
  gtvl\clear
  greg1\set box /def

  @ window_tools
  define integer nx
  define real rx
  let rx = sqrt(t%dim[2])
  let nx = int(rx)
  if nx.ne.rx let nx = nx+1
  greg1\set expand 1./(1.+log(rx))
  !
  @ window_xy  'nx'  'nx'  1
  !
  for i 1 to t%dim[2]
    @ window_xy  'nx'   'nx'   'i'
    s_%work = t[i]
    @ autocorrelation s_%work s_%auto &1
    greg1\draw text 0 -1 's_%arguments[i]' 5 0 /char 8
    say s_%arguments[i] " = " s_%auto /format a16 a F10.1
    if (mod(i,nx).eq.1) axis yl
    if (i.gt.nx*(nx-1)) axis xl
  next
  !
  delete /var s_
end procedure emcee-auto
!
begin procedure emcee-corr
  !
  ! ESHOW AUTO [Length] /SPLIT [/Burn MyBurn]
  ! @ emcee-corr [Length] [/BURN Burn]
  !
  ! Compute the autocorrelation length for each parameter
  !     Burnout Optional burnout region length
  !
  parse /burn /split
  !
  defin integer my_burn
  if pro%parse%burn%narg.gt.0
    let my_burn 'pro%parse%burn%arg[1]'
  else
    let my_burn 50
  endif
  !
  define integer pkl_case
  if file("emcee-chain.tab") then
    SAY "Using chain data from Gildas Table file"
    let pkl_case 1
    !
    if (exist(pkl)) delete /var pkl
    !
    define structure pkl /global
    define integer pkl%params pkl%walkers pkl%length /global
    define image pkl%chain emcee-chain.tab read /global
    let pkl%length  pkl%chain%dim[1]
    let pkl%walkers pkl%chain%dim[2]
    let pkl%params  pkl%chain%dim[3]
    !
    if (exist(s_)) delete /var s_
    define structure s_ /global
    !
  else if file("emcee-chain.pkl") then
    SAY "Reloading data from Pickle file"
    @ emcee-pickle
    let pkl_case -1
    !
  else
    say "No adequate EMCEE data found..."
    return error
  endif
  !
  if (pkl_case.ne.0) then
    define integer pkl%plot pkl%burn pkl%samples /global
    !
    ! Trim the burn-out region
    let pkl%burn my_burn+1
    !
    let pkl%samples (pkl%length-pkl%burn+1)
    define image pkl%data[pkl%samples,pkl%walkers,pkl%params] emcee-series.tab real /global
    let pkl%data pkl%chain[pkl%burn:,,]
    !
    delete /var pkl
    !
  endif
  !
  ! Common code...
  define char s_%name*128 /global
  let s_%name emcee-series  ! As above for pkl_case # 0
  define image t 's_%name'.tab read
  !
  ! Retrieve parameter names
  if (pkl_case.ge.0) then
    if file("emcee-args.greg") then
      @ emcee-args.greg 't%dim[3]'
    endif
  endif
  !
  define real s_%work /like t[1,1] /global
  define real s_%auto s_%auto_one /global
  define character s_%string*128 /global
  define character trail*4 sigm*5
  define real aerr
  define integer code
  !
  !
  gtvl\clear
  greg\set box /def
  @ window_tools
  !
  define integer nx
  define real rx
  rx = sqrt(t%dim[3])
  nx = int(rx)
  if nx.ne.rx let nx = nx+1
  greg1\set expand 1./(1.+log(rx))
  !
  @ window_xy  'nx'  'nx'  1
  !
  ! Work by temporal series
  for i 1 to t%dim[3]
    @ window_xy  'nx'   'nx'   'i'
    let s_%auto 0
    for l 1 to t%dim[2]
      s_%work = t[l,i]
      @ autocorrelation.disc s_%work s_%auto_one &1
      let s_%auto s_%auto+s_%auto_one
    next
    let s_%auto s_%auto/t%dim[2]
    say s_%arguments[i] " = " s_%auto /format a16 a F10.1
    greg1\draw text 0 -1 's_%arguments[i]' 5 0 /char 8
    if (mod(i,nx).eq.1) greg1\axis yl
    if (i.gt.nx*(nx-1)) greg1\axis xl
  next
  !
  delet /var s_
end procedure emcee-corr
!
begin procedure emcee-display
  !
  ! @ emcee-display  *|File [/BURN Burnout]
  !     *       Print on screen
  !     File    Create script for best results
  !     Burnout Optional burnout region length
  !
  parse /burn
  !
  define integer my_burn
  if pro%parse%burn%narg.gt.0
    let my_burn 'pro%parse%burn%arg[1]'
  else
    let my_burn 50
  endif
  !
  define integer code
  let code = 0
  if pro%parse%command%narg.gt.0 then
    if (pro%parse%command%arg[1].ne."*") then
      let code = 1
    else
      let code = -1
    endif
  endif
  !
  define integer pkl_case
  if file("emcee-chain.tab") then
    SAY "Using chain data from Gildas Table file"
    let pkl_case 1
    !
    if (exist(pkl)) delete /var pkl
    !
    define structure pkl /global
    define integer pkl%params pkl%walkers pkl%length /global
    define image pkl%chain emcee-chain.tab read /global
    let pkl%length  pkl%chain%dim[1]
    let pkl%walkers pkl%chain%dim[2]
    let pkl%params  pkl%chain%dim[3]
    !
    if (exist(s_)) delete /var s_
    define structure s_ /global
    !
  else if file("emcee-chain.pkl") then
    SAY "Reloading data from Pickle file"
    @ emcee-pickle
    let pkl_case -1
    !
  else if file("emcee-samples.tab") then
    SAY "Using existing sample data, burnout region not redefined"
    !
    if (exist(s_)) delete /var s_
    define structure s_ /global
    let pkl_case 0
  else
    say "No EMCEE data found..."
    return error
  endif
  !
  if (pkl_case.ne.0) then
    define integer pkl%plot pkl%burn pkl%samples /global
    !
    ! Trim the burn-out region
    let pkl%burn my_burn+1
    !
    let pkl%samples (pkl%length-pkl%burn+1)*pkl%walkers
    define table pkl%data[pkl%samples,pkl%params] emcee-samples.tab real /global
    let pkl%data pkl%chain[pkl%burn:,,]
    !
    delete /var pkl
    !
  endif
  !
  ! Common code...
  define char s_%name*128 /global
  let s_%name emcee-samples  ! A default value ...
  define image t 's_%name'.tab read
  !
  ! Retrieve parameter names
  if (pkl_case.ge.0) then
    if file("emcee-args.greg") then
      @ emcee-args.greg 't%dim[2]'
    endif
  endif
  !
  define real s_%work /like t[1] /global
  define real s_%result[3] /global
  define character s_%string*128 /global
  define character trail*4 sigm*5
  define real aerr
  !
  if code.ne.0 then
    if (code.eq.1) then
      sic output emcee_&1.sic
    endif
    ! Use default root name if not specified
    if .not.exist(emcee_root) then
      define character*6 emcee_root
      let emcee_root EMCEE
    endif
    !
    if .not.exist('emcee_root') define structure 'emcee_root' /global
    if exist('emcee_root'%par) then
      delete /var  'emcee_root'%par 'emcee_root'%errors
    endif
    define double 'emcee_root'%par['t%dim[2]'] /global
    define double 'emcee_root'%errors['t%dim[2]'] /global
  endif
  !
  ! Make sure global variables used in EMCEE still exist
  for i 1 to t%dim[2]
    if .not.exist('s_%arguments[i]') then
      define double 's_%arguments[i]' /global
    endif
  next
  !
  for i 1 to t%dim[2]
    s_%work = t[i]
    @ percentile s_%work s_%result  16 50 84
    if code.eq.0 then
      @ print-error s_%string s_%result
      say s_%arguments[i] " = " s_%string /format a16 a a
    else
      let aerr (s_%result[3]-s_%result[1])*0.5
      say "emcee_result " s_%arguments[I] s_%result[2] aerr s_%result[1]-s_%result[2] -
        s_%result[3]-s_%result[2]   /format A A 1PG14.5 1PG14.5 1PG14.5 1PG14.5
    endif
    ! Set back the values...
    let 'emcee_root'%par[i] s_%result[2]
    let 'emcee_root'%errors[i] aerr
    let 's_%arguments[i]' s_%result[2]
  next
  !
  if code.eq.1 then
    sic output
    say "emcee_&1.sic created"
  endif
  !
  delet /var s_
end procedure emcee-display
!
begin procedure emcee-plot
  parse /burn
  !
  defin integer my_burn
  if pro%parse%burn%narg.gt.0
    let my_burn 'pro%parse%burn%arg[1]'
  else
    let my_burn 50
  endif
  !
  define integer pkl_case
  if file("emcee-chain.tab") then
    SAY "Using chain data from Gildas Table file"
    let pkl_case 1
    !
    if (exist(pkl)) delete /var pkl
    !
    define structure pkl /global
    define integer pkl%params pkl%walkers pkl%length /global
    define image pkl%chain emcee-chain.tab read /global
    let pkl%length  pkl%chain%dim[1]
    let pkl%walkers pkl%chain%dim[2]
    let pkl%params  pkl%chain%dim[3]
    !
    @ emcee-args.greg 'pkl%params'
  else if file("emcee-chain.pkl") then
    SAY "Reloading data from Pickle file"
    @ emcee-pickle
    let pkl_case -1
  else
    SAY "No Gildas or Pickle data file available"
    return
  endif
  !
  @ window_tools.greg
  !
  define integer pkl%plot pkl%burn pkl%samples /global
  !
  if ("&1".eq."CHAINS") then
    let aspect_ratio yes
    let aspect 1.2    ! More in X ?...
    greg1\limits 0 1 0 1
    let inter 0.1 0   ! Up to 10 % of space for labels ?
    !
    let pkl%plot pkl%length
    if pro%narg.gt.1 then
      if pro%arg[2].ne."*" then
        let pkl%plot &2
      endif
    endif
    !
    gtvl\clear
    ! Maximum 5 columns 
    greg1\set expand 0.6
    define integer nxb nyb
    let nxb min(5,nint(sqrt(pkl%params)))
    let nyb pkl%params/nxb
    if (nxb*nyb.lt.pkl%params) let nyb nyb+1
    !
    define real c[pkl%length]
    let c[my_i] my_i
    for i 1 to pkl%params
      @ window_xy 'nxb' 'nyb' 'i'
      !
      greg1\limits -0.05*pkl%plot 1.05*pkl%plot * * /var c pkl%chain[,1,i]
      for j 2 to pkl%walkers
        greg1\limits = = < > /var c pkl%chain[,j,i]
      next
      for j 1 to pkl%walkers
        greg1\pen mod(j,6)
        greg1\connect c pkl%chain[,j,i]
      next
      greg1\pen 0
      if (i.gt.nxb*(nyb-1)) then
        greg1\box p o
      else if i.eq.pkl%params
        greg1\box p o
      else
        greg1\box n o
      endif
      greg1\draw text 0 0.75 's_%arguments[i]' 5 0 /char 8
    next
    !
    ! Label leftmost bottom box here...
    @ window_xy 'nxb' 'nyb' 1 1 
    greg1\label "Iteration" /X
    !
    delete /var s_
    !
  else if ("&1".eq."TRIANGLES") then
    !
    ! Trim the burn-out region
    let pkl%burn my_burn+1
    !
    let pkl%samples (pkl%length-pkl%burn+1)*pkl%walkers
    define table pkl%data[pkl%samples,pkl%params] emcee-samples.tab real /global
    let pkl%data pkl%chain[pkl%burn:,,]
    !
    delete /var pkl
    !
    @ emcee-triangle emcee-samples toto
    !
  endif
end procedure emcee-plot
!
begin procedure emcee-triangle
  !
  ! Purpose:
  !   " triangle " plot of N variables.
  !   Plot the density distributions of the N x N-1 pairs
  !   and the histograms of the N variables
  !
  !   Make a nice density plot for pairs of points:
  !   - Plots the points if the density is low enough
  !   - Make a grey scale contour plot of the point density if the
  !   density is so high that points are crowded.
  !
  ! Version for N entries
  !
  ! If s_%arguments has been defined before, it will be
  ! used as labels for each column. If not, the labels
  ! default to Col.i
  !
  if (pro%narg.eq.0).or.(pro%narg.eq.1.and.pro%arg[1].eq."-help") then
    SAY "Usage:   @ emcee-triangle Name Table [Parameter]"
    say "   Name   :  Input EMCEE table result    "
    say "   Table  :  Name for scratch GDF tables"
    say "   Parameter: Only plot triangles for this parameter (optional)"
    return
  endif
  !
  if .not.exist(s_) then
    define structure s_ /global
  endif
  !
  define char s_%name*128 s_%density*128 s_%table*128 /global
  define integer s_%x s_%y s_%xy /global
  define real s_%result[3] /global
  define character s_%string*128 /global
  let s_%name &1
  let s_%density &2
  let s_%table &2
  let s_%xy 32
  let s_%x 1
  let s_%y 2
  !
  !!if pro%narg.gt.2
  !!  let s_%xy &3
  !!  if pro%narg.eq.6
  !!    let s_%x &4
  !!    let s_%y &5
  !!  endif
  !!endif
  !
  @ window_tools.greg
  let position 0.15 0.95 0.10 0.90
  let aspect_ratio no
  let inter 0.05
  @ window_tools.greg
  !
  define image t 's_%name'.tab read
  define real s_%work /like t[1] /global
  define integer n
  let N t%dim[2]  ! Number of variables
  !
  if .not.exist(s_%arguments) then
    for i 1 to N
      let s_%arguments['i'] "Col."'i'
    next
  endif
  !
  gtvl\clear
  !
  define real xx['2*s_%xy',2] yy['2*s_%xy',2]
  define double umin umax vmin vmax xm ym
  !
  if pro%narg.gt.2 then
    defin integer k nn l
    for i 1 to n
  !!    exa s_%arguments[i]
  !!    exa pro%arg[3]
      if s_%arguments[i].eq.pro%arg[3] then
        k = i
      endif
    next
    let nn nint(sqrt(n))
    if nn**nn.lt.n let nn nn+1
    greg1\set expand min(2.0/nn,0.7)
    !
    @ window_tools.greg
    let position 0.15 0.95 0.10 0.90
    let aspect_ratio no
    let inter 0.25
    @ window_tools.greg
    !
    let l 0
    for i 1 to n
      if i.ne.k then
        let s_%x i
        let s_%y k
        let l l+1
        !
        run table_density gag_scratch:table_density.init /nowin
        !
        greg1\col x 1 y 2 /table 's_%table'.tab
        !
        @ window_xy 'nn' 'nn' 'l'
        define image a 's_%density'.gdf read
        greg1\lim /rg a
        greg1\point
        greg2\level 2 4 6 8
        greg2\rgmap quiet /per 10 /grey 0 2
        greg2\rgmap quiet /per 10
        greg1\box p n
        greg1\label 's_%arguments[s_%x]' /x
        !
        if (mod(l,nn).eq.1) then
          greg1\axis yl
          greg1\label 's_%arguments[s_%y]' /y
        endif
        !
        greg1\pen 3
        sic\compute xm median t[s_%x]
        greg1\draw relo xm user_ymin /user
        greg1\draw line xm user_ymax /user
        sic\compute ym median t[s_%y]
        greg1\draw relo user_xmin ym /user
        greg1\draw line user_xmax ym /user
        greg1\draw marker xm ym /user
        greg1\pen 0
        delete /var a
        !
      endif
    next
    !
    if (no) then
      let umin user_ymin
      let umax user_ymax
      @ window_xy 'nn' 'nn' 'nn^2'
      sic\compute xx histo t[k] umin umax
      sic\compute xm median t[k]
      greg1\limits umin umax * * /var xx[2] xx[1]
      greg1\box
      greg1\label 's_%arguments[k]' /x
      greg1\histo xx[2] xx[1]
      greg1\pen 3
      greg1\draw relo xm user_ymin /user
      greg1\draw line xm user_ymax /user
      greg1\pen 0
      !
      s_%work = t[k]
      @ percentile   s_%work s_%result  16 50 84
      @ print-error  s_%string s_%result "GREG"
      greg1\draw text 0 2 s_%arguments[k] 5 /char 8
      greg1\draw text 0 1 s_%string 6 /char 7
    else
      let l l+1
      let umin user_ymin
      let umax user_ymax
      @ window_xy 'nn' 'nn' 'l'
      sic\compute xx histo t[k] umin umax
      sic\compute xm median t[k]
      greg1\limits * * umin umax /var xx[1] xx[2]
      greg1\box n n
      greg1\histo xx[1] xx[2]
      greg1\pen 3
      greg1\draw relo 0 xm /user
      greg1\draw line 0.9*user_xmax xm /user
      greg1\draw relo 0 user_ymin /user
      greg1\draw line 0 user_ymax /user
      greg1\pen 0
      !
      s_%work = t[k]
      @ percentile   s_%work s_%result  16 50 84
      @ print-error  s_%string s_%result "GREG"
      greg1\draw text 2.0 -1.5 s_%string 6 0 /char 7
      !
      if l.ne.nn^2 then
        greg1\axis yr /label o
        greg1\draw text 4 0 's_%arguments[k]' 5 90 /char 6
      endif
    endif

  else
    greg1\set expand min(3.0/n,1)
    !
    for i 1 to n
      if (i.lt.n) then
        for j n to i+1 by -1 !! I+1 to n
          let s_%x j
          let s_%y i
          !
          run table_density gag_scratch:table_density.init /nowin
          !
          greg1\column x 1 y 2 /table 's_%table'.tab
          !
          @ window_xy 'n' 'n' 'n-j+1' 'i'
          define image a 's_%density'.gdf read
          greg1\limits /rg a
          greg1\point
          greg2\level 2 4 6 8
          greg2\rgmap quiet /per 10 /grey 0 2
          greg2\rgmap quiet /per 10
          greg1\box n n
          if (n-j+1.eq.1) then
            greg1\axis yl
            greg1\label 's_%arguments[s_%y]' /y
          endif
          if (i.eq.1) then
            greg1\axis xl
            greg1\label 's_%arguments[s_%x]' /x
          endif
          !
          greg1\pen 3
          sic\compute xm median t[s_%x]
          greg1\draw relo xm user_ymin /user
          greg1\draw line xm user_ymax /user
          sic\compute ym median t[s_%y]
          greg1\draw relo user_xmin ym /user
          greg1\draw line user_xmax ym /user
          greg1\draw marker xm ym /user
          greg1\pen 0
          delete /var a
          !
        next
        if i.eq.n-1 then
          let vmin user_xmin
          let vmax user_xmax
        endif
        let umin user_ymin
        let umax user_ymax
      else
        let umin vmin
        let umax vmax
      endif
      !
      sic\compute xx histo t[i] umin umax
      sic\compute xm median t[i]
      @ window_xy 'n' 'n' 'n-i+1' 'i'
      greg1\limits umin umax * * /var xx[2] xx[1]
      greg1\box n n
      if (i.eq.1) then
        greg1\axis xl
        greg1\label 's_%arguments[i]' /x
      else if (i.eq.n) then
        greg1\label 's_%arguments[i]' /Y
      endif
      greg1\histo xx[2] xx[1]
      greg1\pen 3
      greg1\draw relo xm user_ymin /user
      greg1\draw line xm user_ymax /user
      greg1\pen 0
      !
      s_%work = t[i]
      @ percentile   s_%work s_%result  16 50 84
      @ print-error  s_%string s_%result "GREG"
      greg1\draw text 0 2 s_%arguments[i] 5 /char 8
      greg1\draw text 0 1 s_%string 6 /char 7
    next
    !
  endif
  !
  delete /var s_
end procedure emcee-triangle
!
begin procedure emcee-timer
  if .not.exist(emcee%left) then
    sic cpu
    define double emcee%time /glo
    define double emcee%left /glo
    define character emcee%string*16 /glo
  endif
  let emcee%counter emcee%counter+1
  if (emcee%counter.eq.100) then
    sic cpu
    let emcee%time sic%cpu%raw%elapsed/(emcee%counter+1)
    let emcee%left emcee%time*(emcee%all-emcee%counter+1)/3600.0
    let emcee%string emcee%left /sexa
    say emcee%counter "/" emcee%all emcee%chi2 ", " emcee%string " to go" /format I8 A I8 F16.2 A A A
  endif
  if mod(emcee%counter,emcee%all/10).eq.0 then
    let emcee%left emcee%time*(emcee%all-emcee%counter+1)/3600.0
    let emcee%string emcee%left /sexa
    say emcee%counter "/" emcee%all emcee%chi2 ", " emcee%string " to go" /format I8 A I8 F16.2 A A A
  endif
end procedure emcee-timer
!
begin procedure autocorrelation
  !
  !  @ autocorrelation  Array  Result [Window]
  !     Array must be a global variable
  !     Result must be a scalar global variable
  if pro%narg.lt.2 then
    say "Usage: "
    say "  @ autocorrelation Array  Result "
    say "     Array must be a global variable (possibly a sub-array)"
    say "     Result must be a scalar global variable "
    return error
  endif
  define integer window
  define integer shape[8] nnn
  sic\compute shape dimof &1
  let nnn shape[1]
  sic\compute shape dimof &2
  if (shape[8].ne.0) then
    say "Result array must a scalar"
    return error
  endif
  define real val[nnn] mval xx[nnn] lval
  let window 100
  if pro%narg.eq.3 then
    let window &3
  endif
  let window min(window,nnn/4)
  !
  let val &1
  let xx[my_i] my_i
  !
  sic\compute mval mean val
  let val val-mval
  !
  ! Compute Auto Correlation Function
  define real aval[nnn,2]
  sic\compute aval FFT+ val REAL    !
  let  val aval[1]^2+aval[2]^2  ! Get power spectrum
  sic\compute aval FFT- val REAL    ! Compute its inverse FT
  let val aval[1]
  let mval val[1]
  let val val/mval              ! Normalize by total power
  !
  greg1\lim 0 window -0.2 1.1 /var xx val
  greg1\hist xx val
  greg1\box n n
  greg1\pen 1
  greg1\draw relo user_xmin 0 /user
  greg1\draw line user_xmax 0 /user
  greg1\pen 0
  !
  ! The correlation length is the sum of the ACF
  ! over the specified window
  lval = 0
  for k 50 to window by 10
    comput mval sum val[1:k]
    ! plus One...
    mval = 2*mval+1
    if mval.gt.lval then
      let lval = mval
    else
      break
    endif
  next
  !
  let &2 lval
end procedure autocorrelation
!
begin procedure percentile
  !
  !  @ percentile  Array  Result Value1 [Value2 ... ValueN]
  !     Array must be a global variable
  !     Result must be 1-D a global variable of dimension N
  if pro%narg.lt.3 then
    say "Usage: "
    say "  @ percentile  Array  Result Value1 [Value2 ... ValueN]"
    say "     Array must be a global variable (possibly a sub-array)"
    say "     Result must be 1-D a global variable of dimension N"
    return error
  endif
  define integer shape[8] nnn
  sic\compute shape dimof &1
  let nnn shape[1]
  sic\compute shape dimof &2
  if (shape[8].ne.1.or.shape[1].ne.pro%narg-2) then
    say "Result array must be 1-D of dimension "'pro%narg-2'
    return error
  endif
  define double val[nnn]
  !
  let val &1
  sic\sort val
  define double percent xxx yyy result
  define integer kkk
  for i 3 to pro%narg
    let percent 'pro%arg[i]'
    let xxx percent/100d0*nnn
    if (nint(xxx).eq.xxx) then
      let kkk xxx
      if kkk.eq.nnn then
        &2['i-2'] = val[kkk]
      else
        &2['i-2'] = 0.5d0*(val[kkk]+val['kkk+1'])
      endif
    else
      yyy = xxx-int(xxx)
      xxx = xxx-yyy+1
      kkk = xxx
      &2['i-2'] = val[kkk]
    endif
  next
end procedure percentile
!
begin procedure print-error
  !
  ! Define the range of result from the percentiles
  !
  define double smin smax sval serr lerr
  define double value vplus vminus
  define inte lval
  sic\compute smin min &2
  sic\compute smax max &2
  !
  sval = max(abs(smin),abs(smax))
  sval = log(sval)/log(10)
  lval = int(abs(sval))+1
  if lval.gt.3 then
    if sval.lt.1 let lval = -lval
    sval = 10^lval
  else
    sval = 1.0
  endif
  !
  value = &2[2]/sval
  vminus = (&2[1]-&2[2])/sval
  vplus = (&2[3]-&2[2])/sval
  !
  ! Compute the number of digits for  the error
  serr = max(abs(vminus),abs(vplus))
  serr = -log(serr)/log(10)
  lerr = max(0,int(serr)+2)
  value = 10^(-lerr)*nint(10^lerr*value)
  vminus = 10^(-lerr)*nint(10^lerr*vminus)
  vplus = 10^(-lerr)*nint(10^lerr*vplus)
  !
  if sval.eq.1.0 then
    let  &1 'value'" ("'vminus'",+"'vplus'")"
  else
    if "_&3".eq."_GREG" then
      let  &1 'value'" ("'vminus'",+"'vplus'") 10\\u"'lval'
    else
      let  &1 'value'" ("'vminus'",+"'vplus'") 1E"'lval'
    endif
  endif
end procedure print-error
!
begin procedure emcee-error
  define double some_emcee_res[3] /global
  define charac*64 some_emcee_string /global
  let some_emcee_res[2] &2
  let some_emcee_res[3] &2+&3
  let some_emcee_res[1] &2+&4
  !
  @ print-error some_emcee_string some_emcee_res
  say "&1" " = " some_emcee_string /format a16 a a
  delet /var some_emcee_res some_emcee_string
  !
end procedure emcee-error
!
define logical emcee_loaded /global
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
