!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_header_types
  use cubetools_parameters
  use cubeheader_messaging
  use cubetools_header_interface
  use cubetools_axset_types
  use cubetools_header_array_types
  use cubetools_spectral_prog_types
  use cubetools_spectral_consistency_types
  use cubetools_spatial_types
  use cubetools_observatory_types
  !
  public :: cube_header_t,cube_header_cons_t
  public :: cubetools_header_import_and_derive,cubetools_header_export
  public :: cubetools_header_rederive,cubetools_header_final
  public :: cubetools_header_sicdef,cubetools_header_copy
  public :: cubetools_header_consistency_init,cubetools_header_consistency_final
  public :: cubetools_header_consistency_check,cubetools_header_consistency_list
  public :: cubetools_header_consistency_set_tol
  public :: cubetools_header_modify ! *** JP: Should be part of the spectral type
  private
  !
  logical, parameter :: genuine = .true.
  !
  type cube_header_t
     type(axset_t)         :: set ! Description of all available data axes
     type(array_t)         :: arr ! Description of data array
     type(spectral_prog_t) :: spe ! Description of the spectral axis when available
     type(spatial_t)       :: spa ! Description of the spatial  axes when available
     type(observatory_t)   :: obs ! Description of the (virtual) observatory
   contains
     procedure, public :: init => cubetools_header_init
     procedure, public :: list => cubetools_header_list
  end type cube_header_t
  !
  type cube_header_cons_t
     logical                  :: prob =.false. ! Is there a problem
     logical                  :: mess =.true.  ! Output message for the consistency
     type(axset_cons_t)       :: set ! Consistency of the axset
     type(array_cons_t)       :: arr ! Consistency of the data array
     type(spatial_cons_t)     :: spa ! Consistency of the spatial section
     type(spectral_cons_t)    :: spe ! Consistency of the spectral section
     type(observatory_cons_t) :: obs ! Consistency of the observatory section
  end type cube_header_cons_t
  !
contains
  !
  subroutine cubetools_header_init(head,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(cube_header_t), intent(inout) :: head
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='HEADER>INIT'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_axset_init(head%set,error)
    if (error) return
    call cubetools_array_init(head%arr,error)
    if (error) return
    call cubetools_spatial_init(head%spa,error)
    if (error) return
    call head%spe%init(error)
    if (error) return
    call cubetools_observatory_init(head%obs,error)
    if (error) return
  end subroutine cubetools_header_init
  !
  subroutine cubetools_header_import_and_derive(in,head,error)
    use cubetools_unit
    use cubetools_header_interface
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(cube_header_interface_t), intent(in)    :: in
    type(cube_header_t),           intent(inout) :: head
    logical,                       intent(inout) :: error
    !
    integer(kind=ndim_k) :: ix,iy,ic,idim,ndim
    integer(kind=data_k) :: nx,ny,nc
    real(kind=coor_k) :: channel
    !
    logical :: axset_genuine(maxdim)
    real(kind=coor_k) :: convert(3,maxdim)
    integer(kind=code_k) :: kind(maxdim)
    integer(kind=data_k) :: dim(maxdim)
    character(len=unit_l) :: name(maxdim),unit(maxdim)
    !
    character(len=*), parameter :: rname='HEADER>IMPORT>AND>DERIVE'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
!!$ JP: for debugging
!!$    call in%list(error)
!!$    if (error) return
    !
    ! Sanity
    call in%sanity_xyc(error)
    if (error)  return
    !
    ! A bit of preparation
    if (in%axset_ndim.le.maxdim) then
       ndim = in%axset_ndim
    else
       call cubeheader_message(headseve%others,rname,'Larger number of dimensions than room to store it! => Truncating')
       ndim = maxdim
    endif
    dim = 0
    dim(1:ndim) = in%axset_dim(1:ndim)
    do idim = 1,maxdim
       if (idim.le.ndim) then
          convert(:,idim) = in%axset_convert(:,idim)
       else
          convert(:,idim) = [0d0,0d0,1d0]  ! For derived dimensions, if any
       endif
    enddo ! idim
    name = strg_unk  ! For derived dimensions, if any
    name(1:ndim) = in%axset_name(1:ndim)
    unit = strg_unk  ! For derived dimensions, if any
    unit(1:ndim) = in%axset_unit(1:ndim)
    kind = code_unit_unk  ! For derived dimensions, if any
    kind(1:ndim) = in%axset_kind(1:ndim)
    axset_genuine = .not.genuine  ! For derived dimensions, if any
    axset_genuine(1:ndim) = genuine
    ! Add derived dimensions if needed:
    call in%derive_xyc(ix,nx,iy,ny,ic,nc,ndim,dim,name,unit,kind,error)
    if (error)  return
    channel = convert(1,ic)
    nc = dim(ic)
    !
    call cubetools_axset_put_and_derive(axset_genuine,&
         name,unit,kind,ndim,dim,convert,ix,iy,ic,&
         head%set,error)
    if (error) return
    ! *** JP: Unclear to me whether we should use in%array_unit or unit?
    call cubetools_array_put_and_derive(&
         in%array_type,in%array_unit,&
         in%axset_ndim,in%axset_dim,&
         nx,ny,nc,&
         in%array_minval,in%array_minloc,&
         in%array_maxval,in%array_maxloc,&
         in%array_noise,in%array_rms,&
!        in%array_nan,&
         head%arr,error)
    if (error) return
    call head%arr%min%associate(head%set%il,head%set%im,head%set%ic,error)
    if (error)  return
    call head%arr%max%associate(head%set%il,head%set%im,head%set%ic,error)
    if (error)  return
    !
    call cubetools_spatial_put_and_derive(&
         in%spatial_source,in%spatial_frame_code,in%spatial_frame_equinox,&
         in%spatial_projection_code,in%spatial_projection_l0,in%spatial_projection_m0,in%spatial_projection_pa,&
         in%spatial_beam_major,in%spatial_beam_minor,in%spatial_beam_pa,&
         head%set%axis(ix),head%set%axis(iy),&
         head%spa,error)
    if (error) return
    call head%spe%put_and_derive(axset_genuine(ic),&
         in%spectral_frame_code,in%spectral_convention,&
         in%spectral_line,nc,channel,&
         in%spectral_code,in%spectral_increment_value,in%spectral_signal_value,in%spectral_image_value,&
         in%spectral_systemic_code,in%spectral_systemic_value,&
         error)
    if (error) return
    call cubetools_observatory_put_and_derive(in%obs,head%obs,error)
    if (error) return
  end subroutine cubetools_header_import_and_derive
  !
  subroutine cubetools_header_export(head,out,error)
    use cubetools_unit
    use cubetools_header_interface
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(cube_header_t),           intent(in)    :: head
    type(cube_header_interface_t), intent(inout) :: out
    logical,                       intent(inout) :: error
    !
    integer(kind=ndim_k) :: idim,jdim,ndim
    integer(kind=data_k) :: nx,ny,nc
    !
    logical :: axset_genuine(maxdim)
    real(kind=coor_k) :: convert(3,maxdim)
    integer(kind=code_k) :: kind(maxdim)
    integer(kind=data_k) :: dim(maxdim),minloc(maxdim),maxloc(maxdim)
    character(len=unit_l) :: name(maxdim),unit(maxdim)
    !
    character(len=*), parameter :: rname='HEADER>EXPORT'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_axset_get(head%set,&
         axset_genuine,name,unit,kind,&
         ndim,dim,convert,&
         out%axset_ix,out%axset_iy,out%axset_ic,&
         error)
    if (error) return
    jdim = 0
    do idim = 1,ndim
       if (axset_genuine(idim)) then
          jdim = jdim+1
          out%axset_name(jdim) = name(idim)
          out%axset_unit(jdim) = unit(idim)
          out%axset_kind(jdim) = kind(idim)
          out%axset_dim(jdim) = dim(idim)
          out%axset_convert(:,jdim) = convert(:,idim)
       else
          ! Non-genuine dimensions are not exported to the interface
          ! (operation opposite to cubetools_header_interface_derive_xyc)
          ! => take care of ix/iy/ic
          ! 1) Neutralize current dimension
          if (out%axset_ix.eq.idim)  out%axset_ix = 0
          if (out%axset_iy.eq.idim)  out%axset_iy = 0
          if (out%axset_ic.eq.idim)  out%axset_ic = 0
          ! 2) Shift upper dimension
          if (out%axset_ix.gt.idim)  out%axset_ix = out%axset_ix-1
          if (out%axset_iy.gt.idim)  out%axset_iy = out%axset_iy-1
          if (out%axset_ic.gt.idim)  out%axset_ic = out%axset_ic-1
       endif
    enddo ! idim
    out%axset_ndim = jdim
    do idim = jdim+1,maxdim
       out%axset_name(idim) = strg_unk
       out%axset_unit(idim) = strg_unk
       out%axset_kind(idim) = code_unit_unk
       out%axset_dim(idim)  = 0
       out%axset_convert(:,idim) = [0d0,0d0,1d0]
    enddo ! idim
    if (out%axset_ix.gt.out%axset_ndim) out%axset_ix = 0
    if (out%axset_iy.gt.out%axset_ndim) out%axset_iy = 0
    if (out%axset_ic.gt.out%axset_ndim) out%axset_ic = 0
    !
    call cubetools_array_get(head%arr,&
         out%array_type,out%array_unit,&
         ndim,dim,&
         nx,ny,nc,&
         out%array_minval,minloc,&
         out%array_maxval,maxloc,&
         out%array_noise,out%array_rms,&
!        out%array_nan,&
         error)
    ! maxloc and minloc are truncating when needed
    out%array_minloc = 0
    out%array_maxloc = 0
    out%array_minloc(1:ndim) = minloc(1:ndim)
    out%array_maxloc(1:ndim) = maxloc(1:ndim)
    call cubetools_spatial_get(head%spa,&
         out%spatial_source,out%spatial_frame_code,out%spatial_frame_equinox,&
         out%spatial_projection_code,out%spatial_projection_l0,out%spatial_projection_m0,out%spatial_projection_pa,&
         out%spatial_beam_major,out%spatial_beam_minor,out%spatial_beam_pa,&
         error)
    if (error) return
    call head%spe%get(&
         out%spectral_frame_code,out%spectral_convention,&
         out%spectral_line,&
         out%spectral_code,out%spectral_increment_value,out%spectral_signal_value,out%spectral_image_value,&
         out%spectral_systemic_code,out%spectral_systemic_value,&
         error)
    if (error) return
    call cubetools_observatory_get(head%obs,out%obs,error)
    if (error) return
!!$    !
!!$    call out%list(error)
!!$    if (error) return
  end subroutine cubetools_header_export
  !
  subroutine cubetools_header_final(head,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(cube_header_t), intent(inout) :: head
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='HEADER>FINAL'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_axset_final(head%set,error)
    if (error) return
    call cubetools_array_final(head%arr,error)
    if (error) return
    call cubetools_spatial_final(head%spa,error)
    if (error) return
    call head%spe%final(error)
    if (error) return
    call cubetools_observatory_final(head%obs,error)
    if (error) return
  end subroutine cubetools_header_final
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_header_rederive(head,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(cube_header_t), intent(inout) :: head
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='HEADER>REDERIVE'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_axset_rederive(head%set,error)
    if (error) return
!!$    call cubetools_array_rederive(head%arr,error)
!!$    if (error) return
!!$    call cubetools_spatial_rederive(head%spa,error)
!!$    if (error) return
    call head%spe%rederive(error)
    if (error) return
!!$    call cubetools_observatory_rederive(head%obs,error)
!!$    if (error) return
  end subroutine cubetools_header_rederive
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_header_list(head,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(cube_header_t), intent(in)    :: head
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='HEADER>LIST'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_axset_list(head%set,error)
    if (error) return
    call cubetools_array_list(head%arr,error)
    if (error) return
    call head%spe%list(error)
    if (error) return
    call cubetools_spatial_list(head%spa,error)
    if (error) return
    call cubetools_observatory_list(head%obs,error)
    if (error) return
  end subroutine cubetools_header_list
  !
  subroutine cubetools_header_sicdef(name,head,readonly,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*),    intent(in)    :: name
    type(cube_header_t), intent(in)    :: head
    logical,             intent(in)    :: readonly
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='HEADER>SICDEF'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call sic_defstructure(name,global,error)
    if (error) return
    call cubetools_axset_sicdef(trim(name)//'%set',head%set,readonly,error)
    if (error) return
    call cubetools_array_sicdef(trim(name)//'%arr',head%arr,readonly,error)
    if (error) return
    call head%spe%obsolete_sicdef(trim(name)//'%spe',readonly,error)
    if (error) return
    call cubetools_spatial_sicdef(trim(name)//'%spa',head%spa,readonly,error)
    if (error) return
    call cubetools_observatory_sicdef(trim(name)//'%obs',head%obs,readonly,error)
    if (error) return
  end subroutine cubetools_header_sicdef
  !
  subroutine cubetools_header_copy(in,ou,error)
    !----------------------------------------------------------------------
    ! Copies one Header into another and properly initializes the
    ! second header
    !----------------------------------------------------------------------
    type(cube_header_t), intent(in)    :: in
    type(cube_header_t), intent(inout) :: ou
    logical,             intent(inout) :: error
    !
    integer(kind=ndim_k) :: il,im
    character(len=*), parameter :: rname='HEADER>COPY'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_axset_copy(in%set,ou%set,error)
    if (error) return
    call cubetools_array_copy(in%arr,ou%arr,error)
    if (error) return
    call in%spe%copyto(ou%spe,error)
    if (error) return
    il = in%set%il
    im = in%set%im
    call cubetools_spatial_copy(ou%set%axis(il),ou%set%axis(im),in%spa,ou%spa,error)
    if (error) return
    call cubetools_observatory_copy(in%obs,ou%obs,error)
    if (error) return
  end subroutine cubetools_header_copy
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_header_consistency_init(cons,error)
    !-------------------------------------------------------------------
    ! Initializes a header consistency object to intelligent defaults
    !-------------------------------------------------------------------
    type(cube_header_cons_t), intent(out)   :: cons
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='HEADER>CONSISTENCY>INIT'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_array_consistency_init(cons%arr,error)
    if (error) return
    call cubetools_axset_consistency_init(cons%set,error)
    if (error) return
    call cubetools_spatial_consistency_init(cons%spa,error)
    if (error) return
    call cons%spe%init(error)
    if (error) return
    call cubetools_observatory_consistency_init(cons%obs,error)
    if (error) return
    !
  end subroutine cubetools_header_consistency_init
  !
  subroutine cubetools_header_consistency_set_tol(spatol,beatol,spetol,cons,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    real(kind=tole_k),        intent(in)    :: spatol
    real(kind=tole_k),        intent(in)    :: beatol
    real(kind=tole_k),        intent(in)    :: spetol
    type(cube_header_cons_t), intent(inout) :: cons
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='HEADER>CONSISTENCY>SET>TOL'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_spatial_consistency_set_tol(spatol,beatol,cons%spa,error)
    if (error) return
    call cons%spe%set_tol(spetol,error)
    if (error) return
  end subroutine cubetools_header_consistency_set_tol
  !
  subroutine cubetools_header_consistency_check(cons,head1,head2,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(cube_header_cons_t), intent(inout) :: cons
    type(cube_header_t),      intent(in)    :: head1
    type(cube_header_t),      intent(in)    :: head2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='HEADER>CONSISTENCY>CHECK'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !    
    cons%prob=.false.
    call cubetools_array_consistency_check(cons%arr,head1%arr,head2%arr,error)
    if (error) return
    call cubetools_axset_consistency_check(cons%set,head1%set,head2%set,error)
    if (error) return
    call cubetools_spatial_consistency_check(cons%spa,head1%spa,head2%spa,error)
    if (error) return
    call cons%spe%check(head1%spe,head2%spe,error)
    if (error) return
    call cubetools_observatory_consistency_check(cons%obs,head1%obs,head2%obs,error)
    if (error) return
    !
    cons%prob = cons%arr%prob.or.cons%set%prob.or.cons%spa%prob.or.cons%spe%prob.or.cons%obs%prob
    !
  end subroutine cubetools_header_consistency_check
  !
  subroutine cubetools_header_consistency_list(cons,head1,head2,error)
    use cubetools_consistency_types
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(cube_header_cons_t), intent(in)    :: cons
    type(cube_header_t),      intent(in)    :: head1
    type(cube_header_t),      intent(in)    :: head2
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='HEADER>CONSISTENCY>LIST'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    if (.not.cons%mess) return
    !
    call cubetools_consistency_title('Headers',1,.true.,cons%prob,error)
    if (error) return
    if (cons%prob) then
       call cubetools_array_consistency_list(cons%arr,head1%arr,head2%arr,error)
       if (error) return
       call cubetools_axset_consistency_list(cons%set,head1%set,head2%set,error)
       if (error) return
       call cubetools_spatial_consistency_list(cons%spa,head1%spa,head2%spa,error)
       if (error) return
       call cons%spe%list(head1%spe,head2%spe,error)
       if (error) return
       call cubetools_observatory_consistency_list(cons%obs,head1%obs,head2%obs,error)
    if (error) return
    endif
  end subroutine cubetools_header_consistency_list
  !
  subroutine cubetools_header_consistency_final(cons,error)
    !-------------------------------------------------------------------
    ! Finalizes a header consistency object
    !-------------------------------------------------------------------
    type(cube_header_cons_t), intent(out)   :: cons
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='HEADER>CONSISTENCY>FINAL'
    !
    call cubeheader_message(headseve%trace,rname,'Welcome')
    !
    call cubetools_array_consistency_final(cons%arr,error)
    if (error) return
    call cubetools_axset_consistency_final(cons%set,error)
    if (error) return
    call cubetools_spatial_consistency_final(cons%spa,error)
    if (error) return
    call cons%spe%final(error)
    if (error) return
    call cubetools_observatory_consistency_final(cons%obs,error)
    if (error) return
  end subroutine cubetools_header_consistency_final
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_header_modify(head,voff,freq,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(cube_header_t), intent(inout) :: head
    real(kind=coor_k),   intent(in)    :: voff
    real(kind=coor_k),   intent(in)    :: freq
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='HEADER>MODIFY'
    !
    call cubeheader_message(seve%e,rname,'Not working anymore')
    error = .true.
    return
  end subroutine cubetools_header_modify  
end module cubetools_header_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
