!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_noise_types
  use cubetools_parameters
  use cubeheader_messaging
  use cubetools_consistency_types
  use cubetools_structure
  !
  public :: noise_t,noise_user_t,noise_cons_t,noise_opt_t
  public :: cubetools_array_noise2userstruct
  !
  public :: cubetools_noise_init,cubetools_noise_get_and_derive
  public :: cubetools_noise_final,cubetools_noise_put
  public :: cubetools_noise_list,cubetools_noise_sicdef,cubetools_noise_copy
  public :: cubetools_noise_consistency_init,cubetools_noise_consistency_final
  public :: cubetools_noise_consistency_check,cubetools_noise_consistency_list
  private
  !
  type noise_t
     real(kind=sign_k) :: sigma = 0.0
     real(kind=sign_k) :: rms  = 0.0
  end type noise_t
  !
  type noise_opt_t
     type(option_t), pointer :: opt
   contains
     procedure :: register  => cubetools_noise_register
     procedure :: parse     => cubetools_noise_parse
     procedure :: user2prog => cubetools_noise_user2prog
  end type noise_opt_t
  !
  type noise_user_t
     character(len=argu_l) :: sigma = strg_unk ! [ ] Theoretical noise
     character(len=argu_l) :: rms   = strg_unk ! [ ] Measured noise
     logical               :: do    = .false.  ! Option was present
  end type noise_user_t
  !
  type noise_cons_t
     logical                  :: check=.true.    ! Check the section
     logical                  :: prob =.false.   ! Is there a problem
     logical                  :: mess =.true.    ! Output message for this section?
     type(consistency_desc_t) :: sigma
     type(consistency_desc_t) :: rms
  end type noise_cons_t
contains
  !
  subroutine cubetools_noise_init(noise,error)
    !-------------------------------------------------------------------
    ! Just initialize the type
    !-------------------------------------------------------------------
    type(noise_t), intent(out)   :: noise
    logical,       intent(inout) :: error
    !
    character(len=*), parameter :: rname='NOISE>INIT'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
  end subroutine cubetools_noise_init
  !
  subroutine cubetools_noise_get_and_derive(sigma,rms,noi,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    real(kind=sign_k), intent(in)    :: sigma
    real(kind=sign_k), intent(in)    :: rms
    type(noise_t),     intent(inout) :: noi
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='GENERAL>GET>AND>DERIVE'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    noi%sigma = sigma
    noi%rms   = rms
  end subroutine cubetools_noise_get_and_derive
  !
  subroutine cubetools_noise_put(noi,sigma,rms,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(noise_t),     intent(in)    :: noi
    real(kind=sign_k), intent(out)   :: sigma
    real(kind=sign_k), intent(out)   :: rms
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='NOISE>PUT'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    sigma = noi%sigma
    rms   = noi%rms
  end subroutine cubetools_noise_put
  !
  subroutine cubetools_noise_final(noise,error)
    !-------------------------------------------------------------------
    !  Just reinitialize the type
    !-------------------------------------------------------------------
    type(noise_t), intent(out)   :: noise
    logical,       intent(inout) :: error
    !
    character(len=*), parameter :: rname='NOISE>FINAL'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
  end subroutine cubetools_noise_final
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_noise_register(noise,abstract,error)
    !----------------------------------------------------------------------
    ! Register a /NOISE option under a given name and abstract
    !----------------------------------------------------------------------
    class(noise_opt_t), intent(out)   :: noise
    character(len=*),   intent(in)    :: abstract
    logical,            intent(inout) :: error
    !
    type(standard_arg_t) :: stdarg
    !
    character(len=*), parameter :: rname='NOISE>REGISTER'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         'NOISE','sigma rms',&
         abstract,&
         strg_emp, &
         noise%opt,error)
    if (error) return
    call stdarg%register( &
         'SIGMA',  &
         'Theoretical noise', &
         '"*" or "=" mean previous value is kept',&
         code_arg_mandatory, &
         error)
    if (error) return
    call stdarg%register( &
         'RMS',  &
         'Measured noise', &
         '"*" or "=" mean previous value is kept',&
         code_arg_mandatory, &
         error)
    if (error) return
  end subroutine cubetools_noise_register
  !
  subroutine cubetools_noise_parse(noise,line,user,error)
    !----------------------------------------------------------------------
    ! Parse noise
    ! /NOISE major [minor [pang [pangunit]]]
    ! ----------------------------------------------------------------------
    class(noise_opt_t), intent(in)    :: noise
    character(len=*),   intent(in)    :: line
    type(noise_user_t), intent(inout) :: user
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='NOISE>PARSE'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    user%sigma = strg_star
    user%rms   = strg_star
    !
    call noise%opt%present(line,user%do,error)
    if (error) return
    if (user%do) then
       call cubetools_getarg(line,noise%opt,1,user%sigma,mandatory,error)
       if (error) return
       call cubetools_getarg(line,noise%opt,2,user%rms,mandatory,error)
       if (error) return
    endif
  end subroutine cubetools_noise_parse
  !
  subroutine cubetools_noise_user2prog(noise,user,prog,error)
    use cubetools_unit
    use cubetools_user2prog
    !----------------------------------------------------------------------
    ! Resolves a noise description based on a previous one according to
    ! user inputs.
    !----------------------------------------------------------------------
    class(noise_opt_t), intent(in)    :: noise
    type(noise_user_t), intent(in)    :: user
    type(noise_t),      intent(inout) :: prog
    logical,            intent(inout) :: error
    !
    type(unit_user_t) :: userunit
    real(kind=sign_k) :: default,previous
    character(len=*), parameter :: rname='NOISE>USER2PROG'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (user%do) then
       call userunit%get_from_code(code_unit_unk,error)
       if (error) return
       !
       default = prog%sigma
       previous = prog%sigma
       call cubetools_user2prog_resolve_all(user%sigma,userunit,default,previous,prog%sigma,error)
       if (error) return
       if (prog%sigma.lt.0.) then
          call cubeheader_message(seve%e,rname,'Theoretical noise can not be negative')
          error = .true.
          return
       endif
       default = prog%rms
       previous = prog%rms
       call cubetools_user2prog_resolve_all(user%rms,userunit,default,previous,prog%rms,error)
       if (error) return
       if (prog%rms.lt.0.) then
          call cubeheader_message(seve%e,rname,'Measured noise can not be negative')
          error = .true.
          return
       endif
    else ! .not.user%do
       continue
    endif
  end subroutine cubetools_noise_user2prog
  !
  subroutine cubetools_noise_prog2user(prog,user,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    type(noise_t),      intent(in)    :: prog
    type(noise_user_t), intent(out)   :: user
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='NOISE>PROG2USER'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    write(user%sigma,'(1pg14.7)') prog%sigma
    write(user%rms,  '(1pg14.7)') prog%rms
  end subroutine cubetools_noise_prog2user
  !
  subroutine cubetools_array_noise2userstruct(prog,userstruct,error)
    use cubetools_userspace
    use cubetools_userstruct
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    type(noise_t),      intent(in)    :: prog
    type(userstruct_t), intent(inout) :: userstruct
    logical,            intent(inout) :: error
    !
    type(noise_user_t) :: user
    character(len=*), parameter :: rname='ARRAY>NOISE2USERSTRUCT'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_noise_prog2user(prog,user,error)
    if (error) return
    call userstruct%def(error)
    if (error) return
    call userstruct%set_member('sigma',user%sigma,error)
    if (error) return
    call userstruct%set_member('rms',user%rms,error)
    if (error) return
  end subroutine cubetools_array_noise2userstruct
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_noise_list(noise,error)
    use cubetools_format
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(noise_t), intent(in)    :: noise
    logical,       intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='NOISE>LIST'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    mess = cubetools_format_stdkey_boldval('Sigma',noise%sigma,'f15.8',22)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('RMS',noise%rms,'f15.8',22)
    call cubeheader_message(seve%r,rname,mess)
  end subroutine cubetools_noise_list
  !
  subroutine cubetools_noise_sicdef(name,noise,readonly,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: name
    type(noise_t),    intent(in)    :: noise
    logical,          intent(in)    :: readonly
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='NOISE>SICDEF'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call sic_defstructure(name,global,error)
    if (error) return
    call sic_def_real(trim(name)//'%sigma',noise%sigma,0,0,readonly,error)
    if (error) return
    call sic_def_real(trim(name)//'%rms',noise%rms,0,0,readonly,error)
    if (error) return
  end subroutine cubetools_noise_sicdef
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_noise_copy(in,ou,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(noise_t), intent(in)    :: in
    type(noise_t), intent(out)   :: ou
    logical,       intent(inout) :: error
    !
    character(len=*), parameter :: rname='NOISE>COPY'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    ou = in
  end subroutine cubetools_noise_copy
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_noise_consistency_init(cons,error)
    !-------------------------------------------------------------------
    ! Init the consistency between noise sections
    !-------------------------------------------------------------------
    type(noise_cons_t), intent(out)   :: cons
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>NOISE>CONSISTENCY>INIT'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_init(strict,check,mess,cons%sigma,error)
    if (error) return
    call cubetools_consistency_init(strict,check,mess,cons%rms,error)
    if (error) return
    !
  end subroutine cubetools_noise_consistency_init
  !
  subroutine cubetools_noise_consistency_check(cons,noise1,noise2,error)
    !-------------------------------------------------------------------
    ! Check the consistency between noise sections
    !-------------------------------------------------------------------
    type(noise_cons_t), intent(inout) :: cons
    type(noise_t),      intent(in)    :: noise1
    type(noise_t),      intent(in)    :: noise2
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>NOISE>CONSISTENCY>CHECK'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    cons%prob = .false.
    call cubetools_consistency_real_check(cons%sigma,noise1%sigma,noise2%sigma,error)
    if (error) return
    call cubetools_consistency_real_check(cons%rms,noise1%rms,noise2%rms,error)
    if (error) return
    !
    cons%prob = cons%sigma%prob.or.cons%rms%prob
  end subroutine cubetools_noise_consistency_check
  !
  subroutine cubetools_noise_consistency_list(unit1,unit2,cons,noise1,noise2,error)
    !-------------------------------------------------------------------
    ! List the consistency between noise sections
    !-------------------------------------------------------------------
    character(len=*),   intent(in)    :: unit1
    character(len=*),   intent(in)    :: unit2
    type(noise_cons_t), intent(in)    :: cons
    type(noise_t),      intent(in)    :: noise1
    type(noise_t),      intent(in)    :: noise2
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>NOISE>CONSISTENCY>LIST'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check.or..not.cons%mess.or..not.cons%prob) return
    !
    if (.not.cons%mess) return
    !
    call cubetools_consistency_title('noises',3,cons%check,cons%prob,error)
    if (error) return
    if (cons%check.and.cons%prob) then
       call cubetools_consistency_real_print('Sigmas',unit1,unit2,cons%sigma,noise1%sigma,noise2%sigma,error)
       if (error) return
       call cubetools_consistency_real_print('RMS',unit1,unit2,cons%rms,noise1%rms,noise2%rms,error)
       if (error) return
    endif
    call cubeheader_message(seve%r,rname,'')
  end subroutine cubetools_noise_consistency_list
  !
  subroutine cubetools_noise_consistency_final(cons,error)
    !-------------------------------------------------------------------
    ! Final the consistency between noise sections
    !-------------------------------------------------------------------
    type(noise_cons_t), intent(out)   :: cons
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>NOISE>CONSISTENCY>FINAL'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_final(cons%sigma,error)
    if (error) return
    call cubetools_consistency_final(cons%rms,error)
    if (error) return
    !
  end subroutine cubetools_noise_consistency_final
end module cubetools_noise_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
