!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeadm_consistency
  use cubetools_header_types
  use cube_types
  use cubeadm_messaging
  use cubeadm_index
  !
  public :: consistency_t
  private
  !
  integer(kind=4), parameter :: elem_l  = 24
  !
  type consistency_t
     type(cube_header_cons_t), private  :: head
     character(len=elem_l), allocatable :: names(:)
     logical,                  private  :: prob   = .false.
     integer(kind=4),          private  :: ncheck = 0
     type(index_t),            private  :: index
   contains
     ! Control methods
     generic,   public  :: init              => init_noname, init_named
     procedure, private :: init_named        => cubeadm_consistency_init_named
     procedure, private :: init_noname       => cubeadm_consistency_init_noname
     procedure, public  :: check             => cubeadm_consistency_check
     procedure, public  :: set_sections      => cubeadm_consistency_set_sections
     procedure, public  :: set_tolerance     => cubeadm_consistency_set_tolerance
     procedure, public  :: list              => cubeadm_consistency_list
     procedure, public  :: proceed           => cubeadm_consistency_proceed
     ! Shape                                 
     generic,   public  :: shape             => shape_two,shape_index
     procedure, private :: shape_two         => cubeadm_consistency_shape_two
     procedure, private :: shape_index       => cubeadm_consistency_shape_index
     procedure, private :: shape_sub         => cubeadm_consistency_shape_sub
     ! Grid                                  
     generic,   public  :: grid              => grid_two,grid_index
     procedure, private :: grid_two          => cubeadm_consistency_grid_two
     procedure, private :: grid_index        => cubeadm_consistency_grid_index
     procedure, private :: grid_sub          => cubeadm_consistency_grid_sub
     ! Spectral                              
     generic,   public  :: spectral          => spectral_two,spectral_index
     procedure, private :: spectral_two      => cubeadm_consistency_spectral_two
     procedure, private :: spectral_index    => cubeadm_consistency_spectral_index
     procedure, private :: spectral_sub      => cubeadm_consistency_spectral_sub
     ! Spatial                               
     generic,   public  :: spatial           => spatial_two,spatial_index
     procedure, private :: spatial_two       => cubeadm_consistency_spatial_two
     procedure, private :: spatial_index     => cubeadm_consistency_spatial_index
     procedure, private :: spatial_sub       => cubeadm_consistency_spatial_sub
     ! Observatory
     generic,   public  :: observatory       => observatory_two,observatory_index
     procedure, private :: observatory_two   => cubeadm_consistency_observatory_two
     procedure, private :: observatory_index => cubeadm_consistency_observatory_index
     procedure, private :: observatory_sub   => cubeadm_consistency_observatory_sub
     ! Signal vs Noise    
     procedure, public  :: signal_noise      => cubeadm_consistency_signal_noise
  end type consistency_t
  !
contains
  subroutine cubeadm_consistency_init_named(cons,names,index,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    character(len=*),     intent(in)    :: names(:)
    type(index_t),        intent(in)    :: index
    logical,              intent(inout) :: error
    !
    integer(kind=ncub_k) :: nnam
    integer(kind=4) :: ier
    character(len=*), parameter :: rname='CONSISTENCY>INIT'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call cubetools_header_consistency_init(cons%head,error)
    if(error) return
    !
    nnam = size(names)
    if (nnam.ne.index%n) then
       call cubeadm_message(seve%e,rname,'Different number of names and cubes')
       error = .true.
       return
    endif
    if (allocated(cons%names)) deallocate(cons%names)
    allocate(cons%names(index%n),stat=ier)
    if (failed_allocate(rname,'name array',ier,error)) return
    cons%names(:) = names(:)
    call index%copy(cons%index,error)
    if (error) return
  end subroutine cubeadm_consistency_init_named
  !
  subroutine cubeadm_consistency_init_noname(cons,index,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    type(index_t),        intent(in)    :: index
    logical,              intent(inout) :: error
    !
    integer(kind=4) :: ier,icub
    character(len=*), parameter :: rname='CONSISTENCY>INIT>NONAME'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call cubetools_header_consistency_init(cons%head,error)
    if(error) return
    !
    allocate(cons%names(index%n),stat=ier)
    if (failed_allocate(rname,'name array',ier,error)) return
    do icub=1,index%n
       write(cons%names(icub),'(a,i0)') 'cube',icub
    end do
    call index%copy(cons%index,error)
    if (error) return
  end subroutine cubeadm_consistency_init_noname
  !
  subroutine cubeadm_consistency_check(cons,error)
    use cubetools_help
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    logical,              intent(inout) :: error
    !
    integer(kind=ncub_k) :: icub
    type(cube_t), pointer :: ref,cube
    integer(kind=ncub_k), parameter :: first = 1
    character(len=*), parameter :: rname='CONSISTENCY>CHECK'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    ref => cons%index%get_cube(first,error)
    if (error)  return
    do icub=2, cons%index%n
       cube => cons%index%get_cube(icub,error)
       if (error)  return
       call cubetools_header_consistency_check(cons%head,ref%head,cube%head,error)
       if(error) return
       cons%prob = cons%head%prob .or. cons%prob
       if (cons%head%prob) then
          call cubeadm_message(seve%r,rname,strg_dash())
          call cubeadm_message(seve%r,rname,blankstr)
          call cubeadm_message(seve%r,rname,"Consistency check between "//trim(cons%names(first))//" and "//&
               trim(cons%names(icub)))
          call cubeadm_message(seve%r,rname,blankstr)
          call cubetools_header_consistency_print(cons%head,ref%head,cube%head,error)
          if(error) return
       endif
       cons%ncheck = cons%ncheck+1
    enddo
    call cubetools_header_consistency_final(cons%head,error)
    if(error) return
    !
    if (cons%prob) then
       call cons%list(error)
       if (error) return
    endif
  end subroutine cubeadm_consistency_check
  !
  subroutine cubeadm_consistency_list(cons,error)
    use cubeadm_opened
    use cubedag_list
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    logical,              intent(inout) :: error
    !
    integer(kind=ncub_k) :: icub
    integer(kind=4) :: custom(20),nc
    character(len=mess_l) :: mess
    type(cube_t), pointer :: cube
    character(len=*), parameter :: cols(8) = &
         ['IDENTIFIER ','TYPE       ','FAMILY     ','FLAG       ',&
          'OBSERVATORY','SOURCE     ','LINE       ','DATASIZE   ']
    character(len=*), parameter :: rname='CONSISTENCY>LIST'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    if (cons%ncheck.gt.0) then
       if (cons%prob) then
          call cubeadm_message(seve%w,rname,'Consistency problem between cubes')
       else
          call cubeadm_message(seve%r,rname,'No consistency problem')
       endif
    else
       call cubeadm_message(seve%w,rname,'Consistency not yet checked')
    endif
    !
    call cubeadm_opened_list_size(cols,custom,error)
    if (error) return
    !
    nc = 27
    call cubeadm_message(seve%r,rname,'Cubes checked for consistency:')
    do icub=1,cons%index%n
       cube => cons%index%get_cube(icub,error)
       if (error)  return
       write(mess,'(a24,a1,x)') trim(cons%names(icub)),':'
       call cubedag_list_one_custom(cube,custom,.true.,code_null,code_null,mess(nc:),error)
       if (error)  return
       call cubeadm_message(seve%r,rname,mess)
    end do
  end subroutine cubeadm_consistency_list
  !
  subroutine cubeadm_consistency_set_sections(cons,checkspa,checkspe,checkarr,checkobs,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    logical,              intent(in)    :: checkspa
    logical,              intent(in)    :: checkspe
    logical,              intent(in)    :: checkarr
    logical,              intent(in)    :: checkobs
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>SET>SECTIONS'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    cons%head%spa%check = checkspa
    cons%head%spe%check = checkspe
    cons%head%arr%check = checkarr
    cons%head%obs%check = checkobs
  end subroutine cubeadm_consistency_set_sections
  !
  subroutine cubeadm_consistency_set_tolerance(cons,tolspa,tolbea,tolspe,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    real(kind=8),         intent(in)    :: tolspa
    real(kind=8),         intent(in)    :: tolbea
    real(kind=8),         intent(in)    :: tolspe
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>SET>TOLERANCE'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call cubetools_header_consistency_set_tol(tolspa,tolbea,tolspe,cons%head,error)
    if (error) return
  end subroutine cubeadm_consistency_set_tolerance
  !
  subroutine cubeadm_consistency_proceed(cons,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>PROCEED'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    if (cons%prob) then
       call cubeadm_message(seve%e,rname,'Cannot proceed with inconsistencies between cubes')
       error = .true.
    endif
  end subroutine cubeadm_consistency_proceed
  !
  !----------Shape-------------------------------------------------------
  !
  subroutine cubeadm_consistency_shape_two(cons,name1,cube1,name2,cube2,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    character(len=*),     intent(in)    :: name1
    type(cube_t),         intent(in)    :: cube1
    character(len=*),     intent(in)    :: name2
    type(cube_t),         intent(in)    :: cube2    
    logical,              intent(inout) :: error
    !
    type(index_t) :: index
    character(len=*), parameter :: rname='CONSISTENCY>SHAPE>TWO'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call index%put_cube(1,cube1,error)
    if (error) return
    call index%put_cube(2,cube2,error)
    if (error) return
    call cons%init([name1,name2],index,error)
    if(error) return
    call cons%shape_sub(error)
    if (error) return
  end subroutine cubeadm_consistency_shape_two
  !
  subroutine cubeadm_consistency_shape_index(cons,index,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    type(index_t),        intent(in)    :: index
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>SHAPE>INDEX'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call cons%init(index,error)
    if(error) return
    call cons%shape_sub(error)
    if (error) return
  end subroutine cubeadm_consistency_shape_index
  !
  subroutine cubeadm_consistency_shape_sub(cons,error)
    !------------------------------------------------------------------------
    ! 
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>SHAPE>SUB'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    cons%head%spa%check = .false.
    cons%head%spe%check = .false.
    cons%head%obs%check = .false.
    !
    cons%head%arr%noi%check   = .false.
    cons%head%arr%unit%check  = .false.
    cons%head%arr%min%check   = .false.
    cons%head%arr%max%check   = .false.
    cons%head%arr%n%nan%check = .false.
    ! *** JP The next one is a work around 2D vs degenerate 3D cubes
    cons%head%arr%n%dim%check = .false.
    ! *** JP The previous one is a work around 2D vs degenerate 3D cubes
    !
    call cons%check(error)
    if(error) return
  end subroutine cubeadm_consistency_shape_sub
  !
  !----------Grid--------------------------------------------------------
  !
  subroutine cubeadm_consistency_grid_two(cons,name1,cube1,name2,cube2,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    character(len=*),     intent(in)    :: name1
    type(cube_t),         intent(in)    :: cube1
    character(len=*),     intent(in)    :: name2
    type(cube_t),         intent(in)    :: cube2    
    logical,              intent(inout) :: error
    !
    type(index_t) :: index
    character(len=*), parameter :: rname='CONSISTENCY>GRID>TWO'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call index%put_cube(1,cube1,error)
    if (error) return
    call index%put_cube(2,cube2,error)
    if (error) return
    call cons%init([name1,name2],index,error)
    if(error) return
    call cons%grid_sub(error)
    if (error) return
  end subroutine cubeadm_consistency_grid_two
  !
  subroutine cubeadm_consistency_grid_index(cons,index,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    type(index_t),        intent(in)    :: index
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>GRID>INDEX'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call cons%init(index,error)
    if(error) return
    call cons%grid_sub(error)
    if (error) return
  end subroutine cubeadm_consistency_grid_index
  !
  subroutine cubeadm_consistency_grid_sub(cons,error)
    !------------------------------------------------------------------------
    ! 
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>GRID>SUB'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    cons%head%obs%check       = .false.
    cons%head%arr%min%check   = .false.
    cons%head%arr%max%check   = .false.
    cons%head%arr%n%nan%check = .false.
    cons%head%spa%bea%check   = .false.
    !
    call cons%check(error)
    if(error) return
  end subroutine cubeadm_consistency_grid_sub
  !
  !----------Spectral----------------------------------------------------
  !
  subroutine cubeadm_consistency_spectral_two(cons,name1,cube1,name2,cube2,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    character(len=*),     intent(in)    :: name1
    type(cube_t),         intent(in)    :: cube1
    character(len=*),     intent(in)    :: name2
    type(cube_t),         intent(in)    :: cube2    
    logical,              intent(inout) :: error
    !
    type(index_t) :: index
    character(len=*), parameter :: rname='CONSISTENCY>SPECTRAL>TWO'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call index%put_cube(1,cube1,error)
    if (error) return
    call index%put_cube(2,cube2,error)
    if (error) return
    call cons%init([name1,name2],index,error)
    if(error) return
    call cons%spectral_sub(error)
    if (error) return
  end subroutine cubeadm_consistency_spectral_two
  !
  subroutine cubeadm_consistency_spectral_index(cons,index,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    type(index_t),        intent(in)    :: index
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>SPECTRAL>INDEX'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call cons%init(index,error)
    if(error) return
    call cons%spectral_sub(error)
    if (error) return
  end subroutine cubeadm_consistency_spectral_index
  !
  subroutine cubeadm_consistency_spectral_sub(cons,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>SPECTRAL>SUB'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    cons%head%obs%check = .false.
    cons%head%arr%check = .false.
    cons%head%spa%check = .false.
    !
    call cons%check(error)
    if(error) return
  end subroutine cubeadm_consistency_spectral_sub
  !
  !----------Spatial-----------------------------------------------------
  !
  subroutine cubeadm_consistency_spatial_two(cons,name1,cube1,name2,cube2,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    character(len=*),     intent(in)    :: name1
    type(cube_t),         intent(in)    :: cube1
    character(len=*),     intent(in)    :: name2
    type(cube_t),         intent(in)    :: cube2    
    logical,              intent(inout) :: error
    !
    type(index_t) :: index
    character(len=*), parameter :: rname='CONSISTENCY>SPATIAL>TWO'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call index%put_cube(1,cube1,error)
    if (error) return
    call index%put_cube(2,cube2,error)
    if (error) return
    call cons%init([name1,name2],index,error)
    if(error) return
    call cons%spatial_sub(error)
    if (error) return
  end subroutine cubeadm_consistency_spatial_two
  !
  subroutine cubeadm_consistency_spatial_index(cons,index,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    type(index_t),        intent(in)    :: index
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>SPATIAL>INDEX'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call cons%init(index,error)
    if(error) return
    call cons%spatial_sub(error)
    if (error) return
  end subroutine cubeadm_consistency_spatial_index
  !
  subroutine cubeadm_consistency_spatial_sub(cons,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>SPATIAL>SUB'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    cons%head%obs%check = .false.
    cons%head%arr%check = .false.
    cons%head%spe%check = .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%head%spa%bea%check = .false.
    ! *** JP
    !
    call cons%check(error)
    if(error) return
  end subroutine cubeadm_consistency_spatial_sub
  !
  !----------Observatory-------------------------------------------------
  !
  subroutine cubeadm_consistency_observatory_two(cons,name1,cube1,name2,cube2,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    character(len=*),     intent(in)    :: name1
    type(cube_t),         intent(in)    :: cube1
    character(len=*),     intent(in)    :: name2
    type(cube_t),         intent(in)    :: cube2    
    logical,              intent(inout) :: error
    !
    type(index_t) :: index
    character(len=*), parameter :: rname='CONSISTENCY>OBSERVATORY>TWO'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call index%put_cube(1,cube1,error)
    if (error) return
    call index%put_cube(2,cube2,error)
    if (error) return
    call cons%init([name1,name2],index,error)
    if(error) return
    call cons%observatory_sub(error)
    if (error) return
  end subroutine cubeadm_consistency_observatory_two
  !
  subroutine cubeadm_consistency_observatory_index(cons,index,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    type(index_t),        intent(in)    :: index
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>OBSERVATORY>INDEX'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call cons%init(index,error)
    if(error) return
    call cons%observatory_sub(error)
    if (error) return
  end subroutine cubeadm_consistency_observatory_index
  !
  subroutine cubeadm_consistency_observatory_sub(cons,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>OBSERVATORY'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    cons%head%arr%check = .false.
    cons%head%spe%check = .false.
    cons%head%spa%check = .false.
    !
    call cons%check(error)
    if(error) return
  end subroutine cubeadm_consistency_observatory_sub
  !
  !----------Signal-vs-Noise---------------------------------------------
  !
  subroutine cubeadm_consistency_signal_noise(cons,name1,cube1,name2,cube2,error)
    !------------------------------------------------------------------------
    ! This consistency check has to be done two by two as it presumes
    ! a pair consisting of a signal and a noise cubes
    !------------------------------------------------------------------------
    class(consistency_t), intent(inout) :: cons
    character(len=*),     intent(in)    :: name1
    type(cube_t),         intent(in)    :: cube1
    character(len=*),     intent(in)    :: name2
    type(cube_t),         intent(in)    :: cube2
    logical,              intent(inout) :: error
    !
    type(index_t) :: index
    character(len=*), parameter :: rname='CONSISTENCY>SIGNAL>NOISE'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call index%put_cube(1,cube1,error)
    if (error) return
    call index%put_cube(2,cube2,error)
    if (error) return
    call cons%init([name1,name2],index,error)
    if(error) return
    cons%head%arr%check  = .false.
    cons%head%obs%check  = .false.
    cons%head%spa%bea%check = .false.
    ! Channel axis is not to be checked
    cons%head%spe%c%check     = .false.
    cons%head%spe%ref%c%check = .false.
    ! All other axes must be checked except for their size, genuinity and increments
    cons%head%spe%f%n%check       = .false.
    cons%head%spe%f%inc%check     = .false.
    cons%head%spe%f%genuine%check = .false.
    cons%head%spe%v%n%check       = .false.
    cons%head%spe%v%inc%check     = .false.
    cons%head%spe%v%genuine%check = .false.
    cons%head%spe%i%n%check       = .false.
    cons%head%spe%i%inc%check     = .false.
    cons%head%spe%i%genuine%check = .false.
    cons%head%spe%l%n%check       = .false.
    cons%head%spe%l%inc%check     = .false.
    cons%head%spe%l%genuine%check = .false.
    cons%head%spe%z%n%check       = .false.
    cons%head%spe%z%inc%check     = .false.
    cons%head%spe%z%genuine%check = .false.
    !
    call cons%check(error)
    if(error) return
  end subroutine cubeadm_consistency_signal_noise
end module cubeadm_consistency
    
