!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_consistency
  use cubetools_parameters
  use cubetools_structure
  use cubetools_keywordlist_types
  use cube_types
  use cubeadm_cubeid_types
  use cubeadm_index
  use cubemain_messaging
  !
  public :: consistency
  private
  !
  integer(kind=4), parameter :: nsection = 4
  integer(kind=4), parameter :: sect_l = 12
  character(len=sect_l), parameter :: sections(nsection) = [&
       'SPATIAL    ',&
       'SPECTRAL   ',&
       'ARRAY      ',&
       'OBSERVATORY']
  integer(kind=4), parameter :: ispa = 1
  integer(kind=4), parameter :: ispe = 2
  integer(kind=4), parameter :: iarr = 3
  integer(kind=4), parameter :: iobs = 4
  !
  integer(kind=4), parameter :: ntol = 3
  character(len=*), parameter :: tole(ntol) = [&
       'SPATIAL ',&
       'SPECTRAL',&
       'BEAM    ']
  integer(kind=4), parameter :: itolspa = 1
  integer(kind=4), parameter :: itolspe = 2
  integer(kind=4), parameter :: itolbea = 3
  !
  type :: cons_comm_t
     type(option_t),      pointer :: comm
     type(option_t),      pointer :: nocheck
     type(keywordlist_comm_t), pointer :: nocheck_arg
     type(option_t),      pointer :: tolerance
     type(keywordlist_comm_t), pointer :: tole_arg
     type(option_t),      pointer :: index
   contains
     procedure, public  :: register        => cubemain_consistency_register
     procedure, private :: parse           => cubemain_consistency_parse
     procedure, private :: parse_names     => cubemain_consistency_parse_names
     procedure, private :: parse_nocheck   => cubemain_consistency_parse_nocheck
     procedure, private :: parse_tolerance => cubemain_consistency_parse_tolerance
     procedure, private :: main            => cubemain_consistency_main
  end type cons_comm_t
  type(cons_comm_t) :: consistency
  !
  type cons_user_t
     type(cubeid_user_t)   :: cubeids
     logical               :: check(nsection) = .true.
     character(len=argu_l) :: tol(ntol) = strg_unk     ! Tolerances
     logical               :: doindex
   contains
     procedure, private :: toprog => cubemain_consistency_user_toprog
  end type cons_user_t
  type cons_prog_t
     type(index_t)                     :: index            ! Index of cubes to be compared
     real(kind=8)                      :: tol(ntol) = 1d-1 ! Default tolerance
     logical                           :: check(nsection) = .true.
   contains
     procedure, private :: do => cubemain_consistency_prog_do
  end type cons_prog_t
  !
contains
  !
  subroutine cubemain_consistency_command(line,error) 
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(cons_user_t) :: user
    character(len=*), parameter :: rname='CONSISTENCY'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call consistency%parse(line,user,error)
    if (error) return
    call consistency%main(user,error)
    if (error) return
  end subroutine cubemain_consistency_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_consistency_register(consistency,error)
    use cubedag_allflags
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    class(cons_comm_t), intent(inout) :: consistency
    logical,            intent(inout) :: error
    !
    !
    type(cubeid_arg_t)   :: cubearg
    type(cubeid_arg_t), pointer :: dummy
    type(standard_arg_t) :: stdarg
    type(keywordlist_comm_t)  :: keyarg
    character(len=*), parameter :: rname='CONSISTENCY>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'CONSISTENCY','[cubeid1 cubeid2]',&
         'Check the consistency between two cube headers',&
         'CONSISTENCY checks header consistency either between two cubes or&
         & across the current index.'//strg_bl//&
         'Behavior:'//strg_cr//&
         '- Without /INDEX, CONSISTENCY compares two cube headers (explicit&
         & cube arguments or index fallback).'//strg_cr//&
         '- With /INDEX, CONSISTENCY checks cubes from the current index.'//strg_cr//&
         '- Available sections are SPATIAL, SPECTRAL, ARRAY, and OBSERVATORY;&
         & /NOCHECK disables selected sections.'//strg_cr//&
         '- /TOLERANCE customizes percent thresholds for SPECTRAL, SPATIAL,&
         & and BEAM checks. Default tolerance is 10%. '//strg_bl//&
         'Examples:'//strg_cr//&
         'CUBE> CONSISTENCY cubeA cubeB'//strg_cr//&
         'CUBE> CONSISTENCY cubeA cubeB /NOCHECK ARRAY'//strg_cr//&
         'CUBE> CONSISTENCY /INDEX /TOLERANCE SPATIAL 5 SPECTRAL 5',&
         cubemain_consistency_command,&
         consistency%comm,error)
    if (error) return
    call cubearg%register(&
         'CUBEID1',&
         'Identifier of cube #1',&
         'If omitted, use the last matching cube (any family/flags) in the&
         & default index (DAG by default; see SET\INDEX).',&
         code_arg_optional,&
         [flag_any],&
         code_read_head,&
         code_access_imaset_or_speset,&
         dummy,&! Pointer not saved, will use consistency%comm%arg%list(:)
         error)
    if (error) return
    call cubearg%register(&
         'CUBEID2',&
         'Identifier of cube #2',&
         'If omitted, use the last matching cube (any family/flags) in the&
         & default index (DAG by default; see SET\INDEX).',&
         code_arg_optional,&
         [flag_any],&
         code_read_head,&
         code_access_imaset_or_speset,&
         dummy,&! Pointer not saved, will use consistency%comm%arg%list(:)
         error)
    if (error) return
    ! 
    call cubetools_register_option(&
         'NOCHECK','section',&
         'Select consistency section(s) to skip',&
         'Disable selected consistency sections.'//strg_cr//&
         'Accepted sections are SPATIAL, SPECTRAL, ARRAY, and OBSERVATORY.',&
         consistency%nocheck,&
         error)
    if (error) return
    call keyarg%register(&
         'SECTION',&
         'Section(s) to skip in consistency check',&
         'Accepted values: SPATIAL, SPECTRAL, ARRAY, OBSERVATORY.',&
         code_arg_unlimited,&
         sections,&
         .not.flexible,&
         consistency%nocheck_arg,&
         error)
    if (error) return
    ! 
    call cubetools_register_option(&
         'TOLERANCE','[SPECTRAL Tol] [SPATIAL Tol] [BEAM Tol]',&
         'Customize the tolerance on parameters consistency',&
         'Set custom tolerances in percent for SPECTRAL, SPATIAL, and BEAM&
         & consistency checks.'//strg_cr//&
         'Default is 10% for all tolerance-enabled sections.',&
         consistency%tolerance,&
         error) 
    if (error) return
    call keyarg%register(&
         'SECTION',&
         'Section(s) that will have a modified tolerance',&
         'Accepted values: SPECTRAL, SPATIAL, BEAM.',&
         code_arg_unlimited,&
         tole,&
         .not.flexible,&
         consistency%tole_arg,&
         error)
    if (error) return
    call stdarg%register(&
         'TOL',&
         'New tolerance for a given section, in percent',&
         'Default is 10%.',&
         code_arg_unlimited,&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'INDEX','',&
         'Check consistency between cubes in the current index',&
         'Run consistency checks on cubes from the current index instead of an&
         & explicit two-cube comparison.',&
         consistency%index,&
         error)
    if (error) return
  end subroutine cubemain_consistency_register
  !
  subroutine cubemain_consistency_parse(consistency,line,user,error) 
    !---------------------------------------------------------------------
    ! CONSISTENCY [cube1 cube2]
    ! /INDEX
    ! /NOCHECK [SPATIAL|SPECTRAL|ARRAY|OBSERVATORY]
    ! /TOLERANCE [SPECTRAL Tol] [SPATIAL Tol] [BEAM Tol]
    !---------------------------------------------------------------------
    class(cons_comm_t), intent(in)    :: consistency
    character(len=*),   intent(in)    :: line
    type(cons_user_t),  intent(out)   :: user
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call consistency%parse_nocheck(line,user,error)
    if (error) return
    call consistency%parse_tolerance(line,user,error)
    if (error) return
    call consistency%index%present(line,user%doindex,error)
    if (error) return
    if (.not.user%doindex) then
       call consistency%parse_names(line,user,error)
       if (error) return
    endif
  end subroutine cubemain_consistency_parse
  !
  subroutine cubemain_consistency_parse_names(consistency,line,user,error)
    !---------------------------------------------------------------------
    ! CONSISTENCY cub1 cub2
    !---------------------------------------------------------------------
    class(cons_comm_t), intent(in)    :: consistency
    character(len=*),   intent(in)    :: line
    type(cons_user_t),  intent(inout) :: user
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>PARSE>NAMES'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,consistency%comm,user%cubeids,error)
    if (error) return
  end subroutine cubemain_consistency_parse_names
  !
  subroutine cubemain_consistency_parse_nocheck(consistency,line,user,error)
    !---------------------------------------------------------------------
    ! /NOCHECK [SPATIAL|SPECTRAL|ARRAY|OBSERVATORY]
    !---------------------------------------------------------------------
    class(cons_comm_t), intent(in)    :: consistency
    character(len=*),   intent(in)    :: line
    type(cons_user_t),  intent(inout) :: user
    logical,            intent(inout) :: error
    !
    integer(kind=4) :: narg, iarg,ikey
    character(len=argu_l) :: arg,key
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='CONSISTENCY>PARSE>NOCHECK'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    narg = consistency%nocheck%getnarg()
    if (narg.gt.nsection) then
       write(mess,'(a,i0,a)') 'Only ',nsection,' sections available'
       call cubemain_message(seve%e,rname,mess)
       error = .true.
       return
    endif
    !
    do iarg = 1, narg
       call cubetools_getarg(line,consistency%nocheck,iarg,arg,mandatory,error)
       if (error) return
       call cubetools_keywordlist_user2prog(consistency%nocheck_arg,arg,ikey,key,error)
       if (error) return
       user%check(ikey) = .false.
    enddo
  end subroutine cubemain_consistency_parse_nocheck
  !
  subroutine cubemain_consistency_parse_tolerance(consistency,line,user,error)
    !---------------------------------------------------------------------
    ! /TOLERANCE [SPECTRAL Tol] [SPATIAL Tol] [BEAM Tol]
    !---------------------------------------------------------------------
    class(cons_comm_t), intent(in)    :: consistency
    character(len=*),   intent(in)    :: line
    type(cons_user_t),  intent(inout) :: user
    logical,            intent(inout) :: error
    !
    integer(kind=4) :: narg, iarg,ikey
    character(len=argu_l) :: arg,key
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='CONSISTENCY>PARSE>TOLERANCE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    narg = consistency%tolerance%getnarg()
    if (narg.gt.2*ntol) then
       write(mess,'(a,i0,a)') 'Only ',ntol,' sections available'
       call cubemain_message(seve%e,rname,mess)
       error = .true.
       return
    endif
    !
    user%tol(:) = strg_star
    do iarg = 1,narg,2
       call cubetools_getarg(line,consistency%tolerance,iarg,arg,mandatory,error)
       if (error) return
       call cubetools_keywordlist_user2prog(consistency%tole_arg,arg,ikey,key,error)
       if (error) return
       call cubetools_getarg(line,consistency%tolerance,iarg+1,user%tol(ikey),mandatory,error)
       if (error) return
    enddo
  end subroutine cubemain_consistency_parse_tolerance
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_consistency_main(consistency,user,error)
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    class(cons_comm_t), intent(in)    :: consistency
    type(cons_user_t),  intent(in)    :: user
    logical,            intent(inout) :: error
    !
    type(cons_prog_t) :: prog
    character(len=*), parameter :: rname='CONSISTENCY>MAIN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call user%toprog(prog,error)
    if (error) return
    call prog%do(error)
    if (error) return
  end subroutine cubemain_consistency_main
  !
  subroutine cubemain_consistency_user_toprog(user,prog,error)
    use gkernel_interfaces
    use cubetools_consistency_types
    use cubetools_user2prog
    use cubetools_unit
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    class(cons_user_t), intent(in)    :: user
    type(cons_prog_t),  intent(out)   :: prog
    logical,            intent(inout) :: error
    !
    integer(kind=4) :: itol
    type(unit_user_t) :: nounit
    real(kind=8), parameter :: deftol = 2*tenper
    character(len=*), parameter :: rname='CONSISTENCY>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    if (user%doindex) then
       call prog%index%get_from_current(code_access_imaset_or_speset,code_read_head,error)
       if (error) return
    else
       call prog%index%get_from_cubeid(consistency%comm,user%cubeids,error)
       if (error) return
    endif
    !
    ! What sections are to be checked
    prog%check(:) = user%check(:)
    !
    call nounit%get_from_code(code_unit_unk,error)
    if (error) return
    do itol=1,ntol
       call cubetools_user2prog_resolve_star(user%tol(itol),nounit,deftol,prog%tol(itol),error)
       if (error) return
       ! Convert from percentage to deviation from mean
       prog%tol(itol) = prog%tol(itol)/2d2
    enddo
  end subroutine cubemain_consistency_user_toprog
  !
  subroutine cubemain_consistency_prog_do(prog,error)
    use cubeadm_consistency
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    class(cons_prog_t), intent(in)    :: prog
    logical,            intent(inout) :: error
    !
    type(consistency_t) :: cons
    character(len=*), parameter :: rname='CONSISTENCY>PROG>DO'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cons%init(prog%index,error)
    if (error) return
    call cons%set_sections(prog%check(ispa),prog%check(ispe),prog%check(iarr),prog%check(iobs),error)
    if (error) return
    call cons%set_tolerance(prog%tol(itolspa),prog%tol(itolbea),prog%tol(itolspe),error)
    if (error) return
    !
    call cons%check(error)
    if (error) return
    !
  end subroutine cubemain_consistency_prog_do
end module cubemain_consistency
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
