!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
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
    !
    character(len=*), parameter :: comm_abstract = &
       'Check the consistency between two cube headers'
    character(len=*), parameter :: comm_help = &
         'The consistency is divided into 4 sections. The SPATIAL, and&
         & SPECTRAL sections describe the spatial and spectral&
         & characterstics of the cube, respectively. The ARRAY and&
         & OBSERVATORY sections describe the characteristics of the data&
         & array and used telescope, respectively.'
    !
    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','[cube1 cube2]',&
         comm_abstract,&
         comm_help,&
         cubemain_consistency_command,&
         consistency%comm,error)
    if (error) return
    call cubearg%register(&
         'CUBE1',&
         'First cube', &
         strg_id,&
         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(&
         'CUBE2',&
         'Second cube', &
         strg_id,&
         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',&
         'Set which consistency check(s) will be ignored',&
         strg_id,&
         consistency%nocheck,&
         error)
    if (error) return
    call keyarg%register(&
         'section', &
         'Section(s) to be ignored in consistency check',&
         strg_id,&
         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',&
         strg_id,&
         consistency%tolerance,&
         error) 
    if (error) return
    call keyarg%register(&
         'SECTION', &
         'Section(s) that will have a modified tolerance',&
         strg_id,&
         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',&
         strg_id,&
         consistency%index,&
         error)
    if (error) return
  end subroutine cubemain_consistency_register
  !
  subroutine cubemain_consistency_parse(consistency,line,user,error) 
    !---------------------------------------------------------------------
    ! CONSISTENCY cub1 cub2
    ! /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
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
