subroutine gdf_stbl(stbl,error)
  use gio_interfaces, only : gio_message
  use gio_image
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! GDF set STarting BLOcks default
  !     temporary routine to change the number of header blocks
  !---------------------------------------------------------------------
  integer, intent(in)  :: stbl      ! Number of starting blocks
  logical, intent(out) :: error     ! Error flag
  ! Local
  character(len=60) :: chain
  !
  if (stbl.lt.1 .or. stbl.gt.10) then
    call gio_message(seve%e,'GDF_STBL','Invalid starting block number')
    error = .true.
    return
  endif
  write(chain,'(A,I0,A)') 'Setting ',stbl,' starting blocks'
  call gio_message(seve%d,'GDF_STBL',chain)
  startbl = stbl
  error = .false.
end subroutine gdf_stbl
!
function gdf_stbl_get()
  use gio_image
  !---------------------------------------------------------------------
  ! @ public
  ! Return the STarting BLOcks default
  !     temporary routine to change the number of header blocks
  !---------------------------------------------------------------------
  integer(kind=4) :: gdf_stbl_get
  gdf_stbl_get = startbl
end function gdf_stbl_get
!
subroutine gio_geis (is,error)
  use gio_interfaces, only : gio_message
  use gio_image
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! GDF GEt Image Slot
  !     Only used by SIC
  !---------------------------------------------------------------------
  integer, intent(out) :: is        ! Image slot
  logical, intent(out) :: error     ! Error flag
  ! Local
  integer :: i
  !
  error = .true.
  do i=1,mis
    if (islot(i).eq.code_gio_empty) then
      error = .false.
      islot(i) = code_gio_full
      is = i
      istbl(i) = startbl  ! A default value...
      imblock(i) = 0
      irblock(i) = 0
      iwblock(i) = 0      
      return
    endif
  enddo
  is = 0
  call gio_message(seve%e,'GDF_GEIS','Too many images')
end subroutine gio_geis
!
subroutine gio_fris (is,error)
  use gio_interfaces, only : gio_message, gio_frms, gdf_deis
  use gio_image
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! GDF FRee Image Slot
  !   Only used by SIC
  !
  ! In case of success, error flag (T/F) is preserved on return. Code is
  ! insensitive to error=T on input.
  !---------------------------------------------------------------------
  integer, intent(in)    :: is     ! Image slot
  logical, intent(inout) :: error  ! Error flag
  ! Local
  integer :: i
  !
  if (islot(is).eq.code_gio_empty) then
    call gio_message(seve%e,'FRIS','Image slot is empty')
    error = .true.
    return
  endif
  !
  ! Free all associated memory slot
  if (islot(is).ne.code_gio_full) then
    do i=1,mms
      if (mslot(i).eq.is) then
        call gio_frms(i,error)
      endif
    enddo
    call gdf_deis(is,error)
  endif
  ichan(is) = 0
  islot(is) = code_gio_empty 
end subroutine gio_fris
!
subroutine gio_clis (is,error)
  use gio_interfaces, only : gio_message, gio_frms, gdf_deis
  use gio_image
  use gbl_message
  !----------------------------------------------------------------------
  ! @ public
  ! GDF CLose Image Slot
  !   Only used by SIC
  !
  ! In case of success, error flag (T/F) is preserved on return. Code is
  ! insensitive to error=T on input.
  !----------------------------------------------------------------------
  integer, intent(in)    :: is     ! Image slot
  logical, intent(inout) :: error  ! Error flag
  ! Local
  integer :: i
  !
  if (islot(is).eq.code_gio_empty) then
    call gio_message(seve%e,'CLIS','Image slot is empty')
    error = .true.
    return
  endif
  !
  ! Free all associated memory slot
  if (islot(is).ne.code_gio_full) then
    do i=1,mms
      if (mslot(i).eq.is) then
        call gio_frms(i,error)
      endif
    enddo
    call gdf_deis(is,error)
  endif
  ichan(is) = 0
  islot(is) = code_gio_full 
end subroutine gio_clis
!
subroutine gdf_deis (is,error)
  use gio_dependencies_interfaces
  use gio_image
  !---------------------------------------------------------------------
  ! @ private
  ! GDF DElete Image Slot
  !             whatever the consequences...
  !             Close the unit, and free it
  !
  ! In case of success, error flag (T/F) is preserved on return. Code is
  ! insensitive to error=T on input.
  !---------------------------------------------------------------------
  integer, intent(in)    :: is     ! Image slot
  logical, intent(inout) :: error  ! Error flag
  !
  ! Close file
  close (unit=iunit(is))            ! Just in case
  call sic_frelun (iunit(is))
  iunit(is) = 0
end subroutine gdf_deis
!
function gdf_stis (is)
  use gio_image
  !---------------------------------------------------------------------
  ! @ public
  ! GDF STatus of Image Slot
  !             return slot status (-1 if not available)
  !---------------------------------------------------------------------
  integer :: gdf_stis               ! intent(out)
  integer, intent(in) :: is         ! Image slot
  if (is.le.0 .or. is.gt.mis) then
    gdf_stis = -1              ! No such slot
  else
    gdf_stis = islot(is)
  endif
end function gdf_stis
!
function gio_chis (is,rdonly)
  use gio_image
  !---------------------------------------------------------------------
  ! @ public
  ! Change READ Status to allow or avoid rewriting buffers...
  !     Only used by SIC
  !---------------------------------------------------------------------
  integer :: gio_chis               ! intent(out)
  integer, intent(in) :: is         ! Image slot
  logical, intent(in) :: rdonly     ! ReadOnly Status
  if (is.le.0 .or. is.gt.mis) then
    gio_chis = -1
  else
    gio_chis = islot(is)
    if (rdonly) then
      if (islot(is).eq.code_gio_write) islot(is) = code_gio_reado
    else
      if (islot(is).eq.code_gio_reado) islot(is) = code_gio_write
    endif
  endif
end function gio_chis
!
subroutine gio_lsis (chain,error)
  use gio_interfaces, only : gio_message, gio_dump_header
  use gildas_def
  use gio_image
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! GDF LiSt Image Slot
  !             A debugging routine only used by SIC
  ! It will prompt for user input if CHAIN is not empty.
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: chain
  logical, intent(out) :: error     ! Error flag
  ! Local
  character(len=*), parameter :: rname='GIO_LSIS'
  integer :: i, ic, j
  character(len=filename_length) :: file
  logical :: status, query
  character(len=message_length) :: mess
  !
  query = len_trim(chain).gt.0
  if (query) print *,trim(chain)
  error = .false.
  ic = 0
  do i=1,mis
    if (islot(i).ne.code_gio_empty) then
      if (iunit(i).ne.0) then
        inquire(unit=iunit(i),opened=status)
        if (status) then
          inquire(unit=iunit(i),name=file)
          write(mess,*) 'Slot ',i,'Opened on ',iunit(i),' on '
          call gio_message(seve%i,rname,trim(mess)//' '//file)
        else
          write(mess,*) 'Slot ',i,'closed on ',iunit(i)
          call gio_message(seve%i,rname,mess)
        endif
      else
        write(mess,*) 'Slot ',i,'allocated, no unit'
        call gio_message(seve%i,rname,mess)
      endif
      if (query) then
        call gdf_print_header (gheads(i))
        write(*,*) 'Enter a number to continue '
        read(*,*) j
      endif
      ic = ic+1
    else
      if (iunit(i).ne.0) then
        write(mess,*) 'Empty Slot ',i,' with allocated unit'
        call gio_message(seve%i,rname,mess)
      endif  
    endif
  enddo
  if (ic.eq.0) call gio_message(seve%i,rname,'No allocated image in GIO library')
end subroutine gio_lsis
