subroutine gio_cdim (is,ndims,dims)
  use gio_image
  !---------------------------------------------------------------------
  ! @ private
  ! GDF
  !       Change DIM of an Image Slot
  !       Change the dimensions of a pre-defined image slot
  !       This can be useful to reshape an image slot, and
  !               allow reading by blocks regardless of the actual
  !       underlying data structure. Typical applications include
  !       computing extrema, transposition, FITS interface...
  !
  !             It is used by GDF_READ_DATA and GDF_WRITE_DATA which can
  !         thus specify whatever shape they want for their data.
  !---------------------------------------------------------------------
  integer, intent(in) :: is                         ! Image Slot
  integer(4), intent(in) :: ndims                   ! Number of dimensions
  integer(kind=size_length), intent(in) :: dims(:)  ! Dimensions
  ! Local
  integer :: i
  !
  indim(is) = ndims
  do i=1,gdf_maxdims
    idims(i,is)  = max(1,dims(i))
  enddo
end subroutine gio_cdim
!
subroutine gio_dams (ms,is,blc,trc,array,form,error)
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>gio_dams
  use gildas_def
  use gio_image
  use gbl_message
  use gbl_format
  !---------------------------------------------------------------------
  ! @ private
  ! GDF
  !       Data Associated Memory Slot
  !       Associate pre-defined array ARRAY to (sub)-set BLC,TRC of
  !       image IS, at slot MS.
  !---------------------------------------------------------------------
  integer(kind=4),            intent(out) :: ms        ! Memory slot
  integer(kind=4),            intent(in)  :: is        ! Image slot
  integer(kind=index_length), intent(in)  :: blc(:)    ! Bottom left corner
  integer(kind=index_length), intent(in)  :: trc(:)    ! Top right corner
  real(kind=4),               intent(in)  :: array(*)  ! Data array
  integer(kind=4),            intent(in)  :: form      ! Image format
  logical,                    intent(out) :: error     ! Flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  integer(kind=size_length) :: isize,ioffs,ileng
  integer(kind=index_length) :: iblc(gdf_maxdims),itrc(gdf_maxdims),dimou(gdf_maxdims)
  integer(kind=address_length) :: ipi, ipo, addr_tmp
  integer :: ms_tmp, ndim
  integer(kind=index_length) :: jblc(gdf_maxdims), jtrc(gdf_maxdims), dimin(gdf_maxdims)
  !
  integer(kind=4) :: i,j
  logical :: icont
  integer(kind=address_length) :: addr    ! Input address
  character(len=message_length) :: mess
  character(len=*), parameter :: rname = 'GIO_DAMS'
  !
  if (islot(is).eq.code_gio_empty) then
    call gio_message(seve%e,rname,'Image slot is empty')
    error = .true.
    return
  elseif (islot(is).eq.code_gio_full) then
    call gio_message(seve%e,rname,'Image is not mapped')
    error = .true.
    return
  endif
  error = .false.
  !
  ! Get adress...
  addr = locwrd(array)
  !
  ! Special case: set attribute READE (External)
  islot(is) = code_gio_reade            ! Was DUMPE_GIO before
  !
  call gio_cont (is,ndim,blc,trc,iblc,itrc,isize,icont)
  if (isize.le.0) then
    call gio_message(seve%e,rname,'Zero length memory slot')
    write(mess,*) 'Islot ',is
    call gio_message(seve%d,rname,mess)
    write(mess,*) 'NDim ',ndim
    call gio_message(seve%d,rname,mess)
    write(mess,*) 'Isize ',isize
    call gio_message(seve%d,rname,mess)
    write(mess,*) 'Icont ',icont
    call gio_message(seve%d,rname,mess)
    call gio_dump_header(gheads(is))
  endif
  !
  ! Allocate a free memory frame
  if (icont) then
    do i=1,gdf_maxdims
      dimou(i) = itrc(i)-iblc(i)+1
    enddo
    !
    ioffs = 0
    do i=ndim,1,-1
      ioffs = ioffs*idims(i,is)+iblc(i)-1
    enddo
    ileng = isize
    !
    ! Disk file
    if (ichan(is).ne.0) then
      call gio_lnslot (ms,error)
      if (error) return
      if (form.eq.fmt_r8.or.form.eq.fmt_c4) then
        ileng = 2*isize
        ioffs = 8*ioffs
      elseif (form.eq.fmt_by) then
        ileng = (isize+3)/4
      else
        ileng = isize
        ioffs = 4*ioffs
      endif
      mslot(ms) = is
      maddr(1,ms) = addr
      maddr(2,ms) = addr+4*(isize-1)
      mleng(ms) = ileng
      moffs(ms) = ioffs        ! Offset in Bytes
      !
      ! Virtual memory, probably never used in this context...
    else
      ileng = -ileng
      call gio_lnslot (ms,error)
      if (error) return
      mslot(ms) = is
      maddr(1,ms) = addr
      maddr(2,ms) = addr+4*(isize-1)
      mleng(ms) = ileng
    endif
    if (error) then
      mslot(ms) = code_gio_empty
      return
    else
      do i=1,gdf_maxdims
        mblc(i,ms) = blc(i)
        mtrc(i,ms) = trc(i)
      enddo
      msize(ms) = isize
      mcont(ms) = icont
    endif
    ! Define memory slot format
    mform(ms) = form
    !
    ! Read it now
    call gio_rems(ms,error)
  else
    !!call gio_message(seve%w,rname,'Subset option support is experimental')
    !
    ileng = isize ! Are we sure ?
    !
    ! Define smallest contiguous containing subset
    jblc = iblc
    jtrc = itrc
    do i=ndim,1,-1
      if (iblc(i).ne.itrc(i)) then
        do j=1,i-1
          jblc(j) = 1
          jtrc(j) = idims(j,is)
        enddo
      endif
    enddo
    dimin = jtrc-jblc+1
    dimou = itrc-iblc+1
    !
    ! The memory for the subset is already allocated
    call gio_lnslot (ms,error)  ! Get a memory Slot
    mslot(ms) = is
    maddr(1,ms) = addr
    maddr(2,ms) = addr+4*(isize-1)
    mleng(ms) = ileng
    !
    ! Get the continuous subset
    call gio_gemsco (ms_tmp, is, jblc, jtrc, addr_tmp, form, error)
    if (error)  return
    !
    ! Extract the subset
    ipo = gag_pointer(addr,memory)
    ipi = gag_pointer(addr_tmp,memory)
    !
    ! Good code...
    do i=1,ndim
      if (dimin(i).eq.dimou(i)) iblc(i) = 1
    enddo
    !
    if (form.eq.fmt_r8.or.form.eq.fmt_c4) then
      call gdf_sub8(iblc,dimin(1),dimin(2),dimin(3),dimin(4),memory(ipi),  &
                         dimou(1),dimou(2),dimou(3),dimou(4),memory(ipo))
    elseif (form.eq.fmt_by) then
      call gdf_sub1(iblc,dimin(1),dimin(2),dimin(3),dimin(4),memory(ipi),  &
                         dimou(1),dimou(2),dimou(3),dimou(4),memory(ipo))
    else
      call gdf_sub4(iblc,dimin(1),dimin(2),dimin(3),dimin(4),memory(ipi),  &
                         dimou(1),dimou(2),dimou(3),dimou(4),memory(ipo))
    endif
    !
    ! Free the temporary subset.
    ! Note that ISLOT(IS) must be READO in this case, to free the Memory
    islot(is) = code_gio_reado            !
    call gio_frms (ms_tmp, error)
    islot(is) = code_gio_reade            ! Restore the proper code
    !
  endif
  if (error) return
  !
  ! Patch old UV data files
  if (abs(ivers(is)).eq.code_gdf_uvold) then
    call gio_message(seve%i,rname,'Patching old UV data weights')
    !
    ! If the array has been re-shaped for transposition, re-re-shape it
    if (dimou(1).eq.1 .and. dimou(3).ne.1) then
      dimou(1) = dimou(2)
      dimou(2) = dimou(3)
      dimou(3) = dimou(4)
      dimou(4) = 1
    endif
    call patch_weight (ivers(is),array,dimou(1),dimou(2),dimou(3),dimou(4))
  endif
end subroutine gio_dams
!
subroutine gio_rems (ms,error)
  use gio_interfaces, except_this=>gio_rems
  use gio_image
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! GDF   REad Memory Slot
  !---------------------------------------------------------------------
  integer, intent(in)  :: ms         ! Memory slot
  logical, intent(out) :: error      ! Flag
  ! Local
  integer :: is
  character(len=*), parameter :: rname = 'GIO_REMS'
  !
  is = mslot(ms)
  if (is.eq.code_gio_empty) then
    call gio_message(seve%e,rname,'Memory slot is empty')
    error = .true.
    return
  endif
  error = .false.
  !
  ! Contiguous slot
  if (mcont(ms)) then
    !
    ! If virtual memory, ignore it
    if (mleng(ms).lt.0) then
      call gio_message(seve%e,rname,'Virtual Memory slot cannot be read')
      error = .true.
      return
    elseif  (islot(is).ne.code_gio_reade) then
      error = .true.
      call gio_message(seve%e,rname,'Memory slot is not READ External')
    else
      if (mapped(is)) then
        return
      else
        !
        ! Read disk file
        call gio_rmslot (ms,iunit(is),error)
      endif
    endif
    !
  else
    error = .true.
    ! Not contiguous
    call gio_message(seve%e,rname,'Inconsistent state of GDF library')
    call gio_message(seve%e,rname,'Non-contiguous READ slot')
  endif
end subroutine gio_rems
!
subroutine gio_rmslot (ms,lun,error)
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>gio_rmslot
  use gildas_def
  use gio_image
  use gbl_message
  use gbl_format
  !---------------------------------------------------------------------
  ! @ private
  ! Read Memory SLOT
  !       Direct access solution
  !---------------------------------------------------------------------
  integer, intent(in)  :: ms         ! Memory slot
  integer, intent(in)  :: lun        ! Logical Unit Number
  logical, intent(out) :: error      ! Flag
  ! Global
  integer(kind=4) :: gdf_conv
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname = 'GIO_RMSLO'
  integer :: ier,form,is,ileft, koffs
  integer(4) :: buffer(lenbig),sizbuf
  integer(kind=record_length) :: i,ikbfi,ikbla
  integer(kind=size_length) :: ioffs
  integer(kind=address_length) :: ip
  character(len=80) :: mess
  !
  ! Read into specified area
  is = mslot(ms)
  error = .true.
  if (islot(is).ne.code_gio_reade) return
  !
  error = .false.
  form = mform(ms)
  !
  ! See also code for DUMPE case
  !!Print *,'RMSLOT ',is,istbl(is),isbig(is)
  ioffs = moffs(ms)/4+istbl(is)*lenbuf ! Offset in Word in file
  sizbuf = isbig(is)*lenbuf
  koffs = mod(ioffs,sizbuf)  ! Offset in Word from first buffer
  ikbfi = ioffs/sizbuf + 1
  ikbla = (ioffs+mleng(ms)+sizbuf-1)/sizbuf  ! Last buffer address
  !
  open(unit=lun,file=cname(is),status='OLD',form='UNFORMATTED',  &
       access='DIRECT',action='READ',recl=sizbuf*facunf,iostat=ier)
  if (ier.ne.0)  goto 90
  ip = gag_pointer(maddr(1,ms),memory)
  !
  ! Read file
  ! Native format
  if (iform(is).eq.mform(ms)) then
    ileft = mleng(ms)
    do i=ikbfi,ikbla-1
      if (i.eq.ikbfi) then
        ier = gio_riox (lun,i,buffer,sizbuf)
        if (ier.ne.0) goto 90
        call r4tor4 (buffer(1+koffs),memory(ip),sizbuf-koffs)
        ip = ip+sizbuf-koffs
        ileft = ileft-sizbuf+koffs
      else
        ier = gio_riox (lun,i,memory(ip),sizbuf)
        if (ier.ne.0) goto 90
        ip = ip+sizbuf
        ileft = ileft-sizbuf
      endif
    enddo
    ier = gio_riox(lun,ikbla,buffer,sizbuf)
    if (ikbla.eq.ikbfi) then
      call r4tor4(buffer(1+koffs),memory(ip),ileft)
    else
      call r4tor4(buffer,memory(ip),ileft)
    endif
  else
    ! As above, but with format Conversion
    ileft = mleng(ms)
    do i=ikbfi,ikbla-1
      if (i.eq.ikbfi) then
        ier = gio_riox (lun,i,buffer,sizbuf)
        if (ier.ne.0) goto 90
        ier = gdf_conv (buffer(1+koffs),memory(ip),sizbuf-koffs,form,iform(is))
        ip = ip+sizbuf-koffs   ! That is what we have filled
        ileft = ileft-sizbuf+koffs
      else
        ier = gio_riox (lun,i,buffer,sizbuf)
        if (ier.ne.0) goto 90
        ier = gdf_conv (buffer,memory(ip),sizbuf,form,iform(is))
        ip = ip+sizbuf
        ileft = ileft-sizbuf
      endif
      if (ier.ne.1) goto 80
    enddo
    ier = gio_riox(lun,ikbla,buffer,sizbuf)
    if (ikbla.eq.ikbfi) then
      ier = gdf_conv (buffer(koffs+1),memory(ip),ileft,form,iform(is))
    else
      ier = gdf_conv (buffer,memory(ip),ileft,form,iform(is))
    endif
    if (ier.ne.1) goto 80
  endif
  !
  close(unit=lun)
  return
  !
  ! Error messages
80 call gio_message(seve%e,rname,'Input conversion error in data')
  write(mess,*) 'Form ',form,' in file ',iform(is)
  call gio_message(seve%e,rname,mess)
  error = .true.
  close(unit=lun)
  return
  !
90 call gio_message(seve%e,rname,'Read error in data')
  call putios('E-'//rname//',  ',ier)
  error = .true.
  close(unit=lun)
end subroutine gio_rmslot
!
subroutine gio_pums (ms,is,blc,trc,addr,form,error)
  use gio_interfaces, except_this=>gio_pums
  use gildas_def
  use gio_image
  use gbl_message
  use gbl_format
  !---------------------------------------------------------------------
  ! @ private
  ! GDF
  !       Put Memory Slot
  !       Associate pre-defined area ADDR to (sub)-set BLC,TRC of
  !       image IS, at slot MS.
  !---------------------------------------------------------------------
  integer, intent(out) :: ms         ! Memory slot
  integer, intent(in)  :: is         ! Image slot
  integer(kind=index_length), intent(in)  :: blc(:) ! Bottom left corner
  integer(kind=index_length), intent(in)  :: trc(:) ! Top right corner
  integer(kind=address_length), intent(in) :: addr  ! Input address
  integer, intent(in)  :: form       ! Image format
  logical, intent(out) :: error      ! Flag
  ! Local
  integer(kind=index_length) :: iblc(gdf_maxdims),itrc(gdf_maxdims)
  integer(kind=size_length) :: isize,ioffs,ileng,i
  integer(kind=4) :: ndim
  logical :: icont
  character(len=message_length) :: mess
  character(len=*), parameter :: rname = 'GIO_PUMS'
  !
  if (islot(is).eq.code_gio_empty) then
    call gio_message(seve%e,rname,'Image slot is empty')
    error = .true.
    return
  elseif (islot(is).eq.code_gio_full) then
    call gio_message(seve%e,rname,'Image is not mapped')
    error = .true.
    return
  endif
  error = .false.
  !
  ! Special case: set attribute DUMP
  islot(is) = code_gio_dumpe
  !
!!  ! Can now be blocked in BIG buffers, because header is skipped
!!  ! Well, what happens if we inherit a file with smaller chunks ?
!!  isbig(is) = gio_blocking
!!  ! Why should we change the initial status of isbig(is)
  !
  call gio_cont (is,ndim,blc,trc,iblc,itrc,isize,icont)
  if (isize.le.0) then
    call gio_message(seve%e,rname,'Zero length memory slot')
    write(mess,*) 'Islot ',is
    call gio_message(seve%d,rname,mess)
    write(mess,*) 'NDim ',ndim
    call gio_message(seve%d,rname,mess)
    write(mess,*) 'Isize ',isize
    call gio_message(seve%d,rname,mess)
    write(mess,*) 'Icont ',icont
    call gio_message(seve%d,rname,mess)
    !!call gio_dump_header(gheads(is))  ! DEBUG !
  endif
  !
  ! Allocate a free memory frame
  if (icont) then
    ioffs = 0
    do i=ndim,1,-1
      ioffs = ioffs*idims(i,is)+iblc(i)-1
    enddo
    ileng = isize
    !
    ! Disk file
    if (ichan(is).ne.0) then
      call gio_lnslot (ms,error)
      if (error) return
      if (form.eq.fmt_r8.or.form.eq.fmt_c4) then
        ileng = 2*isize
        ioffs = 8*ioffs
      elseif (form.eq.fmt_by) then
        ileng = (isize+3)/4
      else
        ileng = isize
        ioffs = 4*ioffs
      endif
      mslot(ms) = is
      maddr(1,ms) = addr
      maddr(2,ms) = addr+4*(isize-1)
      mleng(ms) = ileng
      !
      ! Virtual memory
    else
      ileng = -ileng
      call gio_lnslot (ms,error)
      if (error) return
      mslot(ms) = is
      maddr(1,ms) = addr
      maddr(2,ms) = addr+4*(isize-1)
      mleng(ms) = ileng
    endif
    if (error) then
      mslot(ms) = code_gio_empty
      return
    else
      do i=1,gdf_maxdims
        mblc(i,ms) = blc(i)
        mtrc(i,ms) = trc(i)
      enddo
      msize(ms) = isize
      mcont(ms) = icont
    endif
    moffs(ms) = ioffs          ! Offset in Bytes
  else
    call gio_message(seve%e,rname,'Subset option not yet supported')
    error = .true.
    return
  endif
  ! Define memory slot format
  mform(ms) = form
end subroutine gio_pums
!
subroutine gio_lnslot (ms,error)
  use gio_interfaces, only : gio_message
  use gio_image
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! GDF   Get a free memory slot
  !---------------------------------------------------------------------
  integer, intent(out) :: ms                     ! Memory slot number
  logical, intent(out) :: error                  !
  ! Local
  integer :: i,freems
  character(len=*), parameter :: rname = 'GIO_LNSLOT'
  !
  ! OK, now get a free frame-ID and virtual memory
  freems = 0
  ms = 0
  do i=1,mms
    if (mslot(i).eq.code_gio_empty) then
      if (mleng(i).eq.0) then
        freems = i
        exit
      endif
    endif
  enddo
  !
  ! No free frame large enough, or virtual memory
  if (freems.eq.0) then
    call gio_message(seve%e,rname,'Too many memory frames')
    error = .true.
  else
    ms = freems
    maddr(1,ms) = 0
    maddr(2,ms) = 0
    mleng(ms) = 0
    moffs(ms) = 0
  endif
end subroutine gio_lnslot
