!
module gio_section32
  !--------------------------------------------------------------------
  ! GIO global parameters for header sections support
  !--------------------------------------------------------------------
  integer(kind=4), parameter :: mvoc=11
  character(len=12), parameter :: vocab(mvoc) =  (/  &
       'GENERAL     ',  &
       'BLANKING    ',  &
       'EXTREMA     ',  &
       'DESCRIPTION ',  &
       'POSITION    ',  &
       'PROJECTION  ',  &
       'SPECTROSCOPY',  &
       'RESOLUTION  ',  &
       'NOISE       ',  &
       'PROPERMOTION',  &
       'TABLE       ' /)
  integer(kind=4), parameter :: address_32(mvoc) = & 
         & (/ 11,41,44,55,74,87,97,110,114,117,11 /)
  integer(kind=4), parameter :: length_32(mvoc) = &
         & (/ 29,2,10,18,12,9,12,3,2,5,5 /)
end module gio_section32
!
!
subroutine gio_whsec32(ibuf32,type,array,size,error)
  use gio_dependencies_interfaces
  use gio_image
  use gio_section32
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! GDF   Stand-Alone routine
  !       Write a descriptor in Header of file, in "old" 32 bit
  !           format.
  !----------------------------------------------------------------------
  !
  !       Greg Data Frame structure
  !       Fixed length 512-bytes Records
  !
  ! First Record  : Header
  ! Others        : Data
  ! After data (if needed) : Comments
  !
  ! Basic Header for data checks
  !       'GILDAS_IMAGE  '                        ! C*12
  !       Type (Real, Real*8, Integer)
  !       Data Length (Blocks)                    !
  !       Additional Information (blocks)         !
  !                                               ! 10  Words reserved
  !
  ! KEY = GENERAL                 (1)
  !       LENGTH
  !       NDIM (<4)               1       2
  !       DIM(4)                  4       6
  !       XREF,XVAL,XINC (4 fois) 3*8     30
  !       Length = 30     Words                   ! 40
  !
  ! KEY = TABLE                   (8)
  !       LENGTH
  !       NDIM                    1       2
  !       DIM(4)                  1       6
  !       Length = 6      Words
  !
  ! KEY = BLANKING                (2)
  !       LENGTH
  !       BVAL,EVAL               2       3
  !       Length = 3      Words                   ! 43
  !
  ! KEY = EXTREMA                 (3)
  !       LENGTH
  !       RMIN,RMAX, MIN1,MAX1, MIN2,MAX2, MIN3,MAX3, MIN4,MAX4
  !       Length = 11     Words                   ! 54
  !
  ! KEY = DESCRIPTION             (4)
  !       LENGTH
  !       UNIT C*12       Map unit  3     4
  !       CODE C*12(4)    Axis type 4*3   16
  !       SYST C*12       Coord. Sy.3     19
  !       Length = 16     Words                   ! 73
  !
  ! KEY = POSITION                (5)
  !       LENGTH
  !       RSOURC C*12             3       4       ! Source name
  !       REPOCH R*4              1       5       ! Epoch of observation
  !       RRA,   R*8              2       7       ! R.A. of center position
  !       RDEC,  R*8              2       9       ! Declination ----
  !       RL,    R*8              2       11      ! Galactic longitude
  !       RB     R*8              2       13      ! Galactic latitude
  !       Length = 13     Words                   ! 86
  !
  ! KEY = PROJECTION              (6)
  !       LENGTH
  !       TYPE,A0,D0,ANGLE        1+3*2   8
  !       AXIS1,AXIS2             2*1     10      ! Projected axis
  !       Length = 10     Words                   ! 96
  !
  ! KEY = SPECTROSCOPY            (7)
  !       LENGTH
  !       RLINE  C*12             ! Line name
  !       RFRES, R*8              ! Frequency resolution
  !       RFIMA, R*8              ! Image Frequency
  !       RVRES, R*4              ! Velocity resolution
  !       RVOFF  R*4              ! Velocity offset
  !       RRESTF R*8              ! Rest frequency of transition
  !       RFAXI  I*4              ! Frequency axis
  !       Length = 13             ! 109
  !
  ! KEY = RESOLUTION              (8)
  !       LENGTH
  !       MAJOR                   ! Major axis
  !       MINOR                   ! Minor axis
  !       POSITION_ANGLE          !
  !       Length = 4              ! 113
  !---------------------------------------------------------------------
  integer, intent(inout) :: ibuf32(*)         ! Buffer where sections must be stored
  character(len=*), intent(in) :: type        ! Section name
  integer, intent(in) :: array(*)             ! Section array values
  integer, intent(in) :: size                 ! Section size
  logical :: error                  !
  ! Local
  character(len=*), parameter :: rname='GDF_Whsec32'
  character(len=12) :: keywor
  integer :: nkey
  integer :: azero(128),k,ia,l,i
  data azero/128*0/
  !
!  if (islot(is).eq.empty_gio) then
!    call gio_message(seve%e,rname,'Image slot is empty')
!    error = .true.
!    return
!  endif
  !
  ! Find section
  error = .false.
  call sic_ambigs('GDF_Whsec32',type,keywor,nkey,vocab,mvoc,error)
  if (error) return
  !
  ! Put at appropriate location
  k = length_32(nkey)-size
  if (k.lt.0) then
    if (nkey.gt.1) then
      call gio_message(seve%w,rname,'Section '//trim(keywor)//' too long')
    endif
    l = length_32(nkey)
  else
    l = size
  endif
  !
  ia = address_32(nkey)
  ibuf32 (ia) = 4*l
  do i=1,l
    ibuf32(ia+i) = array(i)
  enddo
  do i=1,k
    ibuf32(ia+l+i) = 0
  enddo
end subroutine gio_whsec32
!
subroutine gio_rhsec32(ibuf32,type,array,size,error)
  use gio_dependencies_interfaces
  use gio_image
  use gio_section32
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! GREG  Stand-alone routine
  !       Find information Greg Data Frame header
  !---------------------------------------------------------------------
  integer, intent(inout) :: ibuf32(*)         ! Buffer from which section must be fetched
  character(len=*), intent(in) :: type        ! Section name
  integer, intent(inout) :: array(*)          ! Section data
  integer, intent(inout) :: size              ! Section size
  logical :: error                  !
  ! Local
  character(len=*), parameter :: rname='GDF_Rhsec32'
  character(len=12) :: keywor
  integer :: nkey
  integer :: i,ia,l
  !
!  if (islot(is).eq.empty_gio) then
!    call gio_message(seve%e,rname,'Image slot is empty')
!    error = .true.
!    return
!  endif
  !
  ! Find section
  error = .false.
  call sic_ambigs('GDF_Rhsec32',type,keywor,nkey,vocab,mvoc,error)
  if (error) return
  !
  ! Get from appropriate location
  ia = address_32(nkey)
  l = ibuf32(ia) / 4
  if (l.le.0) then
    size = 0
    call gio_message(seve%d,rname,'Absent section '//keywor)
    return
  endif
  if (size.lt.l) then
    l = size
    ! Ignore message for TABLE section
    if (nkey.ne.mvoc .and. nkey.ne.1) then
      call gio_message(seve%w,rname,'Section '//trim(keywor)//' too long')
    endif
  endif
  !
  ! Table section : verify there is no more than 2 dimension
  if (nkey.eq.mvoc) then
    ibuf32(ia+1) = 0
    do i=2,5
      if (ibuf32(ia+i).gt.1)  ibuf32(ia+1) = ibuf32(ia+1)+1
    enddo
  endif
  do i=1,l
    array(i) = ibuf32(ia+i)
  enddo
  size = l
end subroutine gio_rhsec32
!
!
subroutine gio_cvhd32 (len,inhead,ouhead,r8,r4,i4)
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  integer, intent(in)  :: len       ! Length of buffer
  integer, intent(in)  :: inhead(*) ! Input values in file format
  integer, intent(out) :: ouhead(*) ! Converted values in machine format
  external :: r8                    ! Real*8 conversion routine
  external :: r4                    ! Real*4 conversion routine
  external :: i4                    ! Integer*4 conversion routine
  ! Local
  integer :: i
  !
  real(4) :: intmp(8),outmp(8)
  !
  do i=1,len
    ouhead(i) = inhead(i)
  enddo
  call i4 (inhead(4),ouhead(4),2)      ! X_FORM, ndb
  call i4 (inhead(11),ouhead(11),6)    ! X_gene, Ndim, Dim
  call r8 (inhead(17),ouhead(17),12)   ! Conversion formula
  call i4 (inhead(41),ouhead(41),1)    ! X_blan
  call r4 (inhead(42),ouhead(42),2)    ! Blanking
  call i4 (inhead(44),ouhead(44),1)    ! X_extr
  call r4 (inhead(45),ouhead(45),2)    ! Values at extrema
  call i4 (inhead(47),ouhead(47),8)    ! Position of extrema
  call i4 (inhead(55),ouhead(55),1)    ! X_desc
  call i4 (inhead(74),ouhead(74),1)    ! X_posi
  call r4tor4(inhead(78),intmp,8)      ! Mis-aligned stuff
  call r8 (intmp,outmp,4)              ! RA,Dec,lII,bII
  call r4tor4(outmp,ouhead(78),8)      !
  call r4 (inhead(86),ouhead(86),1)    ! Epoch
  ! print *,'Inhead 87-88 ',inhead(87), inhead(88)
  call i4 (inhead(87),ouhead(87),2)    ! X_proj, X_Ptyp
  ! print *,'Inhead 87-88 ',ouhead(87), ouhead(88)
  call r8 (inhead(89),ouhead(89),3)    ! Projection
  call i4 (inhead(95),ouhead(95),3)    ! X_Xaxi, X_Yaxi, X_spec
  call r8 (inhead(101),ouhead(101),3)  ! Spectro (frequency)
  call r4 (inhead(107),ouhead(107),2)  ! Spectro (velocity)
  call i4 (inhead(109),ouhead(109),2)  ! X_Faxi, X_reso
  call r4 (inhead(111),ouhead(111),3)  ! Resolution
  call i4 (inhead(114),ouhead(114),1)  ! X_Sigma
  call r4 (inhead(115),ouhead(115),2)  ! Noise, Rms
end subroutine gio_cvhd32
!!
subroutine gio_read32header(hd32,ibuf32,error)
  use gio_headers
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! GIO / GDF Internal routine
  !       Read an image header from the requested slot ISLO
  !       The slot must have been properly opened before
  !---------------------------------------------------------------------
  type (gildas_header_v1), intent(out) :: hd32   ! GILDAS image structure
  integer(kind=4), intent(inout) :: ibuf32(*)    ! Buffer of data
  logical, intent(inout) :: error                ! Error flag
  ! Local
  integer :: ilen
  !
  hd32%ijtyp = ibuf32(1:3)
  call bytoby (ibuf32,hd32%ijtyp,12)
  hd32%ndb = ibuf32(4)
  hd32%form = ibuf32(5)
  ilen = 29
  call gio_rhsec32(ibuf32,'GENERAL',hd32%ndim,ilen,error)
  hd32%gene = ilen
  ilen = 2
  call gio_rhsec32(ibuf32,'BLANKING',hd32%bval,ilen,error)
  hd32%blan = ilen
  ilen = 10
  call gio_rhsec32(ibuf32,'EXTREMA',hd32%rmin,ilen,error)
  hd32%extr = ilen
  ilen = 18
  call gio_rhsec32(ibuf32,'DESCRIPTION',hd32%ijuni,ilen,error)
  hd32%desc = ilen
  ilen = 12
  call gio_rhsec32(ibuf32,'POSITION',hd32%ijsou,ilen,error)
  hd32%posi = ilen
  ilen = 9
  call gio_rhsec32(ibuf32,'PROJECTION',hd32%ptyp,ilen,error)
  hd32%proj = ilen
  ilen = 12
  call gio_rhsec32(ibuf32,'SPECTROSCOPY',hd32%ijlin,ilen,error)
  hd32%spec = ilen
  ilen = 3
  call gio_rhsec32(ibuf32,'RESOLUTION',hd32%majo,ilen,error)
  hd32%reso = ilen
  ilen = 2
  call gio_rhsec32(ibuf32,'NOISE',hd32%noise,ilen,error)
  hd32%sigm = ilen
  ilen = 4
  call gio_rhsec32(ibuf32,'PROPERMOTION',hd32%mura,ilen,error)
  hd32%prop = ilen
  !
  !
  !!write(99,*) 'Tested gio_read_header'
  !!call gdf_dump(imag) ! To debug...
end subroutine gio_read32header
!
subroutine gio_write32header(hd32,ibuf32,error)
  use gio_headers
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! GDF / GIO Internal routine
  !       Update an image header on a specified image slot
  !           The slot must have been opened before
  !---------------------------------------------------------------------
  type (gildas_header_v1), intent(inout) :: hd32   ! GILDAS type output structure
  integer(kind=4), intent(out) :: ibuf32(*)  ! Working buffer
  logical, intent(out) :: error             ! Logical error flag
  ! Local
  integer :: i
  !
  error = .false.
  do i=1,4
    hd32%dim(i)=max(1,hd32%dim(i))
  enddo
  !
  call gio_whsec32(ibuf32,'GENERAL',     hd32%ndim, hd32%gene,error)
  call gio_whsec32(ibuf32,'BLANKING',    hd32%bval, hd32%blan,error)
  call gio_whsec32(ibuf32,'EXTREMA',     hd32%rmin, hd32%extr,error)
  call gio_whsec32(ibuf32,'DESCRIPTION', hd32%ijuni, hd32%desc,error)
  call gio_whsec32(ibuf32,'POSITION',    hd32%ijsou, hd32%posi,error)
  call gio_whsec32(ibuf32,'PROJECTION',  hd32%ptyp, hd32%proj,error)
  call gio_whsec32(ibuf32,'SPECTROSCOPY',hd32%ijlin, hd32%spec,error)
  call gio_whsec32(ibuf32,'RESOLUTION',  hd32%majo, hd32%reso,error)
  call gio_whsec32(ibuf32,'NOISE',       hd32%noise,hd32%sigm,error)
  call gio_whsec32(ibuf32,'PROPERMOTION',hd32%mura, hd32%prop,error)
  !
  !!write(99,*) 'Tested gio_write_header'
end subroutine gio_write32header
!
