!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_consistency_types
  use cubetools_parameters
  use cubeheader_messaging
  use cubetools_format
  use cubetools_consistency_colors
  !
  public  :: consistency_desc_t
  public  :: notol,check,mess,strict,tenper
  public  :: cubetools_consistency_init,cubetools_consistency_final
  public  :: cubetools_consistency_real_check,cubetools_consistency_real_relative_check
  public  :: cubetools_consistency_angle_check,cubetools_consistency_real_print
  public  :: cubetools_consistency_angle_print
  public  :: cubetools_consistency_integer_check,cubetools_consistency_integer_print
  public  :: cubetools_consistency_string_check,cubetools_consistency_string_print
  public  :: cubetools_consistency_logical_check,cubetools_consistency_logical_print
  public  :: cubetools_consistency_title
  private
  !
  ! Formats
  integer(kind=4),  parameter :: ident  = 5  ! Ident for value print
  integer(kind=4),  parameter :: tab    = 20 ! Tabulation for values
  integer(kind=4),  parameter :: fsize  = 15 ! field size for values
  character(len=*), parameter :: rlfmt  = '1pg15.5'
  character(len=*), parameter :: rsfmt  = '1pg10.3'
  character(len=*), parameter :: ilfmt  = 'i15'
  !
  ! Initializations
  real(kind=tole_k), parameter :: notol  = 0d0
  real(kind=tole_k), parameter :: strict = 1d-7
  real(kind=tole_k), parameter :: tenper = 5d-2
  logical,      parameter :: check  = .true.
  logical,      parameter :: mess   = .true.
  !
  type consistency_desc_t
     logical         :: check=.true.  ! Check this section?
     logical         :: prob=.false.  ! Inconsistent?
     logical         :: mess=.true.   ! Output message for this section?
     real(kind=tole_k)    :: tol =0d0      ! Default tolerance  
  end type consistency_desc_t
  !
  interface cubetools_consistency_real_check
     module procedure cubetools_consistency_r8_check
     module procedure cubetools_consistency_r4_check
  end interface cubetools_consistency_real_check
  !
  interface cubetools_consistency_real_relative_check
     module procedure cubetools_consistency_r8_relative_check
     module procedure cubetools_consistency_r4_relative_check
  end interface cubetools_consistency_real_relative_check
  !
  interface cubetools_consistency_angle_check
     module procedure cubetools_consistency_r8_angle_check
     module procedure cubetools_consistency_r4_angle_check
  end interface cubetools_consistency_angle_check
  !
  interface cubetools_consistency_angle_print
     module procedure cubetools_consistency_r8_angle_print
     module procedure cubetools_consistency_r4_angle_print
  end interface cubetools_consistency_angle_print  
  !
  interface cubetools_consistency_real_print
     module procedure cubetools_consistency_r8_print
     module procedure cubetools_consistency_r4_print
     module procedure cubetools_consistency_r8_print_unit
     module procedure cubetools_consistency_r4_print_unit
     module procedure cubetools_consistency_r8_print_2unit
     module procedure cubetools_consistency_r4_print_2unit
  end interface cubetools_consistency_real_print
  !
  interface cubetools_consistency_integer_check
     module procedure cubetools_consistency_i8_check
     module procedure cubetools_consistency_i4_check
  end interface cubetools_consistency_integer_check
  !
  interface cubetools_consistency_integer_print
     module procedure cubetools_consistency_i8_print
     module procedure cubetools_consistency_i4_print
  end interface cubetools_consistency_integer_print
  !
contains
  subroutine cubetools_consistency_init(tol,check,mess,cons,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Init consistency
    !----------------------------------------------------------------------
    real(kind=tole_k),        intent(in)    :: tol
    type(consistency_desc_t), intent(out)   :: cons
    logical,                  intent(in)    :: check
    logical,                  intent(in)    :: mess
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>INIT'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    cons%tol   = tol
    cons%check = check
    cons%mess  = mess
  end subroutine cubetools_consistency_init
  !
  subroutine cubetools_consistency_final(cons,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Final consistency
    !----------------------------------------------------------------------
    type(consistency_desc_t), intent(out)   :: cons
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>FINAL'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
  end subroutine cubetools_consistency_final
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_consistency_r8_check(cons,dble1,dble2,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Check r8 consistency
    !----------------------------------------------------------------------
    type(consistency_desc_t), intent(inout) :: cons
    real(kind=8),             intent(in)    :: dble1
    real(kind=8),             intent(in)    :: dble2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>R8>CHECK'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    cons%prob = .not.nearly_equal(dble1,dble2,cons%tol)
  end subroutine cubetools_consistency_r8_check
  !
  subroutine cubetools_consistency_r4_check(cons,real1,real2,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Check r4 consistency
    !----------------------------------------------------------------------
    type(consistency_desc_t), intent(inout) :: cons
    real(kind=4),             intent(in)    :: real1
    real(kind=4),             intent(in)    :: real2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>R4>CHECK'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    cons%prob = .not.nearly_equal(real1,real2,real(cons%tol))
  end subroutine cubetools_consistency_r4_check
  !
  subroutine cubetools_consistency_r8_relative_check(cons,inc1,dble1,inc2,dble2,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Check r8 consistency
    !----------------------------------------------------------------------
    type(consistency_desc_t), intent(inout) :: cons
    real(kind=8),             intent(in)    :: inc1
    real(kind=8),             intent(in)    :: dble1
    real(kind=8),             intent(in)    :: inc2
    real(kind=8),             intent(in)    :: dble2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>R8>RELATIVE>CHECK'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    cons%prob = .false.
    cons%prob = (.not.nearly_equal(dble1/inc1,dble2/inc1,cons%tol)).or.&
         (.not.nearly_equal(dble1/inc2,dble2/inc2,cons%tol))
  end subroutine cubetools_consistency_r8_relative_check
  !
  subroutine cubetools_consistency_r4_relative_check(cons,inc1,real1,inc2,real2,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Check r4 consistency
    !----------------------------------------------------------------------
    type(consistency_desc_t), intent(inout) :: cons
    real(kind=4),             intent(in)    :: inc1
    real(kind=4),             intent(in)    :: real1
    real(kind=4),             intent(in)    :: inc2
    real(kind=4),             intent(in)    :: real2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>R4>RELATIVE>CHECK'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    cons%prob = (.not.nearly_equal(real1/inc1,real2/inc1,real(cons%tol))).or.&
         (.not.nearly_equal(real1/inc2,real2/inc2,real(cons%tol)))
  end subroutine cubetools_consistency_r4_relative_check
  !
  subroutine cubetools_consistency_r8_angle_check(cons,angle1,angle2,error)
    use gkernel_interfaces
    use phys_const
    !----------------------------------------------------------------------
    ! Check r8 angle consistency
    !----------------------------------------------------------------------
    type(consistency_desc_t), intent(inout) :: cons
    real(kind=8),             intent(in)    :: angle1
    real(kind=8),             intent(in)    :: angle2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>R8>ANGLE>CHECK'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    ! VVV This is a poor solution as it does not test for angles > pi,
    ! or equal angles with oposing signs
    cons%prob = abs(angle1-angle2).gt.cons%tol*pi
  end subroutine cubetools_consistency_r8_angle_check
  !
  subroutine cubetools_consistency_r4_angle_check(cons,angle1,angle2,error)
    use gkernel_interfaces
    use phys_const
    !----------------------------------------------------------------------
    ! Check r4 angle consistency
    !----------------------------------------------------------------------
    type(consistency_desc_t), intent(inout) :: cons
    real(kind=4),             intent(in)    :: angle1
    real(kind=4),             intent(in)    :: angle2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>R4>ANGLE>CHECK'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    ! VVV This is a poor solution as it does not test for angles > pi,
    ! or equal angles with oposing signs
    cons%prob = abs(angle1-angle2).gt.cons%tol*pi
  end subroutine cubetools_consistency_r4_angle_check
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_consistency_r8_print(label,cons,dble1,dble2,error)
    !----------------------------------------------------------------------
    ! Print i8 consistency
    !----------------------------------------------------------------------
    character(len=*),         intent(in)    :: label
    type(consistency_desc_t), intent(in)    :: cons
    real(kind=8),             intent(in)    :: dble1
    real(kind=8),             intent(in)    :: dble2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>R8>LIST'
    character(len=mess_l) :: mess
    character(len=form_l) :: fmt
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check.or..not.cons%mess) return
    fmt = cubetools_consistency_write_format()
    if (cons%prob) then
       write(mess,fmt) label,cubetools_format_diff(dble1,dble2,rlfmt,fsize)
       mess = trim(cubetools_format_color(mess,colors%incons))
    else
       write(mess,fmt) label,cubetools_format_2values(dble1,dble2,rlfmt,fsize)
       mess = trim(cubetools_format_color(mess,colors%cons))
    endif
    call cubeheader_message(seve%r,rname,mess)
  end subroutine cubetools_consistency_r8_print
  !
  subroutine cubetools_consistency_r4_print(label,cons,real1,real2,error)
    !----------------------------------------------------------------------
    ! Print r4 consistency
    !----------------------------------------------------------------------
    character(len=*),         intent(in)    :: label
    type(consistency_desc_t), intent(in)    :: cons
    real(kind=4),             intent(in)    :: real1
    real(kind=4),             intent(in)    :: real2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>R4>LIST'
    character(len=mess_l) :: mess
    character(len=form_l) :: fmt
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check.or..not.cons%mess) return
    fmt = cubetools_consistency_write_format()
    if (cons%prob) then
       write(mess,fmt) label,cubetools_format_diff(real1,real2,rlfmt,fsize)
       mess = trim(cubetools_format_color(mess,colors%incons))
    else
       write(mess,fmt) label,cubetools_format_2values(real1,real2,rlfmt,fsize)
       mess = trim(cubetools_format_color(mess,colors%cons))
    endif
    call cubeheader_message(seve%r,rname,mess)
  end subroutine cubetools_consistency_r4_print
  !
  subroutine cubetools_consistency_r8_print_unit(label,unit,cons,dble1,dble2,error)
    !----------------------------------------------------------------------
    ! Print r8 consistency with unit
    !----------------------------------------------------------------------
    character(len=*),         intent(in)    :: label
    character(len=*),         intent(in)    :: unit
    type(consistency_desc_t), intent(in)    :: cons
    real(kind=8),             intent(in)    :: dble1
    real(kind=8),             intent(in)    :: dble2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>R8>LIST>UNIT'
    character(len=mess_l) :: mess
    character(len=form_l) :: fmt
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check.or..not.cons%mess) return
    fmt = cubetools_consistency_write_format()
    if (cons%prob) then
       write(mess,fmt) label,cubetools_format_diff(dble1,dble2,rlfmt,fsize,unit)
       mess = trim(cubetools_format_color(mess,colors%incons))
    else
       write(mess,fmt) label,cubetools_format_2values(dble1,dble2,rlfmt,fsize,unit)
       mess = trim(cubetools_format_color(mess,colors%cons))
    endif
    call cubeheader_message(seve%r,rname,mess)
  end subroutine cubetools_consistency_r8_print_unit
  !
  subroutine cubetools_consistency_r4_print_unit(label,unit,cons,real1,real2,error)
    !----------------------------------------------------------------------
    ! Print r4 consistency with unit
    !----------------------------------------------------------------------
    character(len=*),         intent(in)    :: label
    character(len=*),         intent(in)    :: unit
    type(consistency_desc_t), intent(in)    :: cons
    real(kind=4),             intent(in)    :: real1
    real(kind=4),             intent(in)    :: real2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>R4>LIST>UNIT'
    character(len=mess_l) :: mess
    character(len=form_l) :: fmt
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check.or..not.cons%mess) return
    fmt = cubetools_consistency_write_format()
    if (cons%prob) then
       write(mess,fmt) label,cubetools_format_diff(real1,real2,rlfmt,fsize,unit)
       mess = trim(cubetools_format_color(mess,colors%incons))
    else
       write(mess,fmt) label,cubetools_format_2values(real1,real2,rlfmt,fsize,unit)
       mess = trim(cubetools_format_color(mess,colors%cons))
    endif
    call cubeheader_message(seve%r,rname,mess)
  end subroutine cubetools_consistency_r4_print_unit
  !
  subroutine cubetools_consistency_r8_print_2unit(label,unit1,unit2,cons,dble1,dble2,error)
    !----------------------------------------------------------------------
    ! Print r8 consistency with unit
    !----------------------------------------------------------------------
    character(len=*),         intent(in)    :: label
    character(len=*),         intent(in)    :: unit1
    character(len=*),         intent(in)    :: unit2
    type(consistency_desc_t), intent(in)    :: cons
    real(kind=8),             intent(in)    :: dble1
    real(kind=8),             intent(in)    :: dble2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>R8>LIST>2UNIT'
    character(len=mess_l) :: mess
    character(len=form_l) :: fmt
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check.or..not.cons%mess) return
    fmt = cubetools_consistency_write_format()
    write(mess,fmt) label,cubetools_format_2values(dble1,unit1,dble2,unit2,rlfmt,fsize)
    if (cons%prob) then
       mess = trim(cubetools_format_color(mess,colors%incons))
    else
       mess = trim(cubetools_format_color(mess,colors%cons))
    endif
    call cubeheader_message(seve%r,rname,mess)
  end subroutine cubetools_consistency_r8_print_2unit
  !
  subroutine cubetools_consistency_r4_print_2unit(label,unit1,unit2,cons,real1,real2,error)
    !----------------------------------------------------------------------
    ! Print r4 consistency with unit
    !----------------------------------------------------------------------
    character(len=*),         intent(in)    :: label
    character(len=*),         intent(in)    :: unit1
    character(len=*),         intent(in)    :: unit2
    type(consistency_desc_t), intent(in)    :: cons
    real(kind=4),             intent(in)    :: real1
    real(kind=4),             intent(in)    :: real2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>R4>LIST>2UNIT'
    character(len=mess_l) :: mess
    character(len=form_l) :: fmt
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check.or..not.cons%mess) return
    fmt = cubetools_consistency_write_format()
    write(mess,fmt) label,cubetools_format_2values(real1,unit1,real2,unit2,rlfmt,fsize)
    if (cons%prob) then
       mess = trim(cubetools_format_color(mess,colors%incons))
    else
       mess = trim(cubetools_format_color(mess,colors%cons))
    endif
    call cubeheader_message(seve%r,rname,mess)
  end subroutine cubetools_consistency_r4_print_2unit
  !
  subroutine cubetools_consistency_r4_angle_print(label,cons,angle1,angle2,error)
    use phys_const
    !----------------------------------------------------------------------
    ! Print angle consistency
    !----------------------------------------------------------------------
    character(len=*),         intent(in)    :: label
    type(consistency_desc_t), intent(in)    :: cons
    real(kind=4),             intent(in)    :: angle1
    real(kind=4),             intent(in)    :: angle2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>R4>ANGLE>LIST'
    character(len=mess_l) :: mess
    character(len=form_l) :: fmt
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check.or..not.cons%mess) return
    fmt = cubetools_consistency_write_format()
    write(mess,fmt) label,cubetools_format_2values(angle1/rad_per_deg,angle2/rad_per_deg,&
         rlfmt,fsize,'degrees')
    if (cons%prob) then
       mess = trim(cubetools_format_color(mess,colors%incons))
    else       
       mess = trim(cubetools_format_color(mess,colors%cons))
    endif
    call cubeheader_message(seve%r,rname,mess)
  end subroutine cubetools_consistency_r4_angle_print
  !
  subroutine cubetools_consistency_r8_angle_print(label,cons,angle1,angle2,error)
    use phys_const
    !----------------------------------------------------------------------
    ! Print angle consistency
    !----------------------------------------------------------------------
    character(len=*),         intent(in)    :: label
    type(consistency_desc_t), intent(in)    :: cons
    real(kind=8),             intent(in)    :: angle1
    real(kind=8),             intent(in)    :: angle2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>R8>ANGLE>LIST'
    character(len=mess_l) :: mess
    character(len=form_l) :: fmt
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check.or..not.cons%mess) return
    fmt = cubetools_consistency_write_format()
    write(mess,fmt) label,cubetools_format_2values(angle1/rad_per_deg,angle2/rad_per_deg,&
         rlfmt,fsize,'degrees')
    if (cons%prob) then
       mess = trim(cubetools_format_color(mess,colors%incons))
    else       
       mess = trim(cubetools_format_color(mess,colors%cons))
    endif
    call cubeheader_message(seve%r,rname,mess)
  end subroutine cubetools_consistency_r8_angle_print
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_consistency_i8_check(cons,long1,long2,error)
    !----------------------------------------------------------------------
    ! Check i8 consistency
    !----------------------------------------------------------------------
    type(consistency_desc_t), intent(inout) :: cons
    integer(kind=8),          intent(in)    :: long1
    integer(kind=8),          intent(in)    :: long2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>I8>CHECK'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    cons%prob = long1.ne.long2
  end subroutine cubetools_consistency_i8_check
  !
  subroutine cubetools_consistency_i4_check(cons,inte1,inte2,error)
    !----------------------------------------------------------------------
    ! Check i4 consistency
    !----------------------------------------------------------------------
    type(consistency_desc_t), intent(inout) :: cons
    integer(kind=4),          intent(in)    :: inte1
    integer(kind=4),          intent(in)    :: inte2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>I4>CHECK'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    cons%prob = inte1.ne.inte2
  end subroutine cubetools_consistency_i4_check
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_consistency_i8_print(label,cons,long1,long2,error)
    !----------------------------------------------------------------------
    ! Print i8 consistency
    !----------------------------------------------------------------------
    character(len=*),         intent(in)    :: label
    type(consistency_desc_t), intent(in)    :: cons
    integer(kind=8),          intent(in)    :: long1
    integer(kind=8),          intent(in)    :: long2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>I8>LIST'
    character(len=mess_l) :: mess
    character(len=form_l) :: fmt
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check.or..not.cons%mess) return
    fmt = cubetools_consistency_write_format()
    if (cons%prob) then
       write(mess,fmt) label,cubetools_format_diff(long1,long2,ilfmt,fsize)
       mess = trim(cubetools_format_color(mess,colors%incons))
    else
       write(mess,fmt) label,cubetools_format_2values(long1,long2,ilfmt,fsize)
       mess = trim(cubetools_format_color(mess,colors%cons))
    endif
    call cubeheader_message(seve%r,rname,mess)
  end subroutine cubetools_consistency_i8_print
  !
  subroutine cubetools_consistency_i4_print(label,cons,inte1,inte2,error)
    !----------------------------------------------------------------------
    ! Print i4 consistency
    !----------------------------------------------------------------------
    character(len=*),         intent(in)    :: label
    type(consistency_desc_t), intent(in)    :: cons
    integer(kind=4),          intent(in)    :: inte1
    integer(kind=4),          intent(in)    :: inte2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSISTENCY>I4>LIST'
    character(len=mess_l) :: mess
    character(len=form_l) :: fmt
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check.or..not.cons%mess) return
    fmt = cubetools_consistency_write_format()
    if (cons%prob) then
       write(mess,fmt) label,cubetools_format_diff(inte1,inte2,ilfmt,fsize)
       mess = trim(cubetools_format_color(mess,colors%incons))
    else
       write(mess,fmt) label,cubetools_format_2values(inte1,inte2,ilfmt,fsize)
       mess = trim(cubetools_format_color(mess,colors%cons))
    endif
    call cubeheader_message(seve%r,rname,mess)
  end subroutine cubetools_consistency_i4_print
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_consistency_string_check(cons,string1,string2,error)
    !-------------------------------------------------------------------
    ! Check the consistency between two strings
    !-------------------------------------------------------------------
    type(consistency_desc_t), intent(inout) :: cons
    character(len=*),         intent(in)    :: string1
    character(len=*),         intent(in)    :: string2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSITENCY>STRING>CHECK'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    cons%prob = string1.ne.string2
  end subroutine cubetools_consistency_string_check
  !
  subroutine cubetools_consistency_string_print(label,cons,string1,string2,error)
    !-------------------------------------------------------------------
    ! List the consistency between two strings
    !-------------------------------------------------------------------
    character(len=*),         intent(in)    :: label
    type(consistency_desc_t), intent(in)    :: cons
    character(len=*),         intent(in)    :: string1
    character(len=*),         intent(in)    :: string2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSITENCY>STRING>LIST>1LABEL'
    character(len=mess_l) :: mess
    character(len=form_l) :: fmt
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check.or..not.cons%mess) return
    fmt = cubetools_consistency_write_format()
    write(mess,fmt) label,cubetools_format_2values(string1,string2,fsize)
    if (cons%prob) then
       mess = trim(cubetools_format_color(mess,colors%incons))
    else       
       mess = trim(cubetools_format_color(mess,colors%cons))
    endif
    call cubeheader_message(seve%r,rname,mess)
  end subroutine cubetools_consistency_string_print
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_consistency_logical_check(cons,logi1,logi2,error)
    !-------------------------------------------------------------------
    ! Check the consistency between two logicals
    !-------------------------------------------------------------------
    type(consistency_desc_t), intent(inout) :: cons
    logical,                  intent(in)    :: logi1
    logical,                  intent(in)    :: logi2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSITENCY>LOGICAL>CHECK'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    cons%prob = logi1.neqv.logi2
  end subroutine cubetools_consistency_logical_check
  !
  subroutine cubetools_consistency_logical_print(label,cons,logi1,logi2,error)
    !-------------------------------------------------------------------
    ! List the consistency between two logicals
    !-------------------------------------------------------------------
    character(len=*),         intent(in)    :: label
    type(consistency_desc_t), intent(in)    :: cons
    logical,                  intent(in)    :: logi1
    logical,                  intent(in)    :: logi2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONSITENCY>LOGICAL>LIST'
    character(len=mess_l) :: mess
    character(len=form_l) :: fmt
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check.or..not.cons%mess) return
    fmt = cubetools_consistency_write_format()
    write(mess,fmt) label,cubetools_format_2values(logi1,logi2,fsize)
    if (cons%prob) then
       mess = trim(cubetools_format_color(mess,colors%incons))
    else       
       mess = trim(cubetools_format_color(mess,colors%cons))
    endif
    call cubeheader_message(seve%r,rname,mess)
  end subroutine cubetools_consistency_logical_print
  !
  subroutine cubetools_consistency_title(title,level,check,prob,error,short)
    !-------------------------------------------------------------------
    ! Prints the title of a section
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: title
    integer(kind=4),  intent(in)    :: level
    logical,          intent(in)    :: check
    logical,          intent(in)    :: prob
    logical,          intent(inout) :: error
    logical, optional,intent(in)    :: short
    !
    character(len=*), parameter :: rname='CONSITENCY>TITLE'
    character(len=mess_l) :: mess
    character(len=form_l) :: format
    logical :: myshort
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.present(short)) then
       myshort = .false.
    else
       myshort = short
    endif
    if (level.lt.1) then
       call cubeheader_message(seve%e,rname,'Level must be positive')
       error = .true.
       return
    else if (level.eq.1) then
       write(format,'(a,a,a)') '(a)'
    else
       write(format,'(a,i0,a)') '(',2*(level-1),'x,a)'
    endif
    if (check) then
       if (prob) then
          if (myshort) then
             write(mess,format) trim(cubetools_format_color('Inconsistent '//title,colors%incons))
          else
             write(mess,format) trim(cubetools_format_color('Inconsistent '//title//':',colors%incons))
          endif
       else
          write(mess,format) trim(cubetools_format_color('Consistent '//title,colors%cons))
       endif
    else
       write(mess,format) trim(cubetools_format_color(title//' not checked',colors%notche))
    endif
    call cubeheader_message(seve%r,rname,mess)
  end subroutine cubetools_consistency_title
  !
  function cubetools_consistency_write_format() result(fmt)
    !-------------------------------------------------------------------
    ! Produce the printing format
    !-------------------------------------------------------------------
    character(len=form_l) :: fmt
    !
    write(fmt,'(2(a,i0),a)') '(',ident,'x,a,":",t',tab,',a)'
  end function cubetools_consistency_write_format
end module cubetools_consistency_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
