module gildas_tasks_io
  !---------------------------------------------------------------------
  ! Module private to this file
  !---------------------------------------------------------------------
  integer(kind=4) :: ilun,olun
  logical :: inter_state
end module gildas_tasks_io
!
subroutine gildas_open
  use gio_dependencies_interfaces
  use gildas_tasks_io
  use gio_headers
  use gio_interfaces, only : gdf_stbl
  !---------------------------------------------------------------------
  ! @ public
  ! GILDAS
  !       I/O routines for GILDAS tasks.
  !---------------------------------------------------------------------
  ! Local
  integer :: stbl,ier
  logical :: error
  character(len=16) :: chain
  !
  ! Standard FORTRAN unit number, but possible sharing problems
  ilun = 5
  olun = 6
  inter_state = .false.
  !
  if (code_version_gdf_current.lt.code_version_gdf_v20) then
    stbl = 1
  else
    stbl = 2
  endif
  ier = sic_getlog('GILDAS_HEADERS',stbl)
  error = .false.
  call gdf_stbl(stbl,error)
  chain = ' '
  ier = sic_getlog('UVT_VERSION',chain)
  if (chain.ne.' ') call gdf_set_uvt_version(chain)
end subroutine gildas_open
!
subroutine gildas_char (name,chain)
  use gio_dependencies_interfaces
  use gildas_def
  use gildas_tasks_io
  !---------------------------------------------------------------------
  ! @ public
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: name
  character(len=*), intent(out) :: chain
  ! Local
  character(len=16) :: key
  integer :: ier
  !
  if (inter_state) then
    write(olun,101) name
  else
    read (ilun,100) key
    if (key.ne.name)  call gildas_fatale(name)
  endif
  read (ilun,100,iostat=ier) chain
  if (ier.ne.0) then
    call putios ('E-GILDAS_CHAR, '//key,ier)
    call sysexi (fatale)
  endif
100 format(a)
101 format(1x,'Character ',a)
end subroutine gildas_char
!
subroutine gildas_charn (name,string,n)
  use gio_dependencies_interfaces
  use gildas_def
  use gildas_tasks_io
  !---------------------------------------------------------------------
  ! @ public
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: name
  integer(kind=4),  intent(in)  :: n
  character(len=*), intent(out) :: string(n)
  ! Local
  character(len=16) :: key
  integer :: ier,i
  !
  if (inter_state) then
    write(olun,101) name
  else
    read (ilun,100) key
    if (key.ne.name)  call gildas_fatale(name)
  endif
  do i=1,n
    read (ilun,100,iostat=ier) string(i)
    if (ier.ne.0) then
      call putios('E-GILDAS_CHAR,  '//key,ier)
      call sysexi (fatale)
    endif
  enddo
100 format(a)
101 format(1x,'Character ',a)
end subroutine gildas_charn
!
subroutine gildas_real_0d (name,areal,n)
  use gildas_def
  use gbl_message
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>gildas_real_0d
  !---------------------------------------------------------------------
  ! @ public-generic gildas_real
  ! ---
  ! This version for scalar argument
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: name
  integer(kind=4),  intent(in)  :: n
  real(kind=4),     intent(out) :: areal
  ! Local
  character(len=message_length) :: mess
  real(kind=4) :: tmp(1)
  !
  if (n.ne.1) then
    write(mess,'(3A)')  'Internal error: argument ',trim(name),  &
      ' should be array, not scalar'
    call gio_message(seve%e,'GILDAS_REAL',mess)
    call sysexi (fatale)
  endif
  !
  call gildas_real_1d (name,tmp,1)
  areal = tmp(1)
  !
end subroutine gildas_real_0d
!
subroutine gildas_real_1d (name,areal,n)
  use gio_dependencies_interfaces
  use gildas_def
  use gildas_tasks_io
  use gio_interfaces, except_this=>gildas_real_1d
  !---------------------------------------------------------------------
  ! @ public-generic gildas_real
  ! ---
  ! This version for 1D array as argument
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: name
  integer(kind=4),  intent(in)  :: n
  real(kind=4),     intent(out) :: areal(n)
  ! Local
  character(len=16) :: key
  integer :: ier
  !
  if (inter_state) then
    write(olun,102) 'Real',name,n
  else
    read (ilun,100) key
    if (key.ne.name)  call gildas_fatale(name)
  endif
  read (ilun,*,iostat=ier) areal
  if (ier.ne.0) then
    call putios('E-GILDAS_REAL,  '//key,ier)
    call sysexi (fatale)
  endif
100 format(a)
102 format(1x,a,1x,a,1x,i4)
end subroutine gildas_real_1d
!
subroutine gildas_inte4_0d(name,ainte,n)
  use gildas_def
  use gbl_message
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>gildas_inte4_0d
  !---------------------------------------------------------------------
  ! @ public-generic gildas_inte
  ! ---
  ! This version for scalar I*4 argument
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: name
  integer(kind=4),  intent(in)  :: n
  integer(kind=4),  intent(out) :: ainte
  ! Local
  character(len=message_length) :: mess
  integer(kind=4) :: tmp(1)
  !
  if (n.ne.1) then
    write(mess,'(3A)')  'Internal error: argument ',trim(name),  &
      ' should be array, not scalar'
    call gio_message(seve%e,'GILDAS_INTE',mess)
    call sysexi (fatale)
  endif
  !
  call gildas_inte4_1d(name,tmp,1)
  ainte = tmp(1)
  !
end subroutine gildas_inte4_0d
!
subroutine gildas_inte4_1d(name,ainte,n)
  use gio_dependencies_interfaces
  use gildas_def
  use gildas_tasks_io
  use gio_interfaces, except_this=>gildas_inte4_1d
  !---------------------------------------------------------------------
  ! @ public-generic gildas_inte
  ! ---
  ! This version for a 1D I*4 variable
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: name
  integer(kind=4),  intent(in)  :: n
  integer(kind=4),  intent(out) :: ainte(n)
  ! Local
  character(len=16) :: key
  integer(kind=4) :: ier
  !
  if (inter_state) then
    write(olun,102) 'Integer ',name,n
  else
    read (ilun,100) key
    if (key.ne.name)  call gildas_fatale(name)
  endif
  read (ilun,*,iostat=ier) ainte
  if (ier.ne.0) then
    call putios('E-GILDAS_INTE,  '//key,ier)
    call sysexi (fatale)
  endif
100 format(a)
102 format(1x,a,1x,a,1x,i4)
end subroutine gildas_inte4_1d
!
subroutine gildas_inte8_1d(name,along,n)
  use gio_dependencies_interfaces
  use gildas_def
  use gildas_tasks_io
  use gio_interfaces, except_this=>gildas_inte8_1d
  !---------------------------------------------------------------------
  ! @ public-generic gildas_inte
  ! ---
  ! This version for a 1D I*8 variable
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: name
  integer(kind=4),  intent(in)  :: n
  integer(kind=8),  intent(out) :: along(n)
  ! Local
  character(len=16) :: key
  integer(kind=4) :: ier
  !
  if (inter_state) then
    write(olun,102) 'Long ',name,n
  else
    read (ilun,100) key
    if (key.ne.name)  call gildas_fatale(name)
  endif
  read (ilun,*,iostat=ier) along
  if (ier.ne.0) then
    call putios('E-GILDAS_INTE,  '//key,ier)
    call sysexi (fatale)
  endif
100 format(a)
102 format(1x,a,1x,a,1x,i4)
end subroutine gildas_inte8_1d
!
subroutine gildas_logi_0d (name,alogi,n)
  use gildas_def
  use gbl_message
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>gildas_logi_0d
  !---------------------------------------------------------------------
  ! @ public-generic gildas_logi
  ! ---
  ! This version for scalar argument
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: name
  integer(kind=4),  intent(in)  :: n
  logical,          intent(out) :: alogi
  ! Local
  character(len=message_length) :: mess
  logical :: tmp(1)
  !
  if (n.ne.1) then
    write(mess,'(3A)')  'Internal error: argument ',trim(name),  &
      ' should be array, not scalar'
    call gio_message(seve%e,'GILDAS_LOGI',mess)
    call sysexi (fatale)
  endif
  !
  call gildas_logi_1d (name,tmp,1)
  alogi = tmp(1)
  !
end subroutine gildas_logi_0d
!
subroutine gildas_logi_1d (name,alogi,n)
  use gio_dependencies_interfaces
  use gildas_def
  use gildas_tasks_io
  use gio_interfaces, except_this=>gildas_logi_1d
  !---------------------------------------------------------------------
  ! @ public-generic gildas_logi
  ! ---
  ! This version for 1D array as argument
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: name
  integer(kind=4),  intent(in)  :: n
  logical,          intent(out) :: alogi(n)
  ! Local
  character(len=16) :: key
  integer :: ier
  !
  if (inter_state) then
    write(olun,102) 'Logical',name,n
  else
    read (ilun,100) key
    if (key.ne.name)  call gildas_fatale(name)
  endif
  read (ilun,*,iostat=ier) alogi
  if (ier.ne.0) then
    call putios('E-GILDAS_LOGI,  '//key,ier)
    call sysexi (fatale)
  endif
100 format(a)
102 format(1x,a,1x,a,1x,i4)
end subroutine gildas_logi_1d
!
subroutine gildas_dble_0d (name,adble,n)
  use gildas_def
  use gbl_message
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>gildas_dble_0d
  !---------------------------------------------------------------------
  ! @ public-generic gildas_dble
  ! ---
  ! This version for scalar argument
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: name
  integer(kind=4),  intent(in)  :: n
  real(kind=8),     intent(out) :: adble
  ! Local
  character(len=message_length) :: mess
  real(kind=8) :: tmp(1)
  !
  if (n.ne.1) then
    write(mess,'(3A)')  'Internal error: argument ',trim(name),  &
      ' should be array, not scalar'
    call gio_message(seve%e,'GILDAS_DBLE',mess)
    call sysexi (fatale)
  endif
  !
  call gildas_dble_1d(name,tmp,1)
  adble = tmp(1)
  !
end subroutine gildas_dble_0d
!
subroutine gildas_dble_1d (name,adble,n)
  use gio_dependencies_interfaces
  use gildas_def
  use gildas_tasks_io
  use gio_interfaces, except_this=>gildas_dble_1d
  !---------------------------------------------------------------------
  ! @ public-generic gildas_dble
  ! ---
  ! This version for 1D array as argument
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: name
  integer(kind=4),  intent(in)  :: n
  real(kind=8),     intent(out) :: adble(n)
  ! Local
  character(len=16) :: key
  integer :: ier
  !
  if (inter_state) then
    write(olun,102) 'Double',name,n
  else
    read (ilun,100) key
    if (key.ne.name)  call gildas_fatale(name)
  endif
  read (ilun,*,iostat=ier) adble
  if (ier.ne.0) then
    call putios('E-GILDAS_DBLE,  '//key,ier)
    call sysexi (fatale)
  endif
100 format(a)
102 format(1x,a,1x,a,1x,i4)
end subroutine gildas_dble_1d
!
subroutine gildas_close
  use gio_dependencies_interfaces
  use gildas_tasks_io
  !---------------------------------------------------------------------
  ! @ public
  !---------------------------------------------------------------------
  if (ilun.eq.5) return
  close (unit=ilun)
  call sic_frelun (olun)
end subroutine gildas_close
!
subroutine gildas_fatale(name)
  use gio_dependencies_interfaces
  use gildas_def
  use gio_interfaces, only : gio_message
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: name
  !
  call gio_message(seve%f,'GILDAS_OPEN','Missing parameter '//name)
  call sysexi (fatale)
end subroutine gildas_fatale
