!
subroutine adjust_mcmc (comm,line,error)
  use gildas_def
  use gbl_format
  use sic_adjust
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>adjust_mcmc
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !
  !     Support for commands
  !
  !     EMCEE [Data Command] [/BEGIN] [/START A1 B1 C1 ...] [/STEP A2 B2 C2 ...]
  !     [/Bounds Par Low Up [...]] [/Parameters Va Vb Vc ...]
  !     [/ROOT  Name] [/WALKERS NWalk] [/LENGTH Length]
  !
  ! Allows fitting arbitrary data with arbitrary number of parameters
  ! using a MCMC routine
  !---------------------------------------------------------------------
  character(len=*)                :: comm   !
  character(len=*)                :: line   !
  logical,          intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='EMCEE'
  !
  !  ' EMCEE', '/BEGIN', '/BOUNDS', '/LENGTH', '/PARAMETERS', '/ROOT_NAME', &
  !  '/START', '/STEP', '/WALKERS'/
  integer, parameter :: O_BEGIN = 1
  integer, parameter :: O_BOUND = 2
  integer, parameter :: O_LENGTH = 3
  integer, parameter :: O_PAR = 4
  integer, parameter :: O_ROOT = 5
  integer, parameter :: O_START = 6
  integer, parameter :: O_STEP = 7
  integer, parameter :: O_WALK = 8
  !
  character(len=formula_length) :: aprint,bprint
  character(len=commandline_length) :: cprint, chi2_expression
  character(len=varname_length) :: avar,cvar,argum
  character(len=64) :: work
  character(len=16) :: ch
  integer :: i,narg,ivar
  real(4), save :: xstart(adj_m),xstep(adj_m)
  type(sic_descriptor_t) :: ddesc,default
  integer :: nc,pdim
  integer :: lun,n,lk
  !
  integer :: ier
  logical :: resume, begin
  character(len=filename_length) :: file
  character(len=message_length) :: mess
  !
  logical, save :: first=.true.
  logical, save :: setup=.false.
  logical, save :: load_emcee=.false.
  integer, save :: adj_all, adj_counter
  !
  if (first) then
    xstart = 0.0
    xstep  = 1.0
    adj_lower = -5.0
    adj_upper = 5.0
    first = .false.
    call sic_defstructure('EMCEE',.true.,error)
    call sic_def_dble('EMCEE%CHI2',adj_chi2,0,0,.false.,error)
    call sic_def_inte('EMCEE%ALL',adj_all,0,0,.false.,error)
    call sic_def_inte('EMCEE%COUNTER',adj_counter,0,0,.false.,error)
    call sic_def_login('EMCEE%RESTART',adj_restart,0,0,.true.,error)
    call sic_def_inte('EMCEE_LENGTH',adj_length,0,0,.true.,error)
    call sic_def_inte('EMCEE_WALKERS',adj_walkers,0,0,.true.,error)
    call sic_def_inte('EMCEE_PARAMS',adj_n,0,0,.true.,error)
    call sic_def_char('EMCEE_ROOT',adj_root,.true.,error)
    adj_root = 'EMCEE'
    load_emcee = .true.
  endif
  adj_all = 0
  adj_counter = 0
  !
  ! No argument, No option /BEGIN
  begin = sic_present(O_BEGIN,0)
  if (begin) then
    resume = .false.
  else if (sic_narg(0).eq.0) then
    if (.not.setup) then
      call sic_message(seve%e,rname,'MCMC parameters have not been defined')
      error = .true.
      return
    else
      resume = .true.
    endif
  else
    resume = .false.
  endif
  !
  ! /LENGTH option (can be changed in all cases)
  call sic_i4 (line,O_LENGTH,1,adj_length,.false.,error)
  !
  if (.not.resume) then
    !
    ! Delete the generic structure name
    call sic_delvariable(adj_root(1:adj_lroot),.false.,error)
    error = .false.
    !
    cur_exec = adj_exec
    pdim = sic_narg(O_PAR)
    if (pdim.le.0) then
      call sic_message(seve%e,rname,'No variable specified')
      error = .true.
      return
    endif
    !
    ! Option /ROOT : Root name
    if (sic_present(O_ROOT,1)) then
       call sic_ch(line,O_ROOT,1,adj_root,adj_lroot,.true.,error)
       if (error) return
    endif
    !
    ! Main arguments
    !
    default%type = fmt_r8
    default%readonly = .false.
    default%addr = 0
    default%ndim = 0
    default%dims(:) = 0
    default%size = 0
    default%status = 0
    call sic_desc (line,0,1,ddesc,default,.true.,error)
    if (error) return
    !
    call sic_ch(line,0,2,chi2_expression,nc,.true.,error)
    if (error) return
    !
    ! Option /PARAMETER : parameter names, must be parsed before /BOUND
    pdim = sic_narg(O_PAR)
    if (pdim.gt.adj_m) then
      write(work,'(I0)') adj_m
      call sic_message(seve%e,rname,'Too many parameters, maximum allowed is '//work)
      error = .true.
      return
    endif
    !
    do i=1,pdim
      call sic_ke(line,O_PAR,i,work,nc,.true.,error)
      if (error) return
      if (.not.sic_varexist(work(1:nc))) then
         call sic_message(seve%e,rname,'Parameter'//work(1:nc)//' does not exist')
         error = .true.
         return
      endif
      call sic_lower(work)
      adj_names(i) = work
    enddo
    adj_n = pdim
    !
    ! Option Starting values : must be parsed before STEPS and BOUNDS
    narg = min(sic_narg(O_START),pdim)
    do i=1,narg
      call sic_r4 (line,O_START,i,xstart(i),.false.,error)
      if (error) return
    enddo
    !
    ! Option Steps: must be parsed before BOUNDS
    narg = min(sic_narg(O_STEP),pdim) ! Hum pas bon, mais on patche
    do i=1,narg
      call sic_r4 (line,O_STEP,i,xstep(i),.false.,error)
      if (error) return
      adj_lower(i) = xstart(i)-5*xstep(i)
      adj_upper(i) = xstart(i)+5*xstep(i)
    enddo
    !
    ! Option /BOUND : Allowed range for parameter values
    narg = max(0,min(sic_narg(O_BOUND),3*pdim)) ! is -1 if no argument
    if (mod(narg,3).ne.0) then
      call sic_message(seve%e,rname,'/BOUND requires N times 3 arguments')
      error = .true.
      return
    endif
    do i=1,narg,3
      call sic_ke (line,O_BOUND,i,avar,lk,.false.,error)
      ! Parameter names have been defined
      call sic_lower(avar)
      call sic_ambigs('/BOUNDS',avar,cvar,ivar,adj_names,pdim,error)
      if (error) return
      !      
      call sic_ke (line,O_BOUND,i+1,argum,lk,.false.,error)
      if (argum.eq.'*') then
        call sic_message(seve%e,rname,'Free Lower bound not yet supported')
        error = .true.
        return
      else
        call sic_r8 (line,O_BOUND,i+1,adj_lower(ivar),.false.,error)
      endif
      call sic_ke (line,O_BOUND,i+2,argum,lk,.false.,error)
      if (argum.eq.'*') then
        call sic_message(seve%e,rname,'Free Upper bound not yet supported')
        error = .true.
        return
      else
        call sic_r8 (line,O_BOUND,i+2,adj_upper(ivar),.false.,error)
      endif
      adj_bound(ivar) = 3
      write (mess,*) trim(adj_names(ivar)),' bounds ',real(adj_lower(ivar)),real(adj_upper(ivar))
      call sic_message(seve%i,rname,mess)
    enddo
    !
    ! Number of Walkers
    call sic_i4 (line,O_WALK,1,adj_over,.false.,error)
    adj_walkers = adj_over*adj_n
    !
    ! Write the mcmc-adjust.py
    ier = sic_getlun(lun)
    file = 'adjust-emcee.py'
    ier = sic_open(lun,file,'UNKNOWN',.false.)
    write(lun,'(A)') '#'
    write(lun,'(A)') 'import numpy as np'
    write(lun,'(A)') 'import sys'
    write(lun,'(A)') 'import math'
    write(lun,'(A)') 'import pysic'
    write(lun,'(A)') 'pysic.get()'
    write(lun,'(A)') 'sic = pysic.gdict'
    write(lun,'(A)') '#'
    write(lun,'(A)') '# list of variables'
    !
    do i=1,adj_n
      ! name + guess, min, max
      write(lun,'(A)') trim(adj_names(i))//"_guess = sic."//trim(adj_names(i))
      write(lun,'(A,1pg16.7)') trim(adj_names(i))//"_min = ",adj_lower(i)
      write(lun,'(A,1pg16.7)') trim(adj_names(i))//"_max = ",adj_upper(i)
    enddo
    !
    write(lun,'(A)') '# Likelihood and Prior'
    write(lun,'(A)') 'def lnlike(theta) : '
    aprint = "  "//adj_names(1)
    n = len_trim(aprint)+1
    do i=2,adj_n
      aprint(n:) = ","//adj_names(i)
      n = len_trim(aprint)+1
    enddo
    aprint(n:) = " = theta"
    !
    write(lun,'(A)') trim(aprint)
    do i=1,adj_n
      write(lun,'(A)') "  sic."//trim(adj_names(i))//" = "//adj_names(i)
    enddo
    write(lun,'(A)') "  Sic.comm('"//trim(chi2_expression)//"')"
    write(lun,'(A)') "  return -0.5*sic.emcee.chi2[0]"
    !
    write(lun,'(A)')
    write(lun,'(A)') "nll=lambda *args: -lnlike(*args)"
    !
    write(lun,'(A)') "def lnprior(theta):"
    write(lun,'(A)') trim(aprint)
    do i=1,adj_n
      write(lun,'(A)') "  if "//trim(adj_names(i))//"<"//trim(adj_names(i))//"_min : "
      write(lun,'(A)') "    return -np.inf "
      write(lun,'(A)') "  if "//trim(adj_names(i))//"_max<"//trim(adj_names(i))//" : "
      write(lun,'(A)') "    return -np.inf "
    enddo
    write(lun,'(A)') "  return 0.0"
    !
    write(lun,'(A)') " "
    write(lun,'(A)') "def lnprob(theta): "
    write(lun,'(A)') "  lp=lnprior(theta) "
    write(lun,'(A)') "  if not np.isfinite(lp): "
    write(lun,'(A)') "    return -np.inf "
    write(lun,'(A)') "  return lp+lnlike(theta) "
    !
    write(lun,'(A)')
    bprint = "start = ["//trim(adj_names(1))//"_guess"
    n = len_trim(bprint)+1
    do i=2,adj_n
      bprint(n:) = ", "//trim(adj_names(i))//"_guess"
      n = len_trim(bprint)+1
    enddo
    bprint(n:n) = "]"
    write(lun,'(A)') trim(bprint)
    write(lun,'(A)') " "
    !
    write(lun,'(A)') "# Prepare MCMC"
    write(lun,'(A)') "import emcee "
    write(lun,'(A)') "import pickle "
    write(lun,'(A)') "import sys"
    write(lun,'(A)') " "
    write(lun,'(A)') "# Use EMCEE to find the distribution "
    write(lun,'(A)') "# "
    write(lun,'(A)') "# Initialize the walkers "
    !
    ! pos_random = [   1.0,  0.10]  # Comes from the steps ?
    cprint = "pos_random = [ "
    n = len_trim(cprint)+1
    do i=1,adj_n
      write(cprint(n:),'(1pg12.4,a)') xstep(i),','
      n = len_trim(cprint)+1
    enddo
    cprint(n-1:n) = "]"
    write(lun,'(A)') cprint(1:n)
    write(lun,"(a,(i4,a,i4))") "numdim, nwalkers = ",adj_n,",",adj_walkers
    write(lun,'(A)') "pos=[start+pos_random*np.random.randn(numdim) for i in range(nwalkers)]"
    write(lun,'(A)') " "
    write(lun,'(A)') "# or get the starting point from the saved value"
    write(lun,'(A)') "restart = sic.emcee.restart"
    write(lun,'(A)') "if restart:"
    write(lun,'(A)') "  if sys.version_info[:1] == (2,):"
    write(lun,'(A)') "    input = open('emcee-last.pkl', 'r')"
    write(lun,'(A)') "    pos = pickle.load(input)"
    write(lun,'(A)') "  else:"
    write(lun,'(A)') "    input = open('emcee-last.pkl', 'rb')"
    write(lun,'(A)') "    pos = pickle.load(input,encoding='latin1')"
    write(lun,'(A)') " "
    write(lun,'(A)') "# Run the EMCEE sampler"

    write(lun,'(A)') "clength = sic.emcee_length "
    write(lun,'(A)') "sampler = emcee.EnsembleSampler(nwalkers, numdim, lnprob)"
    write(lun,'(A)') "sampler.run_mcmc(pos, clength) "
    write(lun,'(A)') "# Save the full chains in Pickle format"
    write(lun,'(A)') "if sys.version_info[:1] == (2,):"
    write(lun,'(A)') "  output = open('emcee-chain.pkl', 'w')"
    write(lun,'(A)') "else:"
    write(lun,'(A)') "  output = open('emcee-chain.pkl', 'wb')"
    write(lun,'(A)') "pickle.dump(sampler.chain, output)"
    write(lun,'(A)') "output.close()"
    write(lun,'(A)') "#"
    write(lun,'(A)') "# Export result as a Gildas file too"
!!    write(lun,'(A,A,A)') "Sic.comm('define image ", &
!!      & "adjust_current[adjust_length,adjust_walkers,adjust_params] ", &
!!      & "adjust-current.tab real /global')"
    write(lun,'(A)') "for i in range(sic.emcee_params):"
    write(lun,'(A)') "  for j in range(sic.emcee_walkers):"
    write(lun,'(A)') "    sic.emcee_current[i,j,:] = sampler.chain[j,:,i]"
!!    write(lun,'(A)') "Sic.comm('delete /variable adjust_current')"
    write(lun,'(A)') "#"

    write(lun,'(A)') "# Export the last point of the chain as a Pickle file "
    write(lun,'(A)') "clength = clength-1 "
    write(lun,'(A)') "last = sampler.chain[:,clength,:]"
    write(lun,'(A)') "if sys.version_info[:1] == (2,):"
    write(lun,'(A)') "  output = open('emcee-last.pkl', 'w')"
    write(lun,'(A)') "else:"
    write(lun,'(A)') "  output = open('emcee-last.pkl', 'wb')"
    write(lun,'(A)') "pickle.dump(last, output) "
    write(lun,'(A)') "output.close()"

    write(lun,'(A)') "#"
    write(lun,'(A)') "# Printing checkup"
    write(lun,'(A)') 'print("Mean acceptance fraction: {0:.3f}"'
    write(lun,'(A)') "              .format(np.mean(sampler.acceptance_fraction)))"
    close(unit=lun)
    call sic_frelun(lun)
    !
    setup = .true.
  endif
  !
  call sic_delvariable('emcee_current',.false.,error)
  error = .false.
  call exec_program('define image '// &
    'emcee_current[emcee_length,emcee_walkers,emcee_params] '// &
    'emcee-current.tab real /global')
  !
  if (load_emcee) then
    call exec_program('@ emcee-tools.sic')
    load_emcee = .false.
  endif
  !
  if (.not.(begin.or.resume)) then
    if (sic_lire().eq.0) call sic_insert(line)
    return
  endif
  !
  adj_all = adj_walkers * adj_length
  !
  ! Restart from last point in case of RESUME.
  adj_restart = resume
  !
  call exec_program('SIC CPU')
  call exec_program('python adjust-emcee.py')
  call exec_program('delete /variable emcee_current')
  if (error) return
  if (adj_restart) then
    call exec_program('@ emcee-append emcee')
  else
    call exec_program('SIC RENAME emcee-current.tab emcee-chain.tab')
  endif
  if (sic_lire().eq.0) call sic_insert(line)
  !
  ier = sic_getlun(lun)
  ier = sic_open(lun,'emcee-args.greg','UNKNOWN',.false.)
  !
  write(lun,'(A)') "define character*16 nn"
  write(lun,'(A,I6)') "let nn ",adj_n
  write(lun,'(A)') "if (pro%arg[1].ne.nn) then"
  write(lun,'(A)') "  SAY emcee-args.greg does not match the expected arguments"
  write(lun,'(A)') "  return"
  write(lun,'(A)') "endif"
  write(lun,'(A)') "if .not.exist(s_) then"
  write(lun,'(A)') "  define structure s_ /global"
  write(lun,'(A)') "endif"
  write(ch,*) adj_n
  ch = adjustl(ch)
  write(lun,'(A)') "define character*16 s_%arguments["//trim(ch)//"] /global"
  do i =1,adj_n
    write(ch,*) i
    ch = adjustl(ch)
    write(lun,'(A)') "let s_%arguments["//trim(ch)//"] "//trim(adj_names(i))
  enddo
  close(unit=lun)
  call sic_frelun(lun)
end subroutine adjust_mcmc
!
subroutine adjust_display(comm,line,error)
  use gildas_def
  use sic_adjust
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>adjust_display
  use sic_types
  use gbl_message
  !------------------------------------------------------------------
  ! @ private
  !   ADJUST support for ESHOW
  !   ESHOW AUTOCORR|CHAINS|ERRORS|RESULTS|TRIANGLES [Args]
  !     [/BURN] [/SPLIT]
  !------------------------------------------------------------------
  character(len=*), intent(in) :: line
  character(len=*), intent(in) :: comm
  logical, intent(out) :: error
  !
  integer, parameter :: o_split=2
  integer, parameter :: o_burn=1
  integer :: na,iarg,iburn,ispli
  character(len=12) :: arg, argument
  character(len=32) :: trail
  logical :: do_init
  integer, parameter :: mpar=5
  character(len=12) :: cpar(mpar)
  data cpar /'AUTOCORR','CHAINS','ERRORS','RESULTS','TRIANGLES'/
  !
  trail = ' '
  iburn = sic_start(o_burn,0)
  if (iburn.ne.0) then
    ispli = sic_start(o_split,0)
    if (ispli.gt.iburn) then
      trail = line(iburn:ispli-1)
    else
      trail = line(iburn:)
    endif
  endif
  !
  error = .false.
  call sic_ch(line,0,1,arg,na,.false.,error)
  call sic_upper (arg)
  call sic_ambigs('ESHOW',arg,argument,iarg,cpar,mpar,error)
  if (error) return
  !
  do_init = .not.sic_varexist('EMCEE_LOADED')  
  !
  select case (argument)
  case ('AUTOCORR')
    arg = '100'
    call sic_ch(line,0,2,arg,na,.false.,error)
    trail = trim(arg)//' '//trim(trail)
    if (do_init) call exec_program('@ emcee-tools') 
    if (sic_present(o_split,0)) then
      call exec_program('@ emcee-corr '//trail)
    else
      call exec_program('@ emcee-auto '//trail)
    endif
  case ('CHAINS')
    if (do_init) call exec_program('@ emcee-tools') 
    call exec_program('@ emcee-plot CHAINS '//trail)
  case ('ERRORS')
    if (do_init) call exec_program('@ emcee-tools') 
    call exec_program('@ emcee-display * '//trail)
  case ('RESULTS')
    arg = 'results'
    call sic_ch(line,0,2,arg,na,.false.,error)
    if (do_init) call exec_program('@ emcee-tools') 
    call exec_program('@ emcee-display '//trim(arg)//' '//trail)
  case ('TRIANGLES')
    if (do_init) call exec_program('@ emcee-tools') 
    call exec_program('@ emcee-plot TRIANGLES '//trail)
  case default
    error = .true.
    return
  end select
  if (sic_lire().eq.0) call sic_insert(line)
end subroutine adjust_display
!



