!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubestatistics_histoaxis_types
  use cubetools_parameters
  use cubetools_structure
  use cubetools_keyword_arg
  use cubestatistics_messaging
  !
  public :: histoaxis_opt_t,histoaxis_user_t,histoaxis_prog_t
  private
  !
  integer(kind=code_k), parameter :: code_kind_default = 1
  integer(kind=4), parameter :: nkinds = 3
  character(len=argu_l), parameter :: kinds(nkinds)=&
       ['*          ',&
        'LINEAR     ',&
        'LOGARITHMIC']
  !
  integer(kind=code_k), parameter :: code_method_default = 3
  integer(kind=4), parameter :: nmethods = 4
  character(len=argu_l), parameter :: methods(nmethods)=&
       ['*      ',&
        'SQRT   ',&
        'STURGES',&
        'RICE   ']
  !
  type histoaxis_opt_t
     type(option_t),      pointer :: opt
     type(keyword_arg_t), pointer :: nbin
   contains
     procedure :: register => cubestatistics_histoaxis_register
     procedure :: parse    => cubestatistics_histoaxis_parse
  end type histoaxis_opt_t
  !
  type histoaxis_user_t
     logical               :: do = .false.      ! Option was present
     character(len=argu_l) :: kind = strg_star  ! Linear or logarithmic histoaxis?
     character(len=argu_l) :: nbin = strg_star  ! Number of bin
     character(len=argu_l) :: range(2) = [strg_star,strg_star] ! Axis range
   contains
     procedure :: toprog => cubestatistics_histoaxis_user_toprog
  end type histoaxis_user_t
  !
  type histoaxis_prog_t
     logical               :: dolog = .false.
     character(len=argu_l) :: method
     integer(kind=data_k)  :: n
     real(kind=coor_k)     :: min
     real(kind=coor_k)     :: max
     real(kind=coor_k)     :: inc
   contains
     procedure :: list => cubestatistics_histoaxis_prog_list
  end type histoaxis_prog_t
  !
contains
  !
  subroutine cubestatistics_histoaxis_register(option,name,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(histoaxis_opt_t), intent(out)   :: option
    character(len=*),       intent(in)    :: name
    logical,                intent(inout) :: error
    !
    type(standard_arg_t) :: stdarg
    type(keyword_arg_t)  :: keyarg
    character(len=*), parameter :: rname='HISTOAXIS>REGISTER'
    !
    call cubestatistics_message(statisticsseve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         trim(name)//'AXIS','[lin [nbin min max] | log [nbin max dyn]]',&
         'Define a regular sampling of the '//trim(name)//' axis',&
         strg_id,&
         option%opt,error)
    call stdarg%register(&
         trim(name)//'KIND',&
         'Linear or logarithmic axis',&
         strg_id,&
         code_arg_optional,&
         error)
    call keyarg%register(&
         trim(name)//'NBIN',&
         'Number of bins or method to determine it',&
         strg_id,&
         code_arg_optional,&
         methods, &
         flexible, &
         option%nbin, &
         error)
    call stdarg%register(&
         trim(name)//'RANGE1',&
         'Minimum or maximum for a linear or logarithmic axis, respectively',&
         strg_id,&
         code_arg_optional,&
         error)
    call stdarg%register(&
         trim(name)//'RANGE2',&
         'Maximum or dynamical range for a linear or logarithmic axis, respectively',&
         strg_id,&
         code_arg_optional,&
         error)
  end subroutine cubestatistics_histoaxis_register
  !
  subroutine cubestatistics_histoaxis_parse(option,line,user,error)
    use cubetools_structure
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(histoaxis_opt_t), intent(in)    :: option
    character(len=*),       intent(in)    :: line
    type(histoaxis_user_t), intent(inout) :: user
    logical,                intent(inout) :: error    
    !
    character(len=*), parameter :: rname='HISTOAXIS>PARSE'
    !
    call cubestatistics_message(statisticsseve%trace,rname,'Welcome')
    !
    call option%opt%present(line,user%do,error)
    if (error) return
    if (user%do) then
       call cubetools_getarg(line,option%opt,1,user%kind,mandatory,error)
       if (error) return
       call cubetools_getarg(line,option%opt,2,user%nbin,mandatory,error)
       if (error) return
       call cubetools_getarg(line,option%opt,3,user%range(1),mandatory,error)
       if (error) return
       call cubetools_getarg(line,option%opt,4,user%range(2),mandatory,error)
       if (error) return
    endif
  end subroutine cubestatistics_histoaxis_parse
  !
  subroutine cubestatistics_histoaxis_user_toprog(user,option,cube,prog,error)
    use cube_types
    use cubetools_arrelt_types
    use cubetools_header_methods
    use cubetools_keyword_arg
    !----------------------------------------------------------------------
    ! The number of good data (ngood) is only an approximation to the real
    ! size of the data to be put into the histogram as we can't know a
    ! priori how many data points will be excluded for being outside the
    ! user defined range.
    !----------------------------------------------------------------------
    class(histoaxis_user_t), intent(in)    :: user
    type(histoaxis_opt_t),   intent(in)    :: option
    type(cube_t),            intent(in)    :: cube
    type(histoaxis_prog_t),  intent(inout) :: prog
    logical,                 intent(inout) :: error
    !
    integer(kind=data_k) :: ngood
    type(arrelt_t) :: cubemin,cubemax
    character(len=*), parameter :: rname='HISTOAXIS>USER>TOPROG'
    !
    call cubestatistics_message(statisticsseve%trace,rname,'Welcome')
    !
    call cubetools_header_get_array_minmax(cube%head,cubemin,cubemax,error)
    if (error) return
    call cubestatistics_histoaxis_user_range2minmax(&
         real(cubemin%val,kind=coor_k),&
         real(cubemax%val,kind=coor_k),&
         user%kind,user%range,&
         prog%dolog,prog%min,prog%max,error)
    if (error) return
    call cubetools_header_get_array_ngood(cube%head,ngood,error)
    if (error) return
    call cubestatistics_histoaxis_user_nbin_user2prog(ngood,option%nbin,user%nbin,&
         prog%method,prog%n,error)
    if (error) return
    prog%inc = (prog%max-prog%min)/prog%n
  end subroutine cubestatistics_histoaxis_user_toprog
  !
  subroutine cubestatistics_histoaxis_user_range2minmax(cubemin,cubemax,userkind,range,dolog,min,max,error)
    use cubetools_disambiguate
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    real(kind=coor_k), intent(in)    :: cubemin
    real(kind=coor_k), intent(in)    :: cubemax
    character(len=*),  intent(in)    :: userkind
    character(len=*),  intent(in)    :: range(2)
    logical,           intent(out)   :: dolog
    real(kind=coor_k), intent(out)   :: min
    real(kind=coor_k), intent(out)   :: max
    logical,           intent(inout) :: error
    !
    real(kind=coor_k), parameter :: margin = 0.0 ! 10% of margin
    real(kind=coor_k) :: defmin,defmax,defdyn,dyn,myrange
    integer(kind=4) :: ikey
    character(len=argu_l) :: progkind
    character(len=*), parameter :: rname='HISTOAXIS>USER>RANGE2MINMAX'
    !
    call cubestatistics_message(statisticsseve%trace,rname,'Welcome')
    !
    call cubetools_disambiguate_strict(userkind,kinds,ikey,progkind,error)
    if (error) return
    !
    defmin = cubemin
    defmax = cubemax
    select case(progkind)
    case('LINEAR',strg_star)
       dolog = .false.
       myrange = defmax-defmin
       defmin = defmin-margin*myrange
       defmax = defmax+margin*myrange
       call cubestatistics_histoaxis_user_value_user2prog(range(1),defmin,min,error)
       if (error) return
       call cubestatistics_histoaxis_user_value_user2prog(range(2),defmax,max,error)
       if (error) return
    case('LOGARITHMIC')
       dolog = .true.
       defmax = defmax*(1.0+margin)
       if (defmin.gt.0) then
          defdyn = defmax/defmin
       else
          defdyn = 1d6
       endif
       call cubestatistics_histoaxis_user_value_user2prog(range(1),defmax,max,error)
       if (error) return
       call cubestatistics_histoaxis_user_value_user2prog(range(2),defdyn,dyn,error)
       if (error) return
       if (max.gt.0) then
          max = log10(max)
       else
          call cubestatistics_message(seve%e,rname,'Maximum of a logarithmic axis must be positive')
          error = .true.
          return
       endif
       if (dyn.gt.0) then
          dyn = log10(dyn)
       else
          call cubestatistics_message(seve%e,rname,'Dynamic range of a logarithmic axis must be positive')
          error = .true.
          return
       endif
       min = max-dyn
    case default
       call cubestatistics_message(seve%e,rname,'Unknown histogram axis kind: '//trim(progkind))
       error = .true.
       return
    end select
  end subroutine cubestatistics_histoaxis_user_range2minmax
  !
  subroutine cubestatistics_histoaxis_user_value_user2prog(user,default,value,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*),  intent(in)    :: user
    real(kind=coor_k), intent(in)    :: default
    real(kind=coor_k), intent(out)   :: value
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='HISTOAXIS>USER>VALUE>USER2PROG'
    !
    call cubestatistics_message(statisticsseve%trace,rname,'Welcome')
    !
    if (user.eq.strg_star) then
       value = default
    else
       call sic_math_dble(user,argu_l,value,error)
       if (error) return
    endif
  end subroutine cubestatistics_histoaxis_user_value_user2prog
  !
  subroutine cubestatistics_histoaxis_user_nbin_user2prog(ndata,nbin_arg,user,method,nbin,error)
    use cubetools_keyword_arg
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    integer(kind=data_k),  intent(in)    :: ndata
    type(keyword_arg_t),   intent(in)    :: nbin_arg
    character(len=*),      intent(in)    :: user
    character(len=argu_l), intent(out)   :: method
    integer(kind=data_k),  intent(out)   :: nbin
    logical,               intent(inout) :: error
    !
    integer(kind=4) :: nc,ikey,nbin_i4
    character(len=*), parameter :: rname='HISTOAXIS>USER>NBIN>USER2PROG'
    !
    call cubestatistics_message(statisticsseve%trace,rname,'Welcome')
    !
    call cubetools_keyword_user2prog(nbin_arg,user,ikey,method,error)
    if (error) return
    if (method.eq.strg_unresolved) then
       method = 'USER INPUT'
    endif
    !
    select case(method)
    case('USER INPUT')
       nc = len(trim(user))
       call sic_math_inte(trim(user),nc,nbin_i4,error)
       if (error) return
       nbin = int(nbin_i4,kind=data_k)
    case('SQRT')
       nbin = ceiling(sqrt(1.0*ndata))
    case('STURGES')
       ! R default
       method = 'STURGES'
       nbin = ceiling(log(1.0*ndata))+1
    case('RICE',strg_star)
       nbin = ceiling(2*(1.0*ndata)**(1/3.))
    case default
       call cubestatistics_message(seve%e,rname,'Unknown method for defining nbin: '//trim(method))
       error = .true.
       return
    end select
    if (nbin.lt.1) then
       call cubestatistics_message(seve%e,rname,'Number of bins must be greater than 0')
       error = .true.
       return
    endif
  end subroutine cubestatistics_histoaxis_user_nbin_user2prog
  !
  subroutine cubestatistics_histoaxis_prog_list(prog,error)
    use cubetools_format
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(histoaxis_prog_t), intent(inout) :: prog
    logical,                 intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='HISTOAXIS>PROG>LIST'
    !
    call cubestatistics_message(statisticsseve%trace,rname,'Welcome')
    !
    write(mess,'(2x,a,i0,a,a,a,'//fsimple//',a,'//fsimple//',a,'//fsimple//')') &
         'Axis: ',prog%n,' bins (Method: ',trim(prog%method),&
         ') from ',prog%min,' to ',prog%max, ' by ',prog%inc
    call cubestatistics_message(seve%r,rname,mess)
  end subroutine cubestatistics_histoaxis_prog_list
end module cubestatistics_histoaxis_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
