!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_consistency_methods
  use cubetools_header_types
  use cubeheader_messaging
  !
  public :: cubetools_consistency_failed,cubetools_consistency_shape
  public :: cubetools_consistency_grid,cubetools_consistency_spatial,cubetools_consistency_spectral
  public :: cubetools_consistency_observatory,cubetools_consistency_signal_noise
  private
  !
contains
  !
  subroutine cubetools_consistency_check(cons,name1,head1,name2,head2,problem,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    type(cube_header_cons_t), intent(inout) :: cons
    character(len=*),         intent(in)    :: name1
    type(cube_header_t),      intent(in)    :: head1
    character(len=*),         intent(in)    :: name2
    type(cube_header_t),      intent(in)    :: head2
    logical,                  intent(inout) :: problem
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>CHECK'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_header_consistency_check(cons,head1,head2,error)
    if (error) return
    problem = cons%prob .or. problem
    if (cons%prob) then
       call cubetools_header_consistency_list(cons,head1,head2,error)
       if (error) return
       call cubeheader_message(seve%w,rname,trim(name1)//' is inconsistent with '//trim(name2))
    endif
    call cubetools_header_consistency_final(cons,error)
    if (error) return
  end subroutine cubetools_consistency_check
  !
  subroutine cubetools_consistency_shape(name1,head1,name2,head2,problem,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    character(len=*),    intent(in)    :: name1
    type(cube_header_t), intent(in)    :: head1
    character(len=*),    intent(in)    :: name2
    type(cube_header_t), intent(in)    :: head2
    logical,             intent(inout) :: problem
    logical,             intent(inout) :: error
    !
    type(cube_header_cons_t) :: cons
    character(len=*), parameter :: rname='CONSISTENCY>GRID'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_header_consistency_init(cons,error)
    if (error) return
    cons%spa%check = .false.
    cons%spe%do = .false.
    cons%obs%check = .false.
    !
    cons%arr%noi%check   = .false.
    cons%arr%unit%check  = .false.
    cons%arr%min%check   = .false.
    cons%arr%max%check   = .false.
    cons%arr%n%nan%check = .false.
    ! *** JP The next one is a work around 2D vs degenerate 3D cubes
    cons%arr%n%dim%check = .false.
    ! *** JP The previous one is a work around 2D vs degenerate 3D cubes
    !
    call cubetools_consistency_check(cons,name1,head1,name2,head2,problem,error)
    if (error) return
  end subroutine cubetools_consistency_shape
  !
  subroutine cubetools_consistency_grid(name1,head1,name2,head2,problem,error)
    !------------------------------------------------------------------------
    ! Only check the shape of the array, including the number of data, and
    ! does not check the consistency of blanked (NaN) values.
    !------------------------------------------------------------------------
    character(len=*),    intent(in)    :: name1
    type(cube_header_t), intent(in)    :: head1
    character(len=*),    intent(in)    :: name2
    type(cube_header_t), intent(in)    :: head2
    logical,             intent(inout) :: problem
    logical,             intent(inout) :: error
    !
    type(cube_header_cons_t) :: cons
    character(len=*), parameter :: rname='CONSISTENCY>GRID'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_header_consistency_init(cons,error)
    if (error) return
    cons%obs%check       = .false.
    cons%arr%min%check   = .false.
    cons%arr%max%check   = .false.
    cons%arr%n%nan%check = .false.
    cons%spa%bea%check   = .false.
    !
    call cubetools_consistency_check(cons,name1,head1,name2,head2,problem,error)
    if (error) return
  end subroutine cubetools_consistency_grid
  !
  subroutine cubetools_consistency_spectral(name1,head1,name2,head2,problem,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    character(len=*),    intent(in)    :: name1
    type(cube_header_t), intent(in)    :: head1
    character(len=*),    intent(in)    :: name2
    type(cube_header_t), intent(in)    :: head2
    logical,             intent(inout) :: problem
    logical,             intent(inout) :: error
    !
    type(cube_header_cons_t) :: cons
    character(len=*), parameter :: rname='CONSISTENCY>SPECTRAL'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_header_consistency_init(cons,error)
    if (error) return
    cons%obs%check = .false.
    cons%arr%check = .false.
    cons%spa%check = .false.
    !
    call cubetools_consistency_check(cons,name1,head1,name2,head2,problem,error)
    if (error) return
  end subroutine cubetools_consistency_spectral
  !
  subroutine cubetools_consistency_spatial(name1,head1,name2,head2,problem,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    character(len=*),    intent(in)    :: name1
    type(cube_header_t), intent(in)    :: head1
    character(len=*),    intent(in)    :: name2
    type(cube_header_t), intent(in)    :: head2
    logical,             intent(inout) :: problem
    logical,             intent(inout) :: error
    !
    type(cube_header_cons_t) :: cons
    character(len=*), parameter :: rname='CONSISTENCY>SPATIAL'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_header_consistency_init(cons,error)
    if (error) return
    cons%obs%check = .false.
    cons%arr%check = .false.
    cons%spe%do = .false.
    ! *** JP Work-around the fact that we have not yet a way to nocheck the beam
    ! *** JP consistency as this is not stricto-censu needed to avoid segmentation
    ! *** JP faults.
    cons%spa%bea%check = .false.
    ! *** JP
    !
    call cubetools_consistency_check(cons,name1,head1,name2,head2,problem,error)
    if (error) return
  end subroutine cubetools_consistency_spatial
  !
  subroutine cubetools_consistency_observatory(name1,head1,name2,head2,problem,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    character(len=*),    intent(in)    :: name1
    type(cube_header_t), intent(in)    :: head1
    character(len=*),    intent(in)    :: name2
    type(cube_header_t), intent(in)    :: head2
    logical,             intent(inout) :: problem
    logical,             intent(inout) :: error
    !
    type(cube_header_cons_t) :: cons
    character(len=*), parameter :: rname='CONSISTENCY>OBSERVATORY'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_header_consistency_init(cons,error)
    if (error) return
    cons%arr%check = .false.
    cons%spe%do = .false.
    cons%spa%check = .false.
    !
    call cubetools_consistency_check(cons,name1,head1,name2,head2,problem,error)
    if (error) return
  end subroutine cubetools_consistency_observatory
  !
  subroutine cubetools_consistency_signal_noise(name1,head1,name2,head2,problem,error)
    use cubetools_header_interface
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    character(len=*),    intent(in)    :: name1
    type(cube_header_t), intent(in)    :: head1
    character(len=*),    intent(in)    :: name2
    type(cube_header_t), intent(in)    :: head2
    logical,             intent(inout) :: problem
    logical,             intent(inout) :: error
    !
    type(cube_header_cons_t) :: cons
    character(len=*), parameter :: rname='CONSISTENCY>SIGNAL>NOISE'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (head1%spe%code.ne.head2%spe%code) then
       call cubeheader_message(seve%e,rname,'Inconsistent spectral codes')
       error = .true.
       return
    endif
    !
    call cubetools_header_consistency_init(cons,error)
    if (error) return
    !
    ! Do not check anything
    cons%arr%check  = .false.
    cons%obs%check  = .false.
    cons%spa%bea%check = .false.
    !
    cons%spe%line%check  = .false.
    cons%spe%c%check     = .false.
    cons%spe%ref%c%check = .false.
    !
    cons%spe%f%check     = .false.
    cons%spe%ref%f%check = .false.
    cons%spe%i%check     = .false.
    cons%spe%ref%i%check = .false.
    cons%spe%l%check     = .false.
    cons%spe%ref%l%check = .false.
    !
    cons%spe%v%check     = .false.
    cons%spe%ref%v%check = .false.
    cons%spe%z%check     = .false.
    cons%spe%ref%z%check = .false.
    !
    ! Some axes must be checked except for their size, genuinity and increments
    select case (head1%spe%code)
    case (code_spectral_frequency)
       cons%spe%f%check = .true.
       cons%spe%ref%f%check = .true.
       cons%spe%f%n%check       = .false.
       cons%spe%f%inc%check     = .false.
       cons%spe%f%genuine%check = .false.
       !
       cons%spe%i%check = .true.
       cons%spe%ref%i%check = .true.
       cons%spe%i%n%check       = .false.
       cons%spe%i%inc%check     = .false.
       cons%spe%i%genuine%check = .false.
    case (code_spectral_wavelength)
       cons%spe%l%check = .true.
       cons%spe%ref%l%check = .true.
       cons%spe%l%n%check       = .false.
       cons%spe%l%inc%check     = .false.
       cons%spe%l%genuine%check = .false.
    case default
       ! Do nothing more!
    end select
    !
    !***JP: Here I should do a distinction between velocity and redshift!
    cons%spe%v%check = .true.
    cons%spe%ref%v%check = .true.
    cons%spe%v%n%check       = .false.
    cons%spe%v%inc%check     = .false.
    cons%spe%v%genuine%check = .false.
    !
    call cubetools_consistency_check(cons,name1,head1,name2,head2,problem,error)
    if (error) return
  end subroutine cubetools_consistency_signal_noise
  !
  function cubetools_consistency_failed(rname,prob,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: rname
    logical,          intent(in)    :: prob
    logical,          intent(inout) :: error
    !
    logical :: cubetools_consistency_failed
    !
    cubetools_consistency_failed = .false.
    if (prob) then
       call cubeheader_message(seve%e,rname,'There are inconsistencies between input cubes')
       cubetools_consistency_failed = .true.
       error = .true.
    endif
  end function cubetools_consistency_failed
end module cubetools_consistency_methods
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
