!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeio_header_hgdf
  use cubetools_header_types
  use cubetools_header_interface
  use cubeio_interface
  use cubeio_messaging
  !
  public :: cubeio_header_get_and_derive_fromhgdf,cubeio_header_put_tohdgf
  public :: cubeio_hgdf_export
  private
  !
contains
  !
  subroutine cubeio_header_get_and_derive_fromhgdf(hgdf,head,error)
    use image_def
    !-------------------------------------------------------------------
    ! From type(gildas) to type(cube_header_t)
    !-------------------------------------------------------------------
    type(gildas),        intent(in)    :: hgdf
    type(cube_header_t), intent(inout) :: head
    logical,             intent(inout) :: error
    !
    type(cube_header_interface_t) :: interface
    character(len=*), parameter :: rname='HEADER>GET>AND>DERIVE'
    !
    call cubeio_message(ioseve%trace,rname,'Welcome')
    !
    call cubeio_hgdf_export(hgdf,interface,error)
    if (error) return
    call cubetools_header_import_and_derive(interface,head,error)
    if (error) return
  end subroutine cubeio_header_get_and_derive_fromhgdf
  !
  subroutine cubeio_header_put_tohdgf(head,order,hgdf,verbose,error)
    use image_def
    !-------------------------------------------------------------------
    ! From type(cube_header_t) to type(gildas) with desired order
    !-------------------------------------------------------------------
    type(cube_header_t),  intent(in)    :: head
    integer(kind=code_k), intent(in)    :: order  ! code_order_*
    type(gildas),         intent(inout) :: hgdf
    logical,              intent(in)    :: verbose
    logical,              intent(inout) :: error
    !
    type(cube_header_interface_t) :: interface
    character(len=*), parameter :: rname='HEADER>PUT'
    !
    call cubeio_message(ioseve%trace,rname,'Welcome')
    !
    call cubetools_header_export(head,interface,error)
    if (error) return
    call cubeio_interface_transpose(interface,order,error)
    if (error) return
    call cubeio_hgdf_import(interface,hgdf,error)
    if (error) return
  end subroutine cubeio_header_put_tohdgf
  !
  !---------------------------------------------------------------------
  !
  subroutine cubeio_hgdf_export(hgdf,out,error)
    use phys_const
    use image_def
    use gkernel_interfaces
    use cubetools_parameters
    use cubetools_messaging
!    use cubetools_header_interface
    use cubetools_unit_setup
    use cubetools_convert
    use cubetools_observatory_types
    use cubetools_obstel_types
    !-------------------------------------------------------------------
    ! From type(gildas) to type(cube_header_interface_t)
    !-------------------------------------------------------------------
    type(gildas),                  intent(in)    :: hgdf
    type(cube_header_interface_t), intent(inout) :: out
    logical,                       intent(inout) :: error
    !
    integer(kind=data_k) :: faxis
    integer(kind=ndim_k) :: idim,ndim
    character(len=unit_l) :: name,specode,spaframe
    integer(kind=4) :: itel
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='HGDF>EXPORT'
    !
    call cubeio_message(ioseve%trace,rname,'Welcome')
    !
    ! Nullify everything first, leave them nullified if not relevant
    call out%init(error)
    if (error)  return
    !
    ! Data format
    out%array_type = hgdf%gil%form
    !
    ! Dimension section
    if (hgdf%gil%ndim.le.maxdim) then
       ndim = hgdf%gil%ndim
    else
       call cubeio_message(seve%d,rname,'Larger number of dimensions than room to store it! => Truncating')
       ndim = maxdim
    endif
    out%axset_ndim = ndim
    out%axset_dim = 0
    out%axset_dim(1:ndim) = hgdf%gil%dim(1:ndim)
    !
    ! Blanking section
    if (hgdf%gil%blan_words.gt.0) then
      call cubeio_message(seve%d,rname,  &
        'GDF file provides a blanking section with possible blanks values in data')
    endif
    !
    ! Extrema section
    if (hgdf%gil%extr_words.gt.0) then
       out%array_minval = hgdf%gil%rmin
       out%array_maxval = hgdf%gil%rmax
       out%array_minloc(1:ndim) = hgdf%gil%minloc(1:ndim)
       out%array_maxloc(1:ndim) = hgdf%gil%maxloc(1:ndim)
    endif
    !
    ! Coordinate section
    out%axset_convert = 0d0
    out%axset_convert(:,1:ndim) = hgdf%gil%convert(:,1:ndim)
    !
    ! Description section. NB: no unit conversion involved here, as
    ! the GDF and header-interface internal units are the same.
    out%array_unit = hgdf%char%unit
    out%axset_name(1:ndim) = hgdf%char%code(1:ndim) ! code can be used to encore the axis name
    out%axset_unit(1:ndim) = hgdf%char%code(1:ndim) ! or the axis unit...
    do idim = 1,maxdim
       name = out%axset_name(idim)
       call sic_upper(name)
       select case (name)
       case('ANGLE')
          ! To handle MAPPING beams
          out%axset_kind(idim) = code_unit_fov
       case('RA')
          out%axset_kind(idim) = code_unit_fov
          out%axset_unit(idim) = unitbuffer%prog_name(code_unit_fov)
       case('DEC')
          out%axset_kind(idim) = code_unit_fov
          out%axset_unit(idim) = unitbuffer%prog_name(code_unit_fov)
       case('LII')
          out%axset_kind(idim) = code_unit_fov
          out%axset_unit(idim) = unitbuffer%prog_name(code_unit_fov)
       case('BII')
          out%axset_kind(idim) = code_unit_fov
          out%axset_unit(idim) = unitbuffer%prog_name(code_unit_fov)
       case('VELOCITY')
          out%axset_kind(idim) = code_unit_velo
          out%axset_unit(idim) = unitbuffer%prog_name(code_unit_velo)
       case('FREQUENCY')
          out%axset_kind(idim) = code_unit_freq
          out%axset_unit(idim) = unitbuffer%prog_name(code_unit_freq)
       case default
          ! Does nothing
          out%axset_kind(idim) = code_unit_unk
        ! out%axset_unit(idim) = Keep name written in data format
       end select
    enddo ! idim
    !
    ! Position section
    if (hgdf%gil%posi_words.gt.0) then
      if (hgdf%char%name.eq.'') then
        out%spatial_source = strg_unk
      else
        out%spatial_source = hgdf%char%name
      endif
      ! *** JP
      if (hgdf%char%syst.eq.'') then
        spaframe = strg_unk
        call sic_upper(spaframe)
      else
        spaframe = hgdf%char%syst
      endif
      ! *** JP
      call cubetools_convert_spaframe2code(spaframe,out%spatial_frame_code,error)
      if (error) return
      call cubeio_message(seve%d,rname,'Source position is lost in CUBE, only the projection center is used')
      out%spatial_frame_equinox = hgdf%gil%epoc
    endif
    !
    ! Projection section
    if (hgdf%gil%proj_words.gt.0) then
      out%spatial_projection_l0   = hgdf%gil%a0
      out%spatial_projection_m0   = hgdf%gil%d0
      out%spatial_projection_pa   = hgdf%gil%pang
      out%spatial_projection_code = hgdf%gil%ptyp
      if (hgdf%gil%xaxi.le.out%axset_ndim) then
        out%axset_ix = hgdf%gil%xaxi
      else
        write(mess,100)  'X',hgdf%gil%xaxi,out%axset_ndim
        call cubeio_message(seve%w,rname,mess)
        out%axset_ix = 0
      endif
      if (hgdf%gil%yaxi.le.out%axset_ndim) then
        out%axset_iy = hgdf%gil%yaxi
      else
        write(mess,100)  'Y',hgdf%gil%yaxi,out%axset_ndim
        call cubeio_message(seve%w,rname,mess)
        out%axset_iy = 0
      endif
    endif
    !
    ! Spectroscopy section
    if (hgdf%gil%spec_words.gt.0) then
      out%spectral_convention = code_speconv_radio
      out%spectral_code = code_spectral_frequency ! Frequencies, not wavelengths
      ! Spectral increment
      faxis = hgdf%gil%faxi
      if ((1.le.faxis).and.(faxis.le.gdf_maxdims)) then
        specode = hgdf%char%code(faxis)
        ! Get primary resolution from %convert() array (double precision)
        ! instead header element %fres (single precision):
        select case (specode)
        case ('FREQUENCY')
            out%spectral_increment_value = hgdf%gil%convert(code_inc,faxis)
        case ('VELOCITY')
            out%spectral_increment_value = cubetools_convert_vres2fres(hgdf%gil%convert(code_inc,faxis),hgdf%gil%freq)
        case default
            call cubeio_message(seve%d,rname,'Unknown spectral code: '//specode)
            out%spectral_increment_value = hgdf%gil%fres
        end select ! specode
      else
        out%spectral_increment_value = hgdf%gil%fres
      endif
      ! Values at reference channel
      out%spectral_signal_value = hgdf%gil%freq
      out%spectral_image_value  = hgdf%gil%fima
      out%spectral_systemic_code = code_systemic_velocity
      out%spectral_systemic_value = hgdf%gil%voff
      call cubeio_message(seve%d,rname,'Doppler information is lost in CUBE')
      if (hgdf%gil%faxi.le.out%axset_ndim) then
        out%axset_ic = hgdf%gil%faxi
      else
        write(mess,100)  'F',hgdf%gil%faxi,out%axset_ndim
        call cubeio_message(seve%w,rname,mess)
        out%axset_ic = 0
      endif
      out%spectral_frame_code = hgdf%gil%vtyp+1
      if (hgdf%char%line.eq.'') then
        out%spectral_line = strg_unk
      else
        out%spectral_line = hgdf%char%line
      endif
    else
      ! *** JP Waiting for a better handling of missing spectral information
      !        on the interface-to-header side
      out%spectral_convention = code_speconv_radio
      out%spectral_code = code_spectral_frequency ! Frequencies, not wavelengths
      out%spectral_systemic_code = code_systemic_velocity
    endif
    !
    ! Resolution section
    if (hgdf%gil%reso_words.le.0) then
       call cubeio_message(seve%d,rname,'No resolution section in input cube header')
    else
       out%spatial_beam_major = hgdf%gil%majo
       out%spatial_beam_minor = hgdf%gil%mino
       out%spatial_beam_pa    = hgdf%gil%posa
    endif
    !
    ! Noise section
    if (hgdf%gil%nois_words.le.0) then
       call cubeio_message(seve%d,rname,'No noise section in input cube header')
    else
       out%array_noise = hgdf%gil%noise
       out%array_rms   = hgdf%gil%rms
    endif
    !
    ! Astrometry section
    if (hgdf%gil%astr_words.gt.0) then
       call cubeio_message(seve%d,rname,'Astrometry section is lost in CUBE')
    else
       ! Does nothing
    endif
    !
    ! Observatory section
    call cubetools_observatory_reallocate(hgdf%gil%nteles,out%obs,error)
    if (error) return
    do itel=1,hgdf%gil%nteles
      call cubetools_obstel_get_and_derive(&
        hgdf%gil%teles(itel)%lon*rad_per_deg,&
        hgdf%gil%teles(itel)%lat*rad_per_deg,&
        hgdf%gil%teles(itel)%alt,&
        hgdf%gil%teles(itel)%diam,&
        hgdf%gil%teles(itel)%ctele,&
        out%obs%tel(itel),error)
      if (error) return
    enddo ! itel
    !
!!$    ! ***JP:
!!$    if (out%axset_ix.eq.0) out%axset_ix = 1
!!$    if (out%axset_iy.eq.0) out%axset_iy = 2
!!$    ! ***JP:
    !
    100 format(a,' axis dimension (',i0,') larger than the number of supported dimensions (',i0,')')
  end subroutine cubeio_hgdf_export
  !
  subroutine cubeio_hgdf_import(in,hgdf,error)
    use cubetools_parameters
    use cubetools_messaging
    use phys_const
    use image_def
!    use cubetools_header_interface
    use cubetools_nan
    use cubetools_convert
    use cubetools_obstel_types
    !-------------------------------------------------------------------
    ! From type(cube_header_interface_t) to type(gildas)
    ! *** JP: Removed verbose from calling sequence.
    ! *** JP: If such a mechanism is needed it should be a DEBUG HGDF IO ON|OFF
    !-------------------------------------------------------------------
    type(cube_header_interface_t), intent(in)    :: in
    type(gildas),                  intent(inout) :: hgdf
    logical,                       intent(inout) :: error
    !
    integer(kind=ndim_k) :: ndim
    integer(kind=4) :: itel,ier
    real(kind=coor_k) :: lon,lat
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='HGDF>IMPORT'
    !
    call cubeio_message(ioseve%trace,rname,'Welcome')
    !
    ! Data format
    hgdf%gil%form = in%array_type
    ! Dimension section
    if (in%axset_ndim.le.gdf_maxdims) then
       ndim = in%axset_ndim
    else
       call cubeio_message(seve%d,rname,'Larger number of dimensions than room to store it! => Truncating')
       ndim = gdf_maxdims
    endif
    hgdf%gil%ndim = ndim
    hgdf%gil%dim = 0
    hgdf%gil%dim(1:ndim) = in%axset_dim(1:ndim)
    ! Blanking section disabled as we use NaN
    hgdf%gil%blan_words = 0
    call cubeio_message(seve%d,rname,'Undefined blanking values')
    ! Extrema section
    call cubeio_message(seve%d,rname,'Number of NaN element is lost in GDF format')
    if (ieee_is_nan(in%array_minval) .or. ieee_is_nan(in%array_maxval)) then
       ! Disable the section
       hgdf%gil%extr_words = 0
       call cubeio_message(seve%d,rname,'Undefined extrema')
    else
       hgdf%gil%extr_words = 6
       hgdf%gil%rmin = in%array_minval
       hgdf%gil%rmax = in%array_maxval
       hgdf%gil%minloc = 0
       hgdf%gil%maxloc = 0
       hgdf%gil%minloc(1:ndim) = in%array_minloc(1:ndim)
       hgdf%gil%maxloc(1:ndim) = in%array_maxloc(1:ndim)
    endif
    ! Coordinate section
    hgdf%gil%convert = 0d0
    hgdf%gil%convert(:,1:ndim) = in%axset_convert(:,1:ndim)
    ! Description section
    hgdf%char%unit = in%array_unit
    hgdf%char%code(1:ndim) = in%axset_name(1:ndim)
    call cubeio_message(seve%d,rname,'Axis unit information is lost in GDF format')
    ! Position section
    hgdf%char%name = in%spatial_source
    call cubetools_convert_code2spaframe(in%spatial_frame_code,hgdf%char%syst,error)
    if (error) return
    select case (in%spatial_frame_code)
    case (code_spaframe_icrs)
       ! Deduce RA,DEC from L0,M0 and compute LII,BII
       hgdf%gil%ra   = in%spatial_projection_l0
       hgdf%gil%dec  = in%spatial_projection_m0
       hgdf%gil%epoc = equinox_null  ! Not relevant for ICRS description
       call cubeio_message(seve%w,rname,  &
         'Conversion from ICRS to galactic is not implemented, LII BII set to 0')
       hgdf%gil%lii = 0.d0
       hgdf%gil%bii = 0.d0
    case (code_spaframe_equatorial)
       ! Deduce RA,DEC from L0,M0 and compute LII,BII
       hgdf%gil%ra   = in%spatial_projection_l0
       hgdf%gil%dec  = in%spatial_projection_m0
       hgdf%gil%epoc = in%spatial_frame_equinox
       call equ_gal(hgdf%gil%ra,hgdf%gil%dec,hgdf%gil%epoc,hgdf%gil%lii,hgdf%gil%bii,error)
       if (error)  return
    case (code_spaframe_galactic)
       ! Deduce LII,BII from L0,M0 and compute RA,DEC
       hgdf%gil%lii  = in%spatial_projection_l0
       hgdf%gil%bii  = in%spatial_projection_m0
       hgdf%gil%epoc = 2000.0  ! Some arbitrary equinox for the alternate system
       call gal_equ(hgdf%gil%lii,hgdf%gil%bii,hgdf%gil%ra,hgdf%gil%dec,hgdf%gil%epoc,error)
       if (error)  return
    case default
       ! *** JP: I then assume that the source position has no more meaning.
       hgdf%gil%ra   = 0.0
       hgdf%gil%dec  = 0.0
       hgdf%gil%epoc = equinox_null
       hgdf%gil%lii  = 0.0
       hgdf%gil%bii  = 0.0
    end select
    ! Projection section
    hgdf%gil%a0   = in%spatial_projection_l0
    hgdf%gil%d0   = in%spatial_projection_m0
    hgdf%gil%pang = in%spatial_projection_pa
    hgdf%gil%ptyp = in%spatial_projection_code
    if (in%axset_ix.le.hgdf%gil%ndim) then
       hgdf%gil%xaxi = in%axset_ix
    else
       write(mess,100)  'X',in%axset_ix,hgdf%gil%ndim
       call cubeio_message(seve%w,rname,mess)
       hgdf%gil%xaxi = 0
    endif
    if (in%axset_iy.le.hgdf%gil%ndim) then
       hgdf%gil%yaxi = in%axset_iy
    else
       write(mess,100)  'Y',in%axset_iy,hgdf%gil%ndim
       call cubeio_message(seve%w,rname,mess)
       hgdf%gil%yaxi = 0
    endif
    ! Spectroscopy section
    if (in%spectral_convention.eq.code_speconv_unknown) then
       continue
    else if (in%spectral_convention.ne.code_speconv_radio) then
       call cubeio_message(seve%e,rname,'GDF format can only handle the radio convention')
       error = .true.
       return
    endif
    if (in%spectral_systemic_code.eq.code_systemic_unknown) then
       continue
    else if (in%spectral_systemic_code.ne.code_systemic_velocity) then
       call cubeio_message(seve%e,rname,'GDF format can only handle the source frame velocity, not its redshift')
       error = .true.
       return
    endif
    if (in%spectral_code.eq.code_spectral_unknown) then
       continue
    else if (in%spectral_code.ne.code_spectral_frequency) then
       call cubeio_message(seve%e,rname,'GDF format can only handle frequencies, not wavelengths')
       error = .true.
       return
    endif
    hgdf%gil%fima = in%spectral_image_value
    hgdf%gil%freq = in%spectral_signal_value
    hgdf%gil%fres = real(in%spectral_increment_value,kind=4)
    hgdf%gil%vres = cubetools_convert_fres2vres(in%spectral_increment_value,hgdf%gil%freq)
    hgdf%gil%voff = real(in%spectral_systemic_value,kind=4)
    hgdf%gil%vtyp = in%spectral_frame_code-1
    hgdf%gil%dopp = 0.0
    if (in%axset_ic.le.hgdf%gil%ndim) then
       hgdf%gil%faxi = in%axset_ic
    else
       write(mess,100)  'F',in%axset_ic,hgdf%gil%ndim
       call cubeio_message(seve%w,rname,mess)
       hgdf%gil%faxi = 0
    endif
    hgdf%char%line = in%spectral_line
    ! Resolution section
    if (ieee_is_nan(in%spatial_beam_major) .or. ieee_is_nan(in%spatial_beam_minor) .or. ieee_is_nan(in%spatial_beam_pa)) then
       hgdf%gil%reso_words = 0
       call cubeio_message(seve%d,rname,'Undefined beam')
    else
       hgdf%gil%reso_words = 3
       hgdf%gil%majo = in%spatial_beam_major
       hgdf%gil%mino = in%spatial_beam_minor
       hgdf%gil%posa = in%spatial_beam_pa
    endif
    ! Noise section
    if (ieee_is_nan(in%array_noise) .or. ieee_is_nan(in%array_rms)) then
       hgdf%gil%nois_words = 0
       call cubeio_message(seve%d,rname,'Undefined noise levels')
    else
       hgdf%gil%nois_words = 3
       hgdf%gil%noise = in%array_noise
       hgdf%gil%rms = in%array_rms
    endif
    ! Astrometry section
    hgdf%gil%astr_words = 0
    call cubeio_message(seve%d,rname,'Undefined astrometry')
    ! Observatory section
    if (in%obs%ntel.le.0) then
      hgdf%gil%tele_words = 0
      call cubeio_message(seve%d,rname,'Undefined observatory')
    else
      hgdf%gil%tele_words = 1
      hgdf%gil%nteles = in%obs%ntel
      ! ZZZ There should be a reallocate API in GILDAS kernel (see also gdf_addteles)
      if (allocated(hgdf%gil%teles))  deallocate(hgdf%gil%teles)
      allocate(hgdf%gil%teles(hgdf%gil%nteles),stat=ier)
      if (failed_allocate(rname,'Telescope list',ier,error)) return
      do itel = 1,hgdf%gil%nteles
        call cubetools_obstel_put(in%obs%tel(itel),&
              lon,lat,&
              hgdf%gil%teles(itel)%alt,&
              hgdf%gil%teles(itel)%diam,&
              hgdf%gil%teles(itel)%ctele,&
              error)
        hgdf%gil%teles(itel)%lon = lon*deg_per_rad
        hgdf%gil%teles(itel)%lat = lat*deg_per_rad
      enddo ! itel
    endif
    100 format(a,' axis dimension (',i0,') larger than the number of supported dimensions (',i0,')')
  end subroutine cubeio_hgdf_import
  !
end module cubeio_header_hgdf
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
