!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_header_array_types
  use cubetools_parameters
  use cubeheader_messaging
  use cubetools_shape_types
  use cubetools_arrelt_types
  use cubetools_noise_types
  use cubetools_consistency_types
  !
  public :: array_t,array_unit_user_t,array_cons_t
  public :: cubetools_array_init,cubetools_array_put_and_derive
  public :: cubetools_array_final,cubetools_array_get
  public :: cubetools_array_list,cubetools_array_unit_register
  public :: cubetools_array_extrema2userstruct
  public :: cubetools_array_unit_parse, cubetools_array_unit_user2prog
  public :: cubetools_array_unit2uservar
  public :: cubetools_array_sicdef,cubetools_array_copy
  public :: cubetools_array_consistency_init,cubetools_array_consistency_final
  public :: cubetools_array_consistency_check,cubetools_array_consistency_list
  private
  !
  type array_t
     integer(kind=code_k)  :: type = code_null ! Type of data (e.g., REAL*4)
     character(len=unit_l) :: unit = strg_unk  ! Unit
     type(shape_t)         :: n                ! Shape related numbers
     type(arrelt_t)        :: min              ! Minimum value
     type(arrelt_t)        :: max              ! Maximum value
     type(noise_t)         :: noi              ! Noise properties
  contains
     procedure :: datasize => cubetools_array_datasize
  end type array_t
  !
  type array_unit_user_t
     character(len=argu_l) :: name = strg_unk  ! Unit name
     logical               :: do   = .false.   ! Option was present
  end type array_unit_user_t
  !
  type array_extrema_user_t
     character(len=argu_l) :: minval = strg_unk ! [ ] Data min value
     character(len=argu_l) :: minix  = strg_unk ! [ ] Min value X position
     character(len=argu_l) :: miniy  = strg_unk ! [ ] Min value Y position
     character(len=argu_l) :: minic  = strg_unk ! [ ] Min value C position
     character(len=argu_l) :: maxval = strg_unk ! [ ] Data max value
     character(len=argu_l) :: maxix  = strg_unk ! [ ] Max value X position
     character(len=argu_l) :: maxiy  = strg_unk ! [ ] Max value Y position
     character(len=argu_l) :: maxic  = strg_unk ! [ ] Max value C position
     logical               :: do  = .false.  ! Option was present
  end type array_extrema_user_t
  !
  type array_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)   :: unit          ! Unit Consistency
     type(shape_cons_t)         :: n             ! Array shape Consistent
     type(arrelt_cons_t)        :: min           ! Minimum value
     type(arrelt_cons_t)        :: max           ! Maximum value
     type(noise_cons_t)         :: noi           ! Noise properties
  end type array_cons_t
contains
  !
  subroutine cubetools_array_init(array,error)
    !-------------------------------------------------------------------
    ! Initialize
    !-------------------------------------------------------------------
    type(array_t), intent(out)   :: array
    logical,       intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>INIT'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_shape_init(array%n,error)
    if (error) return
    call cubetools_arrelt_init('Min',array%min,error)
    if (error) return
    call cubetools_arrelt_init('Max',array%max,error)
    if (error) return
    call cubetools_noise_init(array%noi,error)
    if (error) return
  end subroutine cubetools_array_init
  !
  subroutine cubetools_array_put_and_derive(type,unit,ndim,dim,nl,nm,nc,&
       minval,minloc,maxval,maxloc,sigma,rms,arr,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    integer(kind=code_k),  intent(in)    :: type
    character(len=unit_l), intent(in)    :: unit
    integer(kind=ndim_k),  intent(in)    :: ndim
    integer(kind=data_k),  intent(in)    :: dim(:)
    integer(kind=data_k),  intent(in)    :: nl,nm,nc
    real(kind=sign_k),     intent(in)    :: minval
    integer(kind=data_k),  intent(in)    :: minloc(:)
    real(kind=sign_k),     intent(in)    :: maxval
    integer(kind=data_k),  intent(in)    :: maxloc(:)
    real(kind=sign_k),     intent(in)    :: sigma
    real(kind=sign_k),     intent(in)    :: rms
    type(array_t),         intent(inout) :: arr
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>PUT>AND>DERIVE'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    arr%type = type
    arr%unit = unit
    call cubetools_shape_get_and_derive(ndim,dim,nl,nm,nc,arr%n,error)
    if (error) return
    call cubetools_arrelt_get_and_derive(minval,minloc,arr%min,error)
    if (error) return
    call cubetools_arrelt_get_and_derive(maxval,maxloc,arr%max,error)
    if (error) return
    call cubetools_noise_get_and_derive(sigma,rms,arr%noi,error)
    if (error) return
  end subroutine cubetools_array_put_and_derive
  !
  subroutine cubetools_array_get(arr,type,unit,ndim,dim,nl,nm,nc,&
       minval,minloc,maxval,maxloc,sigma,rms,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(array_t),         intent(in)    :: arr
    integer(kind=code_k),  intent(out)   :: type
    character(len=unit_l), intent(out)   :: unit
    integer(kind=ndim_k),  intent(out)   :: ndim
    integer(kind=data_k),  intent(out)   :: dim(:)
    integer(kind=data_k),  intent(out)   :: nl,nm,nc
    real(kind=sign_k),     intent(out)   :: minval
    integer(kind=data_k),  intent(out)   :: minloc(:)
    real(kind=sign_k),     intent(out)   :: maxval
    integer(kind=data_k),  intent(out)   :: maxloc(:)
    real(kind=sign_k),     intent(out)   :: sigma
    real(kind=sign_k),     intent(out)   :: rms
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>GET'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    type = arr%type
    unit = arr%unit
    call cubetools_shape_put(arr%n,ndim,dim,nl,nm,nc,error)
    if (error) return
    call cubetools_arrelt_put(arr%min,minval,minloc,error)
    if (error) return
    call cubetools_arrelt_put(arr%max,maxval,maxloc,error)
    if (error) return
    call cubetools_noise_put(arr%noi,sigma,rms,error)
    if (error) return
  end subroutine cubetools_array_get
  !
  subroutine cubetools_array_final(array,error)
    !-------------------------------------------------------------------
    ! Finalize
    !-------------------------------------------------------------------
    type(array_t), intent(inout) :: array
    logical,       intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>FINAL'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    array%type = code_null
    array%unit = 'unknown'
    call cubetools_shape_final(array%n,error)
    if (error) return
    call cubetools_arrelt_final(array%min,error)
    if (error) return
    call cubetools_arrelt_final(array%max,error)
    if (error) return
    call cubetools_noise_final(array%noi,error)
    if (error) return
  end subroutine cubetools_array_final
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_array_datasize(array,datasize,error)
    use gbl_format
    !-------------------------------------------------------------------
    ! Return the data size
    !-------------------------------------------------------------------
    class(array_t),       intent(in)    :: array
    integer(kind=data_k), intent(out)   :: datasize
    logical,              intent(inout) :: error
    !
    integer(kind=code_k) :: itype
    character(len=*), parameter :: rname='ARRAY>DATASIZE'
    !
    ! ZZZ This duplicates code from cubetools_shape_list
    itype = hardware-array%type ! hardware is defined in the gbl_format module
    select case (itype)
    case (1,3,4)
      datasize = 4  ! Bytes per element
    case (2,7,9)
      datasize = 8
    case (5)
      datasize = 2
    case (6)
      datasize = 1
    case (8)
      datasize = 16
    case default
       ! This should not happen
       call cubeheader_message(seve%e,rname,'Unknown data type')
       error = .true.
       return
    end select
    datasize = array%n%dat*datasize
  end subroutine cubetools_array_datasize
  !
  subroutine cubetools_array_list(array,error)
    use cubetools_format
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(array_t), intent(in)    :: array
    logical,       intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='ARRAY>LIST'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_shape_list(array%type,array%n,error)
    if (error) return
    mess = cubetools_format_stdkey_boldval('Unit',array%unit,22)    
    call cubeheader_message(seve%r,rname,mess)
    call cubetools_arrelt_list(array%min,error)
    if (error) return
    call cubetools_arrelt_list(array%max,error)
    if (error) return
    call cubetools_noise_list(array%noi,error)
    if (error) return
    call cubeheader_message(seve%r,rname,' ')
  end subroutine cubetools_array_list
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_array_unit_register(name,abstract,option,error)
    use cubetools_structure
    !----------------------------------------------------------------------
    ! Register a /UNIT option under a given name, abstract
    !----------------------------------------------------------------------
    character(len=*),        intent(in)    :: name
    character(len=*),        intent(in)    :: abstract
    type(option_t), pointer, intent(out)   :: option
    logical,                 intent(inout) :: error
    !
    type(standard_arg_t) :: stdarg
    !
    character(len=*), parameter :: rname='ARRAY>UNIT>REGISTER'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         name,'name',&
         abstract,&
         'Unit can be set to any 12 character string, but only&
         & recognized units are supported',&
         option,error)
    if (error) return
    call stdarg%register( &
         'name',  &
         'Unit name', &
         '"*" or "=" mean previous value is kept',&
         code_arg_mandatory, error)
    if (error) return
  end subroutine cubetools_array_unit_register
  !
  subroutine cubetools_array_unit_parse(line,opt,user,error)
    use cubetools_structure
    !----------------------------------------------------------------------
    ! Parse unit name 
    ! /UNIT name
    ! ----------------------------------------------------------------------
    character(len=*),        intent(in)    :: line
    type(option_t),          intent(in)    :: opt
    type(array_unit_user_t), intent(inout) :: user
    logical,                 intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>UNIT>PARSE'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call opt%present(line,user%do,error)
    if (error) return
    if (user%do) then
       call cubetools_getarg(line,opt,1,user%name,mandatory,error)
       if (error) return
       if (len_trim(user%name).gt.unit_l) call cubeheader_message(seve%w,rname,&
            'Unit name will be truncated at 12 characters')
    endif
  end subroutine cubetools_array_unit_parse
  !
  subroutine cubetools_array_unit_user2prog(user,prog,error)
    use cubetools_brightness
    use cubetools_unit_setup
    use cubetools_unit
    !----------------------------------------------------------------------
    ! Resolves unit name based on a previous one according to user
    ! inputs
    !--------------------------------------------------------------------
    type(array_unit_user_t), intent(in)    :: user
    character(len=unit_l),   intent(inout) :: prog
    logical,                 intent(inout) :: error
    !
    type(unit_user_t) :: unit
    character(len=unit_l) :: newunit
    integer(kind=code_k) :: unitcode
    logical :: valid
    character(len=*), parameter :: rname='ARRAY>UNIT>USER2PROG'
    !
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (user%do) then
       if (trim(user%name).eq.strg_equal.or.trim(user%name).eq.strg_star) then
          continue
       else
          call cubetools_unit_get_code(user%name,unitcode,error)
          if (error) return
          select case (unitcode)
          case (code_unit_unk)
             call cubeheader_message(seve%w,rname,'Unsupported unit '//trim(user%name))
             prog = user%name
          case (code_unit_brig,code_unit_flux)
             call cubetools_brightness_valid_brightness_or_flux_unit(user%name,newunit,valid,error)
             if (error) return
             if (.not.valid) then
                call cubeheader_message(seve%e,rname,'Internal error, brightness/flux unit not recognized')
                error = .true.
                return
             else
                prog = newunit
             endif
          case default
             call unit%get_from_name_for_code(user%name,unitcode,error)
             if (error) return
             prog = unit%name
          end select
       endif
    else
       continue
    endif
  end subroutine cubetools_array_unit_user2prog
  !
  subroutine cubetools_array_unit2uservar(prog,uservar,error)
    use cubetools_userspace
    use cubetools_uservar
    !------------------------------------------------------------------------
    ! Loads array unit onto a user space variable
    !------------------------------------------------------------------------
    type(array_t),   intent(in)    :: prog
    type(uservar_t), intent(inout) :: uservar
    logical,         intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>UNIT2USERVAR'
    !
    call cubeheader_message(headseve%trace,rname,'welcome')
    !
    call uservar%set(prog%unit,error)
    if (error) return
  end subroutine cubetools_array_unit2uservar
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_array_extrema_prog2user(prog,user,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    type(array_t),              intent(in)    :: prog
    type(array_extrema_user_t), intent(out)   :: user
    logical,                    intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>EXTREMA>PROG2USER'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    write(user%minval,'(1pg14.7)') prog%min%val
    write(user%minix, '(i0)')      prog%min%ix
    write(user%miniy, '(i0)')      prog%min%iy
    write(user%minic, '(i0)')      prog%min%ic
    write(user%maxval,'(1pg14.7)') prog%max%val
    write(user%maxix, '(i0)')      prog%max%ix
    write(user%maxiy, '(i0)')      prog%max%iy
    write(user%maxic, '(i0)')      prog%max%ic
  end subroutine cubetools_array_extrema_prog2user
  !
  subroutine cubetools_array_extrema2userstruct(prog,userstruct,error)
    use cubetools_userspace
    use cubetools_userstruct
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    type(array_t),      intent(in)    :: prog
    type(userstruct_t), intent(inout) :: userstruct
    logical,            intent(inout) :: error
    !
    type(array_extrema_user_t) :: user
    type(userstruct_t) :: minstruct,maxstruct
    character(len=*), parameter :: rname='ARRAY>EXTREMA2USERSTRUCT'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_array_extrema_prog2user(prog,user,error)
    if (error) return
    call userstruct%def(error)
    if (error) return
    !
    ! Same as cubetools_arrelt_sicdef
    call userstruct%def_substruct('min',minstruct,error)
    if (error) return
    call minstruct%set_member('val',user%minval,error)
    if (error) return
    call minstruct%set_member('ix',user%minix,error)
    if (error) return
    call minstruct%set_member('iy',user%miniy,error)
    if (error) return
    call minstruct%set_member('ic',user%minic,error)
    if (error) return
    !
    call userstruct%def_substruct('max',maxstruct,error)
    if (error) return
    call maxstruct%set_member('val',user%maxval,error)
    if (error) return
    call maxstruct%set_member('ix',user%maxix,error)
    if (error) return
    call maxstruct%set_member('iy',user%maxiy,error)
    if (error) return
    call maxstruct%set_member('ic',user%maxic,error)
    if (error) return
  end subroutine cubetools_array_extrema2userstruct
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_array_sicdef(name,array,readonly,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: name
    type(array_t),    intent(in)    :: array
    logical,          intent(in)    :: readonly
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>SICDEF'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call sic_defstructure(name,global,error)
    if (error) return
    call sic_def_charn(trim(name)//'%unit',array%unit,0,0,readonly,error)
    if (error) return
    call cubetools_shape_sicdef(trim(name)//'%n',array%n,readonly,error)
    if (error) return
    call cubetools_arrelt_sicdef(trim(name)//'%min',array%min,readonly,error)
    if (error) return
    call cubetools_arrelt_sicdef(trim(name)//'%max',array%max,readonly,error)
    if (error) return
    call cubetools_noise_sicdef(trim(name)//'%noi',array%noi,readonly,error)
    if (error) return
  end subroutine cubetools_array_sicdef
  !
  subroutine cubetools_array_copy(in,ou,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(array_t), intent(in)    :: in
    type(array_t), intent(out)   :: ou
    logical,       intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>COPY'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    ou%type = in%type
    ou%unit = in%unit
    call cubetools_shape_copy(in%n,ou%n,error)
    if (error) return
    call cubetools_arrelt_copy(in%min,ou%min,error)
    if (error) return
    call cubetools_arrelt_copy(in%max,ou%max,error)
    if (error) return
    call cubetools_noise_copy(in%noi,ou%noi,error)
    if (error) return
  end subroutine cubetools_array_copy
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_array_consistency_init(cons,error)
    !-------------------------------------------------------------------
    ! Init the consistency between two array sections
    !-------------------------------------------------------------------
    type(array_cons_t), intent(out)   :: cons
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>CONSISTENCY>INIT'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_init(notol,check,mess,cons%unit,error)
    if (error) return
    call cubetools_shape_consistency_init(cons%n,error)
    if (error) return
    call cubetools_arrelt_consistency_init(cons%min,error)
    if (error) return
    call cubetools_arrelt_consistency_init(cons%max,error)
    if (error) return
    call cubetools_noise_consistency_init(cons%noi,error)
    if (error) return
    !
  end subroutine cubetools_array_consistency_init
  !
  subroutine cubetools_array_consistency_check(cons,arr1,arr2,error)
    !-------------------------------------------------------------------
    ! Check the consistency between two array sections
    !-------------------------------------------------------------------
    type(array_cons_t), intent(inout) :: cons
    type(array_t),      intent(in)    :: arr1
    type(array_t),      intent(in)    :: arr2
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>CONSISTENCY>CHECK'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    call cubetools_consistency_string_check(cons%unit,arr1%unit,arr2%unit,error)
    if (error) return
    call cubetools_shape_consistency_check(cons%n,arr1%n,arr2%n,error)
    if (error) return
    call cubetools_arrelt_consistency_check(cons%min,arr1%min,arr2%min,error)
    if (error) return
    call cubetools_arrelt_consistency_check(cons%max,arr1%max,arr2%max,error)
    if (error) return
    call cubetools_noise_consistency_check(cons%noi,arr1%noi,arr2%noi,error)
    if (error) return
    !
    cons%prob = cons%unit%prob.or.cons%n%prob.or.cons%min%prob.or.cons%max%prob
    !   
  end subroutine cubetools_array_consistency_check
  !
  subroutine cubetools_array_consistency_list(cons,arr1,arr2,error)
    !-------------------------------------------------------------------
    ! List the consistency between two array sections
    !-------------------------------------------------------------------
    type(array_cons_t), intent(in)    :: cons
    type(array_t),      intent(in)    :: arr1
    type(array_t),      intent(in)    :: arr2
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>CONSISTENCY>LIST'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%mess) return
    !
    call cubetools_consistency_title('data arrays',2,cons%check,cons%prob,error)
    if (error) return
    if (cons%check.and.cons%prob) then
       call cubetools_array_unit_consistency_list(cons%unit,arr1%unit,arr2%unit,error)
       if (error) return
       call cubetools_shape_consistency_list(cons%n,arr1%n,arr2%n,error)
       if (error) return
       call cubetools_arrelt_consistency_list('minima',arr1%unit,arr2%unit,cons%min,arr1%min,arr2%min,error)
       if (error) return
       call cubetools_arrelt_consistency_list('maxima',arr1%unit,arr2%unit,cons%max,arr1%max,arr2%max,error)
       if (error) return
       call cubetools_noise_consistency_list(arr1%unit,arr2%unit,cons%noi,arr1%noi,arr2%noi,error)
       if (error) return
       endif
    call cubeheader_message(seve%r,rname,'')
    !
  end subroutine cubetools_array_consistency_list
  !
  subroutine cubetools_array_unit_consistency_list(cons,unit1,unit2,error)
    !-------------------------------------------------------------------
    ! List the consistency between two units
    !-------------------------------------------------------------------
    type(consistency_desc_t), intent(in)    :: cons
    character(len=*),         intent(in)    :: unit1
    character(len=*),         intent(in)    :: unit2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>UNIT>CONSISTENCY>LIST'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%mess) return
    !
    call cubetools_consistency_title('units',3,cons%check,cons%prob,error)
    if (error) return
    if (cons%check.and.cons%prob) then
       call cubetools_consistency_string_print('Unit names',cons,unit1,unit2,error)
       if (error) return
    endif
    call cubeheader_message(seve%r,rname,'')
  end subroutine cubetools_array_unit_consistency_list
  !
  subroutine cubetools_array_consistency_final(cons,error)
    !-------------------------------------------------------------------
    ! Final the consistency between two array sections
    !-------------------------------------------------------------------
    type(array_cons_t), intent(out)   :: cons
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>CONSISTENCY>FINAL'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_final(cons%unit,error)
    if (error) return
    call cubetools_shape_consistency_final(cons%n,error)
    if (error) return
    call cubetools_arrelt_consistency_final(cons%min,error)
    if (error) return
    call cubetools_arrelt_consistency_final(cons%max,error)
    if (error) return
    call cubetools_noise_consistency_final(cons%noi,error)
    if (error) return
    !
  end subroutine cubetools_array_consistency_final
end module cubetools_header_array_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
