!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_shape_types
  use cubetools_parameters
  use cubeheader_messaging
  use cubetools_consistency_types
  !
  public :: shape_t,shape_cons_t
  public :: cubetools_shape_init,cubetools_shape_get_and_derive
  public :: cubetools_shape_final,cubetools_shape_put
  public :: cubetools_shape_list,cubetools_shape_sicdef, cubetools_shape_shape2userstruct
  public :: cubetools_shape_copy
  public :: cubetools_shape_consistency_init, cubetools_shape_consistency_final
  public :: cubetools_shape_consistency_check, cubetools_shape_consistency_list
  private
  !
  integer(kind=4),parameter :: labe_l = 32
  !
  type shape_t
     integer(kind=ndim_k), private :: maxdim = maxdim  ! Number of dimensions
     integer(kind=ndim_k), public  :: dim = 0          ! Number of dimensions
     integer(kind=data_k), public  :: axis(maxdim) = 0 ! Dimension of axis(iaxis)
     integer(kind=pixe_k), public  :: l = 0            ! Number of pixels in l direction
     integer(kind=pixe_k), public  :: m = 0            ! Number of pixels in m direction
     integer(kind=chan_k), public  :: c = 0            ! Number of channels
     integer(kind=data_k), public  :: dat = 0          ! Number of data elements
     integer(kind=data_k), public  :: good = 0         ! Number of good elements
     integer(kind=data_k), public  :: nan = 0          ! Number of NaN elements
  end type shape_t
  !
  type shape_cons_t
     logical                  :: check=.true.     ! Check the section
     logical                  :: prob =.false.    ! Is there a problem
     logical                  :: mess =.true.     ! Output message for this section?
     type(consistency_desc_t) :: maxdim           ! Number of dimensions consistency
     type(consistency_desc_t) :: dim              ! Number of dimensions consistency
     type(consistency_desc_t) :: axis(maxdim)     ! All axis sizes consistency
     type(consistency_desc_t) :: l                ! Number of pixels in l direction consistency
     type(consistency_desc_t) :: m                ! Number of pixels in m direction consistency
     type(consistency_desc_t) :: c                ! Number of channels consistency
     type(consistency_desc_t) :: dat              ! Number of data elements consistency
     type(consistency_desc_t) :: nan              ! Number of NaN elements consistency
  end type shape_cons_t
  !
contains
  !
  !---------------------------------------------------------------------
  !  
  subroutine cubetools_shape_init(n,error)
    !-------------------------------------------------------------------
    ! Just initilize the type
    !-------------------------------------------------------------------
    type(shape_t), intent(out)   :: n
    logical,       intent(inout) :: error
    !
    character(len=*), parameter :: rname='SHAPE>INIT'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
  end subroutine cubetools_shape_init
  !
  subroutine cubetools_shape_get_and_derive(ndim,dim,nl,nm,nc,n,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    integer(kind=ndim_k), intent(in)    :: ndim
    integer(kind=data_k), intent(in)    :: dim(:)
    integer(kind=data_k), intent(in)    :: nl,nm,nc
    type(shape_t),        intent(inout) :: n
    logical,              intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='SHAPE>GET>AND>DERIVE'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (size(dim).gt.n%maxdim) then
       write(mess,'(a,i0)') 'Number of axes larger than the authorized maximum ',n%maxdim
       call cubeheader_message(seve%e,rname,mess)
       error = .true.
       return
    endif
    !
    n%dim = ndim
    n%axis(:) = 0
    n%axis(1:ndim) = dim(1:ndim)
    n%dat = product(dim(1:ndim))
    n%nan = 0
    n%l = nl
    n%m = nm
    n%c = nc
  end subroutine cubetools_shape_get_and_derive
  !
  subroutine cubetools_shape_put(n,ndim,dim,nl,nm,nc,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(shape_t),        intent(in)    :: n
    integer(kind=ndim_k), intent(out)   :: ndim
    integer(kind=data_k), intent(out)   :: dim(:)
    integer(kind=data_k), intent(out)   :: nl,nm,nc
    logical,              intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='SHAPE>PUT'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (size(dim).lt.n%dim) then
       write(mess,'(a,i0)') 'Number of axes larger than the size of the output dim array ',size(dim)
       call cubeheader_message(seve%e,rname,mess)
       error = .true.
       return
    endif
    !
    ndim = n%dim
    dim(:) = 0
    dim(1:ndim)= n%axis(1:ndim)
    nl = n%l  
    nm = n%m
    nc = n%c  
  end subroutine cubetools_shape_put
  !  
  subroutine cubetools_shape_final(n,error)
    !-------------------------------------------------------------------
    ! Just reinitilize the type
    !-------------------------------------------------------------------
    type(shape_t), intent(out)   :: n
    logical,       intent(inout) :: error
    !
    character(len=*), parameter :: rname='SHAPE>FINAL'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
  end subroutine cubetools_shape_final
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_shape_list(arraytype,n,error)
    use gbl_format
    use cubetools_format
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    integer(kind=code_k), intent(in)    :: arraytype
    type(shape_t),        intent(in)    :: n
    logical,              intent(inout) :: error
    !
    integer(kind=code_k) :: itype
    integer, parameter :: mtype=9
    integer(kind=data_k) :: dsize
    character(len=7) :: type(mtype)
    character(len=mess_l) :: mess,size
    character(len=*), parameter :: rname='SHAPE>LIST'
    !
    data type /'REAL*4','REAL*8','INTEG*4','LOGICAL',&
         'INTEG*2','BYTE','CMPLX*4','CMPLX*8','INTEG*8'/
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    itype = hardware-arraytype ! hardware is defined in the gbl_format module
    select case (itype)
    case (1,3,4)
      dsize = 4  ! Bytes per element
    case (2,7,9)
      dsize = 8
    case (5)
      dsize = 2
    case (6)
      dsize = 1
    case (8)
      dsize = 16
    case default
       ! This should not happen
       call cubeheader_message(seve%e,rname,'Unknown data type')
       error = .true.
       return
    end select
    write(size,'(i0,a,i0,a,i0,a)') n%l,' pix x ',n%m,' pix x ',n%c,' chan'
    mess = cubetools_format_stdkey_boldval('Size',size,46)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Type',type(itype),12)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Mem',cubetools_format_memsize(n%dat*dsize),12)
    call cubeheader_message(seve%r,rname,mess)
    call cubeheader_message(seve%r,rname,' ')
  end subroutine cubetools_shape_list
  !
  subroutine cubetools_shape_sicdef(name,n,readonly,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: name
    type(shape_t),    intent(in)    :: n
    logical,          intent(in)    :: readonly
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='SHAPE>SICDEF'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call sic_defstructure(name,global,error)
    if (error) return
    call sic_def_inte(trim(name)//'%maxdim',n%maxdim,0,0,readonly,error)
    if (error) return
    call sic_def_inte(trim(name)//'%dim',n%dim,0,0,readonly,error)
    if (error) return
    call sic_def_long(trim(name)//'%axis',n%axis,1,n%dim,readonly,error)
    if (error) return
    call sic_def_long(trim(name)//'%l',n%l,0,0,readonly,error)
    if (error) return
    call sic_def_long(trim(name)//'%m',n%m,0,0,readonly,error)
    if (error) return
    call sic_def_long(trim(name)//'%c',n%c,0,0,readonly,error)
    if (error) return
    call sic_def_long(trim(name)//'%nan',n%nan,0,0,readonly,error)
    if (error) return
    call sic_def_long(trim(name)//'%dat',n%dat,0,0,readonly,error)
    if (error) return
  end subroutine cubetools_shape_sicdef
  !
  subroutine cubetools_shape_shape2userstruct(n,userstruct,error)
    use cubetools_userspace
    use cubetools_userstruct
    !------------------------------------------------------------------------
    ! Load a shape onto a user structure
    !------------------------------------------------------------------------
    type(shape_t),      intent(in)    :: n
    type(userstruct_t), intent(inout) :: userstruct
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='SHAPE>SHAPE2USERSTRUCT'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call userstruct%def(error)
    if (error) return
    !
    call userstruct%set_member('dim',n%dim,error)
    if (error) return
    call userstruct%set_member('axis',n%axis,error)
    if (error) return
    call userstruct%set_member('l',n%l,error)
    if (error) return
    call userstruct%set_member('m',n%m,error)
    if (error) return
    call userstruct%set_member('c',n%c,error)
    if (error) return
    call userstruct%set_member('dat',n%dat,error)
    if (error) return
  end subroutine cubetools_shape_shape2userstruct
  !
  subroutine cubetools_shape_copy(in,ou,error)
    !----------------------------------------------------------------------
    !
    ! ----------------------------------------------------------------------
    type(shape_t), intent(in)    :: in
    type(shape_t), intent(out)   :: ou
    logical,       intent(inout) :: error
    !
    character(len=*), parameter :: rname='SHAPE>COPY'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    ou = in
  end subroutine cubetools_shape_copy
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_shape_consistency_init(cons,error)
    !----------------------------------------------------------------------
    ! Init array shape consistency
    !----------------------------------------------------------------------
    type(shape_cons_t), intent(out)   :: cons
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='SHAPE>CONSISTENCY>INIT'
    integer(kind=ndim_k) :: idim
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    ! 
    call cubetools_consistency_init(notol,.not.check,mess,cons%maxdim,error)
    if (error) return
    call cubetools_consistency_init(notol,check,mess,cons%dim,error)
    if (error) return
    do idim=1,maxdim
       call cubetools_consistency_init(notol,.not.check,mess,cons%axis(idim),error)
       if (error) return
    enddo
    call cubetools_consistency_init(notol,check,mess,cons%l,error)
    if (error) return
    call cubetools_consistency_init(notol,check,mess,cons%m,error)
    if (error) return
    call cubetools_consistency_init(notol,check,mess,cons%c,error)
    if (error) return
    call cubetools_consistency_init(notol,check,mess,cons%dat,error)
    if (error) return
    call cubetools_consistency_init(notol,check,mess,cons%nan,error)
    if (error) return
  end subroutine cubetools_shape_consistency_init
  !
  subroutine cubetools_shape_consistency_check(cons,shape1,shape2,error)
    !----------------------------------------------------------------------
    ! Check array shape consistency
    !----------------------------------------------------------------------
    type(shape_cons_t), intent(inout) :: cons
    type(shape_t),      intent(in)    :: shape1
    type(shape_t),      intent(in)    :: shape2
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='SHAPE>CONSISTENCY>CHECK'
    integer(kind=ndim_k) :: idim
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    call cubetools_consistency_integer_check(cons%maxdim,shape1%maxdim,shape2%maxdim,error)
    if (error) return
    call cubetools_consistency_integer_check(cons%dim,shape1%dim,shape2%dim,error)
    if (error) return
    do idim=1,maxdim
       call cubetools_consistency_integer_check(cons%axis(idim),shape1%axis(idim),shape2%axis(idim),error)
       if (error) return
    enddo
    call cubetools_consistency_integer_check(cons%l,shape1%l,shape2%l,error)
    if (error) return
    call cubetools_consistency_integer_check(cons%m,shape1%m,shape2%m,error)
    if (error) return
    call cubetools_consistency_integer_check(cons%c,shape1%c,shape2%c,error)
    if (error) return
    call cubetools_consistency_integer_check(cons%dat,shape1%dat,shape2%dat,error)
    if (error) return
    call cubetools_consistency_integer_check(cons%nan,shape1%nan,shape2%nan,error)
    if (error) return
    !
    cons%prob = cons%maxdim%prob.or.cons%dim%prob.or.cons%l%prob.or.cons%m%prob&
         .or.cons%c%prob.or.cons%dat%prob.or.cons%nan%prob
  end subroutine cubetools_shape_consistency_check
  !
  subroutine cubetools_shape_consistency_list(cons,shape1,shape2,error)
    !----------------------------------------------------------------------
    ! Print array shape consistency
    !----------------------------------------------------------------------
    type(shape_cons_t), intent(in)    :: cons
    type(shape_t),      intent(in)    :: shape1
    type(shape_t),      intent(in)    :: shape2
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='SHAPE>CONSISTENCY>LIST'
    character(len=labe_l) :: label
    integer(kind=ndim_k) :: idim
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_title('shapes',3,cons%check,cons%prob,error)
    if (error) return
    if (cons%check.and.cons%prob) then
       call cubetools_consistency_integer_print('Max. dim.',&
            cons%maxdim,shape1%maxdim,shape2%maxdim,error)
       if (error) return
       call cubetools_consistency_integer_print('# of dim.',&
            cons%dim,shape1%dim,shape2%dim,error)
       if (error) return
       do idim=1,maxdim
          write (label,'(a,i0)') 'Axis #',idim
          call cubetools_consistency_integer_print(label,&
               cons%axis(idim),shape1%axis(idim),shape2%axis(idim),error)
          if (error) return
       enddo
       call cubetools_consistency_integer_print('# of px. in l',&
            cons%l,shape1%l,shape2%l,error)
       if (error) return
       call cubetools_consistency_integer_print('# of px. in m',&
            cons%m,shape1%m,shape2%m,error)
       if (error) return
       call cubetools_consistency_integer_print('# of channels',&
            cons%c,shape1%c,shape2%c,error)
       if (error) return
       call cubetools_consistency_integer_print('# of data el.',&
            cons%dat,shape1%dat,shape2%dat,error)
       if (error) return
       call cubetools_consistency_integer_print('# of NaN el.',&
            cons%nan,shape1%nan,shape2%nan,error)
       if (error) return
    endif
    call cubeheader_message(seve%r,rname,'')
  end subroutine cubetools_shape_consistency_list
  !
  subroutine cubetools_shape_consistency_final(cons,error)
    !----------------------------------------------------------------------
    ! Final array shape consistency
    !----------------------------------------------------------------------
    type(shape_cons_t), intent(out)   :: cons
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='SHAPE>CONSISTENCY>FINAL'
    integer(kind=ndim_k) :: idim
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    ! 
    call cubetools_consistency_final(cons%maxdim,error)
    if (error) return
    call cubetools_consistency_final(cons%dim,error)
    if (error) return
    do idim=1,maxdim
       call cubetools_consistency_final(cons%axis(idim),error)
       if (error) return
    enddo
    call cubetools_consistency_final(cons%l,error)
    if (error) return
    call cubetools_consistency_final(cons%m,error)
    if (error) return
    call cubetools_consistency_final(cons%c,error)
    if (error) return
    call cubetools_consistency_final(cons%dat,error)
    if (error) return
    call cubetools_consistency_final(cons%nan,error)
    if (error) return
  end subroutine cubetools_shape_consistency_final
end module cubetools_shape_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
