!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubefitsio_header
  use cfitsio_interfaces
  use gkernel_interfaces
  use cubetools_parameters
  use gfits_types
  use cubefitsio_messaging
  !
  type :: fitsio_header_t
    integer(kind=4)      :: unit=0       ! Logical unit for associated FITS file
    character(len=512)   :: id=strg_unk  ! Some identifier string (for feedback)
    ! Components which have an effect on the FITS reading or writing
    integer(kind=code_k) :: type=code_null  ! Type of data (e.g. R*4, C*4, etc)
    integer(kind=ndim_k) :: ndim
    integer(kind=data_k) :: dim(maxdim)
    ! Collection of components with no meaning for FITS reading or writing
    type(gfits_hdict_t) :: dict
  contains
    procedure :: init    => cubefitsio_header_init
    procedure :: open    => cubefitsio_header_open
    procedure :: close   => cubefitsio_header_close
    procedure :: message => cubefitsio_header_message
  end type fitsio_header_t
  !
  public :: fitsio_header_t
  private
  !
contains
  !
  subroutine cubefitsio_header_init(hfits,filename,error)
    class(fitsio_header_t), intent(inout) :: hfits
    character(len=*),       intent(in)    :: filename
    logical,                intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='INIT'
    integer(kind=4) :: ier,status,blocksize
    !
    status = 0
    !
    ier = sic_getlun(hfits%unit)
    if (mod(ier,2).eq.0) then
      error = .true.
      return
    endif
    !
    hfits%id = strg_unk
    blocksize = 1  ! Ignored by FTINIT
    call ftinit(hfits%unit,filename,blocksize,status)
    if (cubefitsio_error(rname,status,error))  return
  end subroutine cubefitsio_header_init
  !
  subroutine cubefitsio_header_open(hfits,filename,id,error)
    class(fitsio_header_t), intent(inout) :: hfits
    character(len=*),       intent(in)    :: filename
    character(len=*),       intent(in)    :: id  ! Some identifier string
    logical,                intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='INIT'
    integer(kind=4) :: ier,status,blocksize
    integer(kind=4), parameter :: readonly=0
    !
    if (gag_inquire(filename,len_trim(filename)).ne.0) then
      call cubefitsio_message(seve%e,rname,'No such file '//filename)
      error = .true.
      return
    endif
    !
    ier = sic_getlun(hfits%unit)
    if (mod(ier,2).eq.0) then
      error = .true.
      return
    endif
    !
    hfits%id = id
    status = 0
    call ftopen(hfits%unit,filename,readonly,blocksize,status)
    if (cubefitsio_error(rname,status,error))  return
  end subroutine cubefitsio_header_open
  !
  subroutine cubefitsio_header_close(hfits,error)
    class(fitsio_header_t), intent(inout) :: hfits
    logical,                intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='CLOSE'
    integer(kind=4) :: status
    !
    if (hfits%unit.eq.0)  return  ! Already closed
    !
    status = 0
    call ftclos(hfits%unit,status)
    if (cubefitsio_error(rname,status,error))  return
    !
    call sic_frelun(hfits%unit)
    hfits%unit = 0
    hfits%id = strg_unk
  end subroutine cubefitsio_header_close
  !
  subroutine cubefitsio_header_message(hfits,seve,rname,mess)
    !-------------------------------------------------------------------
    ! Subroutine dedicated to messages customized for the current hfits
    ! object
    !-------------------------------------------------------------------
    class(fitsio_header_t), intent(in)    :: hfits
    integer(kind=4),        intent(in)    :: seve
    character(len=*),       intent(in)    :: rname
    character(len=*),       intent(in)    :: mess
    !
    call cubefitsio_message(seve,rname,  &
      'Object '//trim(hfits%id)//' > '//mess)
    !
  end subroutine cubefitsio_header_message
end module cubefitsio_header
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
