function desc_nelem(desc)
  use gildas_def
  use sic_types
  !---------------------------------------------------------------------
  ! @ public
  ! Return the number of elements from the input descriptor
  !---------------------------------------------------------------------
  integer(kind=size_length) :: desc_nelem
  type(sic_descriptor_t), intent(in) :: desc
  ! Local
  integer(kind=4) :: jdim
  !
  desc_nelem = 1
  do jdim=1,desc%ndim
    desc_nelem = desc_nelem*desc%dims(jdim)
  enddo
  !
end function desc_nelem
!
function desc_nword(desc)
  use gildas_def
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>desc_nword
  use sic_types
  !---------------------------------------------------------------------
  ! @ public
  ! Return the number of 4 bytes words from the input descriptor.
  ! Usually suited for the desc%size value.
  !---------------------------------------------------------------------
  integer(kind=size_length) :: desc_nword
  type(sic_descriptor_t), intent(in) :: desc
  !
  if (desc%type.eq.fmt_i4 .or. desc%type.eq.fmt_r4 .or. desc%type.eq.fmt_l) then
    desc_nword = desc_nelem(desc)
  elseif (desc%type.eq.fmt_i8 .or. desc%type.eq.fmt_r8 .or. desc%type.eq.fmt_c4) then
    desc_nword = 2*desc_nelem(desc)
  elseif (desc%type.eq.fmt_c8) then
    desc_nword = 4*desc_nelem(desc)
  elseif (desc%type.eq.fmt_by) then
    desc_nword = (desc_nelem(desc)+3)/4
  elseif (desc%type.gt.0) then
    desc_nword = (desc_nelem(desc)*desc%type+3)/4
  else
    ! 0 = header (no data), or uncatched cases...
    desc_nword = 0
  endif
  !
end function desc_nword
!
function desc_size(desc)
  use gildas_def
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>desc_size
  use sic_types
  !---------------------------------------------------------------------
  ! @ public
  ! Return the whole data size in bytes
  !---------------------------------------------------------------------
  integer(kind=size_length) :: desc_size
  type(sic_descriptor_t), intent(in) :: desc
  !
  desc_size = desc_nelem(desc) * gag_sizeof(desc%type)
  !
end function desc_size
!
function desc_2gelems(desc)
  use gildas_def
  use sic_interfaces, except_this=>desc_2gelems
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  ! Return .true. if the data has more than 2 giga-elements
  !---------------------------------------------------------------------
  logical :: desc_2gelems  ! Function value on return
  type(sic_descriptor_t), intent(in) :: desc
  ! Local
  integer(kind=8), parameter :: maxi4=2147483647_8 ! 2**31-1
  !
  desc_2gelems = desc_nelem(desc).gt.maxi4
end function desc_2gelems
!
function desc_2gbytes(desc)
  use gildas_def
  use sic_interfaces, except_this=>desc_2gbytes
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  ! Return .true. if the data is larger than 2 GB (bytes, not 4-bytes
  ! words)
  !---------------------------------------------------------------------
  logical :: desc_2gbytes  ! Function value on return
  type(sic_descriptor_t), intent(in) :: desc
  ! Local
  integer(kind=8), parameter :: size4max=2147483647  ! 2**31-1
  !
  desc_2gbytes = desc_size(desc).gt.size4max
end function desc_2gbytes
!
subroutine desc_toobig(desc,error)
  use gildas_def
  use gbl_message
  use sic_interfaces, except_this=>desc_toobig
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  ! Return an error if the image is too large to be opened on the
  ! current system
  !---------------------------------------------------------------------
  type(sic_descriptor_t), intent(in)    :: desc
  logical,                intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='SIC'
  !
#if defined(BITS64)
  ! There maybe limits on the number of elements
  if (desc_2gelems(desc)) then
    if (index_length.eq.8) then
      ! Ok
      continue
    else
      call gio_message(seve%e,rname,  &
      'Images or UV tables of more than 2**31-1 elements not supported')
      error = .true.
      return
    endif
  endif
#else
  if (desc_2gbytes(desc)) then
    ! File is larger than 2 GB. We can think to use the blc and trc,
    ! but there are offsets in bytes which are computed by the
    ! file access layer (even if the underlying operating system is
    ! purely 64 bits) that overflow.
    !
    ! So even having moffs being of kind=size_length set to 64 bits
    ! does not help
    error = .true.
    call gio_message(seve%e,rname,  &
      'Files larger than 2 GB are not supported under 32 bits architecture')
  endif
#endif
  !
end subroutine desc_toobig
!
subroutine copy_descr(in,out,error)
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  ! Produce an exact copy of a descriptor.
  !---------------------------------------------------------------------
  type(sic_descriptor_t), intent(in)    :: in
  type(sic_descriptor_t), intent(out)   :: out
  logical,                intent(inout) :: error
  !
  out%type     = in%type
  out%ndim     = in%ndim
  out%dims(:)  = in%dims(:)
  out%addr     = in%addr
  out%head    => in%head
  out%size     = in%size
  out%status   = in%status
  out%readonly = in%readonly
  !
end subroutine copy_descr
!
subroutine sic_descriptor(namein,desc,found)
  use sic_interfaces, except_this=>sic_descriptor
  use gildas_def
  use sic_structures
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ public
  !   Retrieve the descriptor of an existing variable
  !  Returns FOUND = .FALSE. if no such variable exists
  !  Automatic transposition is not allowed at this stage
  !---------------------------------------------------------------------
  character(len=*),       intent(in)    :: namein  ! Variable name
  type(sic_descriptor_t), intent(out)   :: desc    ! Descriptor as array
  logical,                intent(inout) :: found   ! Verbose (in) / Found (out)
  ! Local
  type(sic_identifier_t) :: var
  integer(kind=4) :: in,ier
  type(sic_dimensions_t) :: spec
  logical :: error,verbose
  !
  ! Check syntax and analyse dimensions.
  verbose = found
  found = .false.
  if (namein.eq.' ') return
  !
  spec%do%strict   = .false.  ! Can be an expression silently rejected for later parsing
  spec%do%range    = .true.   ! e.g. A[3:5] allowed
  spec%do%subset   = .true.   ! e.g. A[2,] allowed
  spec%do%implicit = .false.  ! e.g. A[i] forbidden
  spec%do%twospec  = .true.   ! e.g. A[i][j:k] allowed
  error = .false.
  call sic_parse_dim(namein,var,spec,verbose,error)
  if (error) return
  !
  ! Find variable
  var%level = var_level
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.ne.1) then
    var%level = 0
    ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
    if (ier.ne.1) return
  endif
  !
  ! Copy descriptor
  ! print *,'SIC-DESCRIPTOR '
  call extract_descr(desc,dicvar(in)%desc,spec%done,var%name,.false.,0,error)
  if (error) return
  !
  found = .true.
  !
end subroutine sic_descriptor
!
subroutine sic_materialize(namein,desc,found)
  use sic_interfaces, except_this=>sic_materialize
  use gildas_def
  use sic_structures
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ public
  !   Retrieve the descriptor of an existing variable or of an
  ! incarnation of an expression (including automatic transposition)
  !---------------------------------------------------------------------
  character(len=*),       intent(in)    :: namein  ! Variable name
  type(sic_descriptor_t), intent(out)   :: desc    ! Descriptor
  logical,                intent(inout) :: found   ! Verbose (in) / Found (out)
  ! Local
  type(sic_identifier_t) :: var
  integer(kind=4) :: in,ier
  type(sic_dimensions_t) :: spec
  logical :: error,verbose
  !
  ! Check syntax and analyse dimensions.
  verbose = found
  found = .false.
  if (namein.eq.' ')  return
  !
  spec%do%strict   = .false.  ! Can be an expression silently rejected for later parsing
  spec%do%range    = .true.   ! e.g. A[3:5] allowed
  spec%do%subset   = .true.   ! e.g. A[2,] allowed
  spec%do%implicit = .false.  ! e.g. A[i] forbidden
  spec%do%twospec  = .true.   ! e.g. A[i][j:k] allowed
  error = .false.
  call sic_parse_dim(namein,var,spec,verbose,error)
  if (error) return
  !
  ! Find variable
  var%level = var_level
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.ne.1) then
    var%level = 0
    ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
    if (ier.ne.1) return
  endif
  !
  ! Copy descriptor
  ! Print *,'SIC-MATERIALIZE '
  call extract_descr(desc,dicvar(in)%desc,spec%done,var%name,.true.,0,error)
  if (error) return
  found = .true.
  !
end subroutine sic_materialize
!
function sic_varexist(name)
  use sic_interfaces, except_this=>sic_varexist
  use gildas_def
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ public
  !   Check if the input variable exists
  !---------------------------------------------------------------------
  logical :: sic_varexist  ! Function value on return
  character(len=*), intent(in) :: name  ! Variable name
  ! Local
  type(sic_identifier_t) :: var
  integer(kind=4) :: in,ier
  type(sic_dimensions_t) :: spec
  logical :: error,verbose
  !
  sic_varexist = .false.
  !
  if (name.eq.' ') return
  !
  ! Check syntax and analyse dimensions.
  error = .false.
  verbose  = .false.
  spec%do%strict   = .true.   ! Can not be an expression like A[1].eq.B[1]
  spec%do%range    = .true.   ! e.g. A[3:5] allowed
  spec%do%subset   = .true.   ! e.g. A[2,] allowed
  spec%do%implicit = .false.  ! e.g. A[i] forbidden
  spec%do%twospec  = .true.   ! e.g. A[i][j:k] allowed
  call sic_parse_dim(name,var,spec,verbose,error)
  if (error) return
  !
  ! Find variable
  var%level = var_level
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.ne.1) then
    var%level = 0
    ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
    if (ier.ne.1) return
  endif
  !
  sic_varexist = .true.
  !
end function sic_varexist
!
function sic_level(namein)
  use sic_interfaces, except_this=>sic_level
  use gildas_def
  use sic_structures
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ public
  !  Retrieve the level of a variable
  !---------------------------------------------------------------------
  integer(kind=4) :: sic_level  ! Function value on return
  character(len=*), intent(in) :: namein  ! Variable name
  ! Local
  type(sic_identifier_t) :: var
  integer(kind=4) :: in,ier
  type(sic_dimensions_t) :: spec
  logical :: verbose,error
  !
  ! Check syntax and analyse dimensions.
  sic_level = -1
  if (namein.eq.' ')  return
  !
  spec%do%strict   = .true.   ! Can not be an expression like A[1].eq.B[1]
  spec%do%range    = .true.   ! e.g. A[3:5] allowed
  spec%do%subset   = .true.   ! e.g. A[2,] allowed
  spec%do%implicit = .false.  ! e.g. A[i] not allowed
  spec%do%twospec  = .true.   ! e.g. A[i][j:k] allowed
  verbose  = .true.
  error = .false.
  call sic_parse_dim(namein,var,spec,verbose,error)
  if (error) return
  !
  ! Find variable
  var%level = var_level
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.ne.1) then
    var%level = 0
    ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
    if (ier.eq.1) sic_level = 0
  else
    sic_level = var_level
  endif
  !
end function sic_level
!
subroutine extract_descr(out,in,spec,name,inca,form,error)
  use sic_interfaces, except_this=>extract_descr
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  ! From the original full variable descriptor, extract the partial
  ! variable descriptor according to specified dimensions or substring
  !---------------------------------------------------------------------
  type(sic_descriptor_t)                     :: out      ! Resulting descriptor
  type(sic_descriptor_t)                     :: in       ! Descriptor of variable
  type(sic_dimensions_done_t), intent(inout) :: spec(2)  ! Dimension specifications
  character(len=*),            intent(in)    :: name     ! Name of variable
  logical,                     intent(in)    :: inca     ! Allow Incarnation
  integer(kind=4),             intent(in)    :: form     ! Incarnation type
  logical,                     intent(inout) :: error    ! Logical error flag
  ! Local
  integer(kind=4) :: aspec,sspec
  type(sic_descriptor_t) :: in2
  !
  if (spec(1)%ndim.eq.0) then
    ! No specification given
    aspec = 0
    sspec = 0
  elseif (spec(2)%ndim.eq.0) then
    ! One specification given. Subarray or substring?
    if (in%ndim.gt.0) then
      ! Variable is an array => subarray specification
      aspec = 1
      sspec = 0
    elseif (in%type.gt.0) then
      ! Variable is a scalar string => substring specification
      aspec = 0
      sspec = 1
    else
      ! Variable is a scalar numeric => invalid (rejected in extract_descr_subarray)
      aspec = 1
      sspec = 0
    endif
  else
    ! Two specifications given
    aspec = 1  ! First must be for subarray
    sspec = 2  ! Second must be for substring
    ! More checks later
  endif
  !
  ! Get descriptor or define incarnation
  if (aspec.eq.0) then
    ! No subarray specification, return full array
    out = in
  else
    ! Partial array, must do some work
    call extract_descr_subarray(out,in,spec(aspec),name,inca,form,error)
    if (error)  return
  endif
  !
  if (sspec.ne.0) then
    in2 = out
    call extract_descr_substring(out,in2,spec(sspec),name,error)
    if (error) then
      call sic_volatile(in2)
      return
    endif
  endif
  !
end subroutine extract_descr
!
subroutine extract_descr_subarray(out,in,spec,name,inca,form,error)
  use gildas_def
  use gbl_format
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>extract_descr_subarray
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Get sub-array descriptor according to specified dimensions
  !---------------------------------------------------------------------
  type(sic_descriptor_t)                     :: out   ! Resulting descriptor
  type(sic_descriptor_t)                     :: in    ! Descriptor of variable
  type(sic_dimensions_done_t), intent(inout) :: spec  ! Subarray specification
  character(len=*),            intent(in)    :: name  ! Name of variable
  logical,                     intent(in)    :: inca  ! Allow Incarnation
  integer(kind=4),             intent(in)    :: form  ! Incarnation type
  logical,                     intent(inout) :: error ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='PARSE'
  integer(kind=4) :: i,j,ier,item_size,type
  integer(kind=address_length) :: ipntin,ipntout
  integer(kind=size_length) :: size,offset
  character(len=message_length) :: mess
  logical :: transpose
  !
  if (spec%ndim.gt.in%ndim) then
    write(mess,'(3A,I0,A)')  &
      'Variable ',trim(name),' has only ',in%ndim,' dimensions'
    call sic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  transpose = .false.
  !
  ! 1) Check for unspecified leading dimensions
  if (spec%ndim.lt.in%ndim) then
    ! Shift explicit dimensions, and fill the unspecified ones with the
    ! dummy value 0
    do i=spec%ndim,1,-1
      spec%dims(i+in%ndim-spec%ndim,1) = spec%dims(i,1)
      spec%dims(i+in%ndim-spec%ndim,2) = spec%dims(i,2)
    enddo
    do i=in%ndim-spec%ndim,1,-1
      spec%dims(i,1) = 0
      spec%dims(i,2) = 0
    enddo
    spec%ndim = in%ndim
  endif
  !
  offset = 0
  do i=spec%ndim,1,-1
    ! Replace dummy sizes with array bounds for the dimension
    if (spec%dims(i,1).eq.0) spec%dims(i,1) = 1
    if (spec%dims(i,2).eq.0) spec%dims(i,2) = in%dims(i)
    ! Check for out of bound limits
    if (spec%dims(i,1).gt.in%dims(i)) then
      write (mess,102) spec%dims(i,1),i,in%dims(i),trim(name)
      call sic_message(seve%e,rname,mess)
      error = .true.
      return
    elseif (spec%dims(i,2).gt.in%dims(i)) then
      write (mess,102) spec%dims(i,2),i,in%dims(i),trim(name)
      call sic_message(seve%e,rname,mess)
      error = .true.
      return
    endif
    offset = offset+spec%dims(i,1)-1
    if (i.gt.1) offset = offset*in%dims(i-1)
  enddo
  !
  size = 1
  do i=1,spec%ndim
    size = size*(spec%dims(i,2)-spec%dims(i,1)+1)
  enddo
  ! Convert to byte and word units
  type = in%type
  if (type.eq.fmt_r8 .or. type.eq.fmt_c4 .or. type.eq.fmt_i8) then ! Double
    item_size = 8
    size   = 2*size
  elseif (type.gt.0) then      ! Char
    item_size = type
    size   = (size*type+3)/4
  else                         ! Anything else
    item_size = 4
  endif
  offset = offset*item_size
  !! Not yet ipmlemented
  if (form.ne.0 .and. type.ne.form) then
    call sic_message(seve%e,rname,'Incarnation not yet implemented')
    error = .true.
    return
  endif
  ! Fill output descriptor
  out = in
  out%size = size
  ! Test for "implicit transposition" (in fact non contiguous sub-arrays)
  ! like A[1,3:5]
  ! Beware, it is a bit tricky...
  !
  do i=1,spec%ndim-1
    !
    ! Sub-array in dimension I
    if (spec%dims(i,1).ne.1.or.spec%dims(i,2).ne.in%dims(i)) then
      ! Check if remaining dimensions degenerate to zero
      do j=i,spec%ndim
        if (spec%dims(j,1).ne.spec%dims(j,2)) then
          transpose = .true.
        endif
      enddo
    endif
  enddo
  !
  ! Output descriptor must include the degenerate dimensions at this stage,
  ! it is needed for the TRANSPOSE case
  out%dims = 0
  do i=1,spec%ndim
    out%dims(i) = spec%dims(i,2)-spec%dims(i,1)+1
  enddo
  !
  if (.not.transpose) then     ! Can use a pointer to input array
    out%addr = in%addr+offset
  elseif  (.not.inca) then
    ! Message is not allowed here
    ! call gagout('E-PARSE,  Transposition not allowed here')
    error = .true.
    return
  else
    ! General case, must allocate some memory and copy
    ier = sic_getvm (out%size,out%addr)
    if (ier.ne.1) goto 99
    out%status = scratch_operand
    !
    ! This could be suppressed when the subarray will only be used as a
    ! target... Also, one could look for bigger contiguous chunks.
    ipntin  = gag_pointer(in%addr,memory)
    ipntout = gag_pointer(out%addr,memory)
    call extract_array(memory(ipntin),in%ndim,in%dims,spec%dims,item_size,  &
      memory(ipntout),out%ndim,out%dims,error)
  endif
  !
  ! Suppress degenerate dimensions in the output descriptor
  out%ndim = 0
  do i=1,spec%ndim
    if (spec%dims(i,1).lt.spec%dims(i,2)) then
      out%ndim = out%ndim+1
      out%dims(out%ndim) = spec%dims(i,2)-spec%dims(i,1)+1
    endif
  enddo
  do i=out%ndim+1,sic_maxdims
    out%dims(i) = 0
  enddo
  !
  return
  !
99 error = .true.
  return
  !
102 format('Index ',i0,' exceed dimension #',i1,' (',i0,') of ',a)
end subroutine extract_descr_subarray
!
subroutine extract_descr_substring(out,in,spec,name,error)
  use gbl_message
  use sic_interfaces, except_this=>extract_descr_substring
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(sic_descriptor_t),      intent(inout) :: out    ! Resulting descriptor
  type(sic_descriptor_t),      intent(in)    :: in     ! Descriptor of variable
  type(sic_dimensions_done_t), intent(inout) :: spec   ! Substring specification
  character(len=*),            intent(in)    :: name   ! Name of variable
  logical,                     intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='PARSE'
  character(len=message_length) :: mess
  integer(kind=4) :: nchar
  !
  ! Check input variable
  if (in%type.le.0) then
    call sic_message(seve%e,rname,  &
      'Invalid substring specification on non-character string')
    error = .true.
    return
  endif
  if (in%ndim.ne.0) then
    call sic_message(seve%e,rname,'Can not extract substring from array')
    error = .true.
    return
  endif
  if (in%status.eq.scratch_operand) then
    ! This should never happen! Substring are always extracted from scalar
    ! strings (checked above). extract_descr_subarray does not build a scratch
    ! array for a scalar value.
    ! If this would happen, I do not now what we should do, because the
    ! resulting substring descriptor would not reflect the input scratch
    ! array, and we would not clean it properly afterwards.
    call sic_message(seve%e,rname,  &
      'Can not extract substring from scratch variable')
    error = .true.
    return
  endif
  !
  ! Check substring specification
  if (.not.spec%range) then
    call sic_message(seve%e,rname,'Substring specification must provide a range')
    error = .true.
    return
  endif
  if (spec%ndim.ne.1) then
    call sic_message(seve%e,rname,'Substring specification must be 1D')
    error = .true.
    return
  endif
  if (spec%dims(1,1).eq.0) spec%dims(1,1) = 1
  if (spec%dims(1,2).eq.0) spec%dims(1,2) = in%type
  if (spec%dims(1,1).gt.in%type) then
    write (mess,102) spec%dims(1,1),in%type,trim(name)
    call sic_message(seve%e,rname,mess)
    error = .true.
    return
  elseif (spec%dims(1,2).gt.in%type) then
    write (mess,102) spec%dims(1,2),in%type,trim(name)
    call sic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  nchar = spec%dims(1,2)-spec%dims(1,1)+1
  if (nchar.le.0) then
    call sic_message(seve%e,rname,'Negative-length substring')
    error = .true.
    return
  endif
  !
  out%type     = nchar
  out%ndim     = 0
  out%dims(:)  = 0
  out%addr     = in%addr+spec%dims(1,1)-1
  out%size     = (nchar+3)/4  ! Not sure which sense this makes
  out%status   = in%status
  out%readonly = in%readonly
  !
102 format('Index ',i0,' exceeds length ',I0,' of string ',a)
end subroutine extract_descr_substring
!
subroutine sic_parse_dim(string,var,spec,verbose,error)
  use sic_interfaces, except_this=>sic_parse_dim
  use gildas_def
  use gbl_message
  use sic_types
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ private
  !  Parse the dimension field of an input variable e.g. NAME[i,j][k:l]
  ! On return fill:
  !   var%name
  !   var%lname
  !   specifications description (subarray and/or substring)
  !---------------------------------------------------------------------
  character(len=*),       intent(in)    :: string    ! String to parse
  type(sic_identifier_t), intent(out)   :: var       ! Parsed variable
  type(sic_dimensions_t), intent(inout) :: spec      ! Dimensions specifications
  logical,                intent(in)    :: verbose   ! Verbose work?
  logical,                intent(inout) :: error     ! Error flag
  ! Local
  character(len=*), parameter :: rname='DIMENSION'
  integer(kind=4) :: iopen1,iopen2,iclose,idime
  character(len=message_length) :: mess
  !
  ! Parse name from dimensions...
  error = .false.
  do idime=1,2
    spec%done(idime)%ndim = 0
    spec%done(idime)%dims(:,:) = 0
    spec%done(idime)%range = .false.  ! No range found
    spec%done(idime)%implicit = .false.  ! No implicit dimension found
  enddo
  !
  iopen1 = index_obracket(string)
  !
  if (iopen1.eq.0) then
    ! Standard variable name (no opening "[")
    var%lname = len_trim(string)
    if (var%lname.gt.len(var%name)) then
      ! Silent error. May be a large expression.
      ! ZZZ what about the 'verbose' flag?
      error = .true.
      return
    endif
    var%name = string
    return
  endif
  !
  ! Variable has a "["
  if (iopen1.gt.len(var%name)+1) then
    error = .true.
    return
  endif
  !
  var%name = string(1:iopen1-1)
  var%lname = iopen1-1
  !
  ! Parse 1st group of []
  call sic_parse_dim_group(1,iopen1,iclose,error)
  if (error)  return
  !
  if (spec%do%twospec) then
    ! Parse 2nd group of []
    iopen2 = index_obracket(string(iopen1+1:))  ! Relative from previous "["
    if (iopen2.gt.0) then
      ! Found a second "["
      iopen2 = iopen1+iopen2               ! Absolute from beginning of string
      if (iopen2.le.iclose) then
        ! e.g. A[B[1]] not supported
        call sic_message(seve%e,rname,'Invalid syntax')
        error = .true.
        return
      elseif (iopen2.eq.iclose+1) then
        ! 2nd opening "[" is glued to previous closing "]" => there is a 2nd group
        call sic_parse_dim_group(2,iopen2,iclose,error)
        if (error)  return
      else
        ! There is a 2nd opening "[" but further in the string
        ! May be an expression e.g. 'A[1].eq.A[2]'
        if (spec%do%strict)  &
          call sic_message(seve%e,rname,'Invalid variable name '//string)
        error = .true.
        return
      endif
    endif
  endif
  !
  ! Final sanity check
  if (iclose.ne.len_trim(string)) then
    ! May be an expression e.g. 'A[1].eq.0'
    if (spec%do%strict)  &
      call sic_message(seve%e,rname,'Invalid variable name '//string)
    error = .true.
    return
  endif
  !
contains
  function index_obracket(string)
    !-------------------------------------------------------------------
    ! Return the position of the next opening bracket in string, taking
    ! into account double-quoted string. Result should be identical to
    !   index(string,'[')
    ! is there is no double quotes involved. Return 0 if no bracket is
    ! found.
    !-------------------------------------------------------------------
    integer(kind=4) :: index_obracket  ! Function value on return
    character(len=*), intent(in) :: string
    ! Local
    integer(kind=4) :: icha
    logical :: inchain
    !
    inchain = .false.
    index_obracket = 0
    do icha=1,len(string)
      if (string(icha:icha).eq.'"') then
        inchain = .not.inchain
        cycle  ! icha
      endif
      if (inchain) cycle  ! icha
      !
      if (string(icha:icha).eq.'[') then
        index_obracket = icha
        return
      endif
    enddo
    !
  end function index_obracket
  !
  subroutine sic_parse_dim_group(igroup,iopen,iclose,error)
    use sic_interfaces
    use sic_types
    integer(kind=4), intent(in)    :: igroup
    integer(kind=4), intent(in)    :: iopen
    integer(kind=4), intent(out)   :: iclose
    logical,         intent(inout) :: error
    ! Local
    integer(kind=4) :: icomma,istart
    !
    iclose = index(string(iopen:),']')  ! Relative from iopen
    if (iclose.eq.0) then
      if (verbose)  call sic_message(seve%e,rname,'Missing closing bracket')
      error = .true.
      return
    endif
    iclose = iopen+iclose-1  ! Absolute from beginning of string
    !
    istart = iopen
    do while (istart.lt.iclose)
      !
      icomma = index(string(istart+1:iclose),',')
      if (icomma.eq.0) icomma=iclose-istart  ! For last dimension
      !
      if (icomma.ne.1) then
        call sic_decode_dims(string(istart+1:),icomma-1,  &
          spec%done(igroup)%dims,      &
          spec%done(igroup)%ndim,      &
          spec%do%range,               &
          spec%do%implicit,            &
          spec%done(igroup)%range,     &
          spec%done(igroup)%implicit,  &
          spec%done(igroup)%vars,      &
          verbose,error)
        if (error) return
      elseif (spec%do%subset) then  ! icomma.eq.1, and subset is allowed
        spec%done(igroup)%ndim = spec%done(igroup)%ndim+1
        spec%done(igroup)%dims(spec%done(igroup)%ndim,1) = 0
        spec%done(igroup)%dims(spec%done(igroup)%ndim,2) = 0
      else                  ! icomma.eq.1, but subset is not allowed
        write(mess,'(A,I2,A)') 'Subset not allowed in this context '//  &
          '(dimension #',spec%done(igroup)%ndim+1,')'
        call sic_message(seve%e,rname,mess)
        error = .true.
        return
      endif
      !
      istart = istart+icomma
    enddo
  end subroutine sic_parse_dim_group
  !
end subroutine sic_parse_dim
!
subroutine sic_decode_dims(chain,lc,dim,ndim,range,implicit,has_range,  &
  has_implicit,dimvars,verbose,error)
  use gildas_def
  use sic_interfaces, except_this=>sic_decode_dims
  use sic_structures
  use sic_dictionaries
  use sic_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! Parse one dimension of an input variable i:j
  !---------------------------------------------------------------------
  character(len=*),           intent(in)    :: chain     ! String to parse
  integer,                    intent(in)    :: lc        ! Length of input string
  integer(kind=index_length), intent(inout) :: dim(sic_maxdims,2)  ! The dimensions parsed
  integer,                    intent(inout) :: ndim      ! The Nth dimension being parsed
  logical,                    intent(in)    :: range     ! Accept a dimension range
  logical,                    intent(in)    :: implicit  ! Accept implicit dimension
  logical,                    intent(inout) :: has_range             ! Some range found?
  logical,                    intent(inout) :: has_implicit          ! Implicit dimension found?
  type(sic_identifier_t),     intent(inout) :: dimvars(sic_maxdims)  ! Name of implicit dimension
  logical,                    intent(in)    :: verbose   ! Print messages
  logical,                    intent(inout) :: error     ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='DIMENSION'
  type(sic_identifier_t) :: var
  character(len=message_length) :: mess
  integer :: j,imin,imax,i1(2),i2(2),icolon,ier
  logical :: error2
  !
  if (ndim.eq.sic_maxdims) then
    if (verbose) call sic_message(seve%e,rname,'Too many dimensions')
    error = .true.
    return
  endif
  ndim = ndim+1
  !
  if (lc.le.0) then
    dim(ndim,1) = 0
    dim(ndim,2) = 0
    return
  endif
  !
  ! Check for an index range: A[1:3]
  icolon = index(chain(1:lc),':')
  if (icolon.ne.0) then
    has_range = .true.
    if (.not.range) then
      if (verbose) then
        call sic_message(seve%e,rname,'Index range not supported in '//  &
        'this context')
      endif
      error = .true.
      return
    endif
    if (icolon.eq.1) then         ! A[:3]
      dim(ndim,1) = 0        ! 0-->1
      imin = 2
      imax = 2
      i1(2) = 2
      i2(2) = lc
    elseif (icolon.eq.lc) then    ! A[3:]
      imin = 1
      imax = 1
      i1(1) = 1
      i2(1) = icolon-1
      dim(ndim,2) = 0        ! Use full dim
    else
      imin = 1
      imax = 2
      i1(1) = 1
      i2(1) = icolon-1
      i1(2) = icolon+1
      i2(2) = lc
    endif
  else
    imin = 1
    imax = 2
    i1(1) = 1
    i2(1) = lc
    i1(2) = 1
    i2(2) = lc
  endif
  !
  do j=imin,imax
    ! Distinguish plain numbers from variables (assumes ASCII set).
    if (chain(i1(j):i1(j)).lt.'A') then
      read(chain(i1(j):i2(j)),*,iostat=ier) dim(ndim,j)
      if (ier.ne.0) then
        if (verbose)  &
          call sic_message(seve%e,rname,'Invalid dimension: '//chain(i1(j):i2(j)))
        error = .true.
        return
      endif
      if (dim(ndim,j).lt.1) then
        if (verbose) then
          write(mess,'(A,I1,A,I0)') 'Out of bound dimension #',ndim,': ',dim(ndim,j)
          call sic_message(seve%e,rname,mess)
        endif
        error = .true.
        return
      endif
      !
    elseif (icolon.gt.varname_length) then
      if (verbose)  &
        call sic_message(seve%e,rname,'Invalid dimension: '//chain(i1(j):i2(j)))
      error = .true.
      return
      !
    else
      var%name = chain(i1(j):i2(j))
      var%lname = i2(j)-i1(j)+1
      call intege(var,dim(ndim,j),error2)
      if (error2) then
        ! Try an implicit variable, unless a range was specified
        if (implicit .and. icolon.eq.0) then
          has_implicit = .true.
          dimvars(ndim)%name = var%name
          dimvars(ndim)%lname = var%lname
          dim(ndim,j) = -1
        else
          if (verbose)  call sic_message(seve%e,rname,'Invalid dimension: '//var%name)
          error = .true.
          return
        endif
      else
        if (dim(ndim,j).lt.1) then
          if (verbose) then
            write(mess,'(A,I1,A,I0)') 'Out of bound dimension #',ndim,': ',dim(ndim,j)
            call sic_message(seve%e,rname,mess)
          endif
          error = .true.
          return
        endif
      endif
    endif
  enddo
  !
  if (imin.lt.imax) then
    if (dim(ndim,1).gt.dim(ndim,2)) then
      if (verbose)  &
        call sic_message(seve%e,rname,'Invalid dimension: '//chain(i1(1):i2(2)))
      error = .true.
      return
    endif
  endif
  !
end subroutine sic_decode_dims
!
subroutine sic_parse_var(namein,var,spec,impvars,error)
  use sic_interfaces, except_this=>sic_parse_var
  use gildas_def
  use sic_structures
  use sic_dictionaries
  use sic_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! SIC
  !   Parse the dimension field of a variable for implicit dimensions
  ! NAME[i,j].
  !   Define the support variables for the implicit (named) dimensions
  ! in the Sic variables dictionary.
  ! On return fill:
  !   var%name
  !   var%lname
  !   specifications description (subarray and/or substring)
  !---------------------------------------------------------------------
  character(len=*),           intent(in)    :: namein    ! String to parse
  type(sic_identifier_t),     intent(out)   :: var       ! Variable name
  type(sic_dimensions_t),     intent(inout) :: spec      ! Dimensions specifications
  integer(kind=4),            intent(out)   :: impvars(sic_maxdims)  ! Id. of implicit variables
  logical,                    intent(inout) :: error     ! Logical error flag
  ! Local
  integer :: i,in,ier,var_last
  logical :: verbose
  !
  ! Default values if early return
  impvars(:) = 0
  !
  verbose = .true.
  call sic_parse_dim(namein,var,spec,verbose,error)
  if (error)  return
  !
  ! Check consistency of implicit/explicit dimensions. Implicit already
  ! parsed in sic_decode_dims
  do i=1,spec%done(1)%ndim
    if (spec%done(1)%dims(i,1).gt.0 .and. spec%done(1)%implicit) then
      error = .true.
      call sic_message(seve%e,'DIMENSION',  &
        'Invalid mixture of implicit and explicit dimensions')
      return
    endif
  enddo
  if (.not.spec%done(1)%implicit) then
    ! No implicit variables. Nothing more to do, leave
    return
  endif
  !
  ! Loop over implicit (temporary) variables
  var_last = var_n  ! Keep track for error recovery
  do i=1,spec%done(1)%ndim
    if (spec%done(1)%dims(i,1).ne.-1)  cycle  ! Not an implicit named dimension
    !
    spec%done(1)%vars(i)%level = var_level
    ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,spec%done(1)%vars(i),in)
    if (ier.eq.1) then
      call sic_message(seve%e,'IMPLICIT','Variable '//  &
        trim(spec%done(1)%vars(i)%name)//' already exists')
      goto 98
    endif
    !
    if (index(spec%done(1)%vars(i)%name,'%').gt.0) then
      ! Implicit variables can not be (or seem to be) member of a structure
      ! (whatever the parent structure exists or not)
      call sic_message(seve%e,'IMPLICIT','Invalid implicit variable name '//  &
        spec%done(1)%vars(i)%name)
      goto 98
    endif
    ier = sic_hasins('IMPLICIT',maxvar,pfvar,pnvar,dicvar,spec%done(1)%vars(i),in)
    if (ier.eq.0 .or. ier.eq.2)  goto 98
    dicvar(in)%desc%status = empty_operand  ! Not yet allocated
    dicvar(in)%desc%size = 0
    spec%done(1)%dims(i,1) = 1
    impvars(i) = in
    var_n = var_n+1
    var_pointer (var_n) = in
  enddo
  return
  !
98 continue
  ! Error: clean up implicit variables
  do i=1,spec%done(1)%ndim
    if (impvars(i).eq.0)  cycle  ! No variable defined
    ! Set user=.false., we will reset var_n by hand right after
    call sic_zapvariable(impvars(i),.false.,.true.,error)
  enddo
  var_n = var_last
  error = .true.
  !
end subroutine sic_parse_var
!
subroutine sic_parse_char(string,var,nchar,spec,verbose,error)
  use sic_interfaces, except_this=>sic_parse_char
  use gildas_def
  use sic_structures
  use sic_dictionaries
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !  Parse the size field of a character variable NAME*i
  ! On return fill:
  !   var%name
  !   var%lname
  !   nchar      (string length)
  !   specifications description (subarray and/or substring)
  !---------------------------------------------------------------------
  character(len=*),       intent(in)    :: string   ! String to parse
  type(sic_identifier_t), intent(out)   :: var      ! Variable
  integer(kind=4),        intent(out)   :: nchar    ! String length
  type(sic_dimensions_t), intent(inout) :: spec     ! Dimensions specifications
  logical,                intent(in)    :: verbose  ! Verbose work?
  logical,                intent(inout) :: error    ! Error flag
  ! Local
  character(len=*), parameter :: rname='DIMENSION'
  integer(kind=4) :: i,ier
  !
  ! Parse name from dimensions...
  call sic_parse_dim(string,var,spec,verbose,error)
  if (error) return
  !
  ! Parse name from string length
  i = index(var%name(1:var%lname),'*')
  if (i.eq.0) then
    call sic_message(seve%e,rname,'Missing character size')
    error = .true.
    return
  elseif (i.gt.len(var%name)) then
    call sic_message(seve%e,rname,'Invalid variable name '//var%name(1:i-1))
    error = .true.
    return
  endif
  read (var%name(i+1:var%lname),*,iostat=ier) nchar
  if (ier.ne.0 .or. nchar.le.0) then
    ! NB: this also traps empty string length
    call sic_message(seve%e,rname,'Invalid string length '//var%name(i+1:var%lname))
    error = .true.
    return
  endif
  ! n = nchar/4
  ! if (4*n.ne.nchar) nchar=4*(n+1)
  var%name = var%name(1:i-1)
  var%lname = i-1
  error = .false.
end subroutine sic_parse_char
!
subroutine i4_index(in,x,dim)
  use sic_interfaces
  use gildas_def
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! This version for sic_maxdims==7
  !---------------------------------------------------------------------
  integer(kind=4),            intent(in)  :: in      ! Which dimension?
  integer(kind=4),            intent(out) :: x(*)    !
  integer(kind=index_length), intent(in)  :: dim(7)  ! Dimensions
  ! Local
  integer(kind=index_length) :: i1,i2,i3,i4,i5,i6,i7,i
  integer(kind=index_length) :: kdim(7)
  !
  do i=1,7
    kdim(i) = dim(i)
    if (kdim(i).le.0) kdim(i) = 1
  enddo
  !
  if (in.eq.1) then
    i = 0
    do i7=1,kdim(7)
      do i6=1,kdim(6)
        do i5=1,kdim(5)
          do i4=1,kdim(4)
            do i3=1,kdim(3)
              do i2=1,kdim(2)
                do i1=1,kdim(1)
                  i = i+1
                  x(i) = i1
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  elseif (in.eq.2) then
    i = 0
    do i7=1,kdim(7)
      do i6=1,kdim(6)
        do i5=1,kdim(5)
          do i4=1,kdim(4)
            do i3=1,kdim(3)
              do i2=1,kdim(2)
                do i1=1,kdim(1)
                  i = i+1
                  x(i) = i2
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  elseif (in.eq.3) then
    i = 0
    do i7=1,kdim(7)
      do i6=1,kdim(6)
        do i5=1,kdim(5)
          do i4=1,kdim(4)
            do i3=1,kdim(3)
              do i2=1,kdim(2)
                do i1=1,kdim(1)
                  i = i+1
                  x(i) = i3
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  elseif (in.eq.4) then
    i = 0
    do i7=1,kdim(7)
      do i6=1,kdim(6)
        do i5=1,kdim(5)
          do i4=1,kdim(4)
            do i3=1,kdim(3)
              do i2=1,kdim(2)
                do i1=1,kdim(1)
                  i = i+1
                  x(i) = i4
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  elseif (in.eq.5) then
    i = 0
    do i7=1,kdim(7)
      do i6=1,kdim(6)
        do i5=1,kdim(5)
          do i4=1,kdim(4)
            do i3=1,kdim(3)
              do i2=1,kdim(2)
                do i1=1,kdim(1)
                  i = i+1
                  x(i) = i5
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  elseif (in.eq.6) then
    i = 0
    do i7=1,kdim(7)
      do i6=1,kdim(6)
        do i5=1,kdim(5)
          do i4=1,kdim(4)
            do i3=1,kdim(3)
              do i2=1,kdim(2)
                do i1=1,kdim(1)
                  i = i+1
                  x(i) = i6
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  elseif (in.eq.7) then
    i = 0
    do i7=1,kdim(7)
      do i6=1,kdim(6)
        do i5=1,kdim(5)
          do i4=1,kdim(4)
            do i3=1,kdim(3)
              do i2=1,kdim(2)
                do i1=1,kdim(1)
                  i = i+1
                  x(i) = i7
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  endif
end subroutine i4_index
!
subroutine i8_index(in,x,dim)
  use sic_interfaces
  use gildas_def
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! This version for sic_maxdims==7
  !---------------------------------------------------------------------
  integer(kind=4),            intent(in)  :: in      ! Which dimension?
  integer(kind=8),            intent(out) :: x(*)    !
  integer(kind=index_length), intent(in)  :: dim(7)  ! Dimensions
  ! Local
  integer(kind=index_length) :: i1,i2,i3,i4,i5,i6,i7,i
  integer(kind=index_length) :: kdim(7)
  !
  do i=1,7
    kdim(i) = dim(i)
    if (kdim(i).le.0) kdim(i) = 1
  enddo
  !
  if (in.eq.1) then
    i = 0
    do i7=1,kdim(7)
      do i6=1,kdim(6)
        do i5=1,kdim(5)
          do i4=1,kdim(4)
            do i3=1,kdim(3)
              do i2=1,kdim(2)
                do i1=1,kdim(1)
                  i = i+1
                  x(i) = i1
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  elseif (in.eq.2) then
    i = 0
    do i7=1,kdim(7)
      do i6=1,kdim(6)
        do i5=1,kdim(5)
          do i4=1,kdim(4)
            do i3=1,kdim(3)
              do i2=1,kdim(2)
                do i1=1,kdim(1)
                  i = i+1
                  x(i) = i2
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  elseif (in.eq.3) then
    i = 0
    do i7=1,kdim(7)
      do i6=1,kdim(6)
        do i5=1,kdim(5)
          do i4=1,kdim(4)
            do i3=1,kdim(3)
              do i2=1,kdim(2)
                do i1=1,kdim(1)
                  i = i+1
                  x(i) = i3
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  elseif (in.eq.4) then
    i = 0
    do i7=1,kdim(7)
      do i6=1,kdim(6)
        do i5=1,kdim(5)
          do i4=1,kdim(4)
            do i3=1,kdim(3)
              do i2=1,kdim(2)
                do i1=1,kdim(1)
                  i = i+1
                  x(i) = i4
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  elseif (in.eq.5) then
    i = 0
    do i7=1,kdim(7)
      do i6=1,kdim(6)
        do i5=1,kdim(5)
          do i4=1,kdim(4)
            do i3=1,kdim(3)
              do i2=1,kdim(2)
                do i1=1,kdim(1)
                  i = i+1
                  x(i) = i5
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  elseif (in.eq.6) then
    i = 0
    do i7=1,kdim(7)
      do i6=1,kdim(6)
        do i5=1,kdim(5)
          do i4=1,kdim(4)
            do i3=1,kdim(3)
              do i2=1,kdim(2)
                do i1=1,kdim(1)
                  i = i+1
                  x(i) = i6
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  elseif (in.eq.7) then
    i = 0
    do i7=1,kdim(7)
      do i6=1,kdim(6)
        do i5=1,kdim(5)
          do i4=1,kdim(4)
            do i3=1,kdim(3)
              do i2=1,kdim(2)
                do i1=1,kdim(1)
                  i = i+1
                  x(i) = i7
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  endif
end subroutine i8_index
!
subroutine sic_incarnate_desc(form,desc,inca,error)
  use gildas_def
  use gbl_format
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_incarnate_desc
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ public-generic sic_incarnate
  !  Creates an "incarnation" of a variable under a specified type
  ! (REAL, DOUBLE, INTEGER...).
  ! DESC and INCA can be the same descriptor if needed (=> do not
  ! put INTENT statements).
  !---------------------------------------------------------------------
  integer(kind=4),        intent(in)    :: form   ! Format of the desired incarnation
  type(sic_descriptor_t), intent(in)    :: desc   ! Input descriptor of the variable
  type(sic_descriptor_t), intent(inout) :: inca   ! Descriptor of the incarnation
  logical,                intent(out)   :: error  ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='INCARNATE'
  integer :: type,ier
  integer(kind=size_length) :: np
  integer(kind=address_length) :: ipnta,ipntb,addr
  !
  error = .false.
  type = desc%type
  if (type.eq.form) then
    inca = desc
    !
  elseif (form.eq.fmt_r4) then
    if (type.eq.fmt_r8) then
      ! R8 -> R4
      addr = desc%addr
      np   = desc%size/2
      inca%size = np
      inca%ndim = desc%ndim
      inca%dims(:) = desc%dims(:)
      inca%status = scratch_operand
      ier = sic_getvm(inca%size,inca%addr)
      if (ier.ne.1) goto 99
      ipnta = gag_pointer(addr,memory)
      ipntb = gag_pointer(inca%addr,memory)
      call r8tor4_sl(memory(ipnta),memory(ipntb),np)
    elseif (type.eq.fmt_i4) then
      ! I4 -> R4
      addr = desc%addr
      np   = desc%size
      inca%size = np
      inca%ndim = desc%ndim
      inca%dims(:) = desc%dims(:)
      inca%status = scratch_operand
      ier = sic_getvm(inca%size,inca%addr)
      if (ier.ne.1) goto 99
      ipnta = gag_pointer(addr,memory)
      ipntb = gag_pointer(inca%addr,memory)
      call i4tor4_sl(memory(ipnta),memory(ipntb),np)
    elseif (type.eq.fmt_i8) then
      ! I8 -> R4
      addr = desc%addr
      np   = desc%size/2
      inca%size = np
      inca%ndim = desc%ndim
      inca%dims(:) = desc%dims(:)
      inca%status = scratch_operand
      ier = sic_getvm(inca%size,inca%addr)
      if (ier.ne.1) goto 99
      ipnta = gag_pointer(addr,memory)
      ipntb = gag_pointer(inca%addr,memory)
      call i8tor4_sl(memory(ipnta),memory(ipntb),np)
    elseif (type.eq.fmt_c4) then
      ! C4 -> R4
      call sic_message(seve%e,rname,'Cannot convert COMPLEX*4 to REAL*4')
      error = .true.
      return
    else
      call sic_message(seve%e,rname,'Bad variable type (1)')
      error = .true.
      return
    endif
  elseif (form.eq.fmt_r8) then
    if (type.eq.fmt_r4) then
      ! R4 -> R8
      addr = desc%addr
      np   = desc%size
      inca%size = np*2
      inca%ndim = desc%ndim
      inca%dims(:) = desc%dims(:)
      inca%status = scratch_operand
      ier = sic_getvm(inca%size,inca%addr)
      if (ier.ne.1) goto 99
      ipnta = gag_pointer(addr,memory)
      ipntb = gag_pointer(inca%addr,memory)
      call r4tor8_sl(memory(ipnta),memory(ipntb),np)
    elseif (type.eq.fmt_i4) then
      ! I4 -> R8
      addr = desc%addr
      np   = desc%size
      inca%size = 2*np
      inca%ndim = desc%ndim
      inca%dims(:) = desc%dims(:)
      inca%status = scratch_operand
      ier = sic_getvm(inca%size,inca%addr)
      if (ier.ne.1) goto 99
      ipnta = gag_pointer(addr,memory)
      ipntb = gag_pointer(inca%addr,memory)
      call i4tor8_sl(memory(ipnta),memory(ipntb),np)
    elseif (type.eq.fmt_i8) then
      ! I8 -> R8
      addr = desc%addr
      np   = desc%size/2
      inca%size = 2*np
      inca%ndim = desc%ndim
      inca%dims(:) = desc%dims(:)
      inca%status = scratch_operand
      ier = sic_getvm(inca%size,inca%addr)
      if (ier.ne.1) goto 99
      ipnta = gag_pointer(addr,memory)
      ipntb = gag_pointer(inca%addr,memory)
      call i8tor8_sl(memory(ipnta),memory(ipntb),np)
    elseif (type.eq.fmt_c4) then
      ! C4 -> R8
      call sic_message(seve%e,rname,'Cannot convert COMPLEX*4 to REAL*8')
      error = .true.
      return
    else
      call sic_message(seve%e,rname,'Bad variable type (2)')
      error = .true.
      return
    endif
  elseif (form.eq.fmt_i4) then
    if (type.eq.fmt_r8) then
      ! R8 -> I4
      addr = desc%addr
      np   = desc%size/2
      inca%size = np
      inca%ndim = desc%ndim
      inca%dims(:) = desc%dims(:)
      inca%status = scratch_operand
      ier = sic_getvm(inca%size,inca%addr)
      if (ier.ne.1) goto 99
      ipnta = gag_pointer(addr,memory)
      ipntb = gag_pointer(inca%addr,memory)
      call r8toi4_fini_sl(memory(ipnta),memory(ipntb),np,error)
      if (error)  return
    elseif (type.eq.fmt_r4) then
      ! R4 -> I4
      addr = desc%addr
      np   = desc%size
      inca%size = np
      inca%ndim = desc%ndim
      inca%dims(:) = desc%dims(:)
      inca%status = scratch_operand
      ier = sic_getvm(inca%size,inca%addr)
      if (ier.ne.1) goto 99
      ipnta = gag_pointer(addr,memory)
      ipntb = gag_pointer(inca%addr,memory)
      call r4toi4_fini_sl(memory(ipnta),memory(ipntb),np,error)
      if (error)  return
    elseif (type.eq.fmt_i8) then
      ! I8 -> I4
      addr = desc%addr
      np   = desc%size/2
      inca%size = np
      inca%ndim = desc%ndim
      inca%dims(:) = desc%dims(:)
      inca%status = scratch_operand
      ier = sic_getvm(inca%size,inca%addr)
      if (ier.ne.1) goto 99
      ipnta = gag_pointer(addr,memory)
      ipntb = gag_pointer(inca%addr,memory)
      call i8toi4_fini_sl(memory(ipnta),memory(ipntb),np,error)
      if (error)  return
    elseif (type.eq.fmt_c4) then
      ! C4 -> I4
      call sic_message(seve%e,rname,'Cannot convert COMPLEX*4 to INTEGER*4')
      error = .true.
      return
    else
      call sic_message(seve%e,rname,'Bad variable type (3)')
      error = .true.
      return
    endif
  elseif (form.eq.fmt_i8) then
    if (type.eq.fmt_r8) then
      ! R8 -> I8
      addr = desc%addr
      np   = desc%size/2
      inca%size = np*2
      inca%ndim = desc%ndim
      inca%dims(:) = desc%dims(:)
      inca%status = scratch_operand
      ier = sic_getvm(inca%size,inca%addr)
      if (ier.ne.1) goto 99
      ipnta = gag_pointer(addr,memory)
      ipntb = gag_pointer(inca%addr,memory)
      call r8toi8_fini_sl(memory(ipnta),memory(ipntb),np,error)
      if (error)  return
    elseif (type.eq.fmt_r4) then
      ! R4 -> I8
      addr = desc%addr
      np   = desc%size
      inca%size = np*2
      inca%ndim = desc%ndim
      inca%dims(:) = desc%dims(:)
      inca%status = scratch_operand
      ier = sic_getvm(inca%size,inca%addr)
      if (ier.ne.1) goto 99
      ipnta = gag_pointer(addr,memory)
      ipntb = gag_pointer(inca%addr,memory)
      call r4toi8_fini_sl(memory(ipnta),memory(ipntb),np,error)
      if (error)  return
    elseif (type.eq.fmt_i4) then
      ! I4 -> I8
      addr = desc%addr
      np   = desc%size
      inca%size = np*2
      inca%ndim = desc%ndim
      inca%dims(:) = desc%dims(:)
      inca%status = scratch_operand
      ier = sic_getvm(inca%size,inca%addr)
      if (ier.ne.1) goto 99
      ipnta = gag_pointer(addr,memory)
      ipntb = gag_pointer(inca%addr,memory)
      call i4toi8_sl(memory(ipnta),memory(ipntb),np)
    elseif (type.eq.fmt_c4) then
      ! C4 -> I8
      call sic_message(seve%e,rname,'Cannot convert COMPLEX*4 to INTEGER*8')
      error = .true.
      return
    else
      call sic_message(seve%e,rname,'Bad variable type (4)')
      error = .true.
      return
    endif
  elseif (form.eq.fmt_c4) then
    call sic_message(seve%e,rname,'Cannot convert to COMPLEX*4 (not implemented)')
    error = .true.
    return
  else
    call sic_message(seve%e,rname,'Bad incarnation type')
    error = .true.
    return
  endif
  error = .false.
  inca%type = form
  inca%readonly = desc%readonly  ! For symmetry with sic_materialize, which also
    ! reuse the readonly code on the input descriptor. Using a different readonly
    ! code can result in erroneous differences in sic_notsamedesc.
  return
  !
99 call sic_message(seve%e,rname,'Memory allocation failure')
  error =.true.
end subroutine sic_incarnate_desc
!
subroutine sic_incarnate_i4(i4,inca,error)
  use gbl_format
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_incarnate_i4
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ public-generic sic_incarnate
  !  Creates an "incarnation" of an explicit I*4 value
  !---------------------------------------------------------------------
  integer(kind=4),        intent(in)    :: i4     ! The value to be incarnated
  type(sic_descriptor_t), intent(out)   :: inca   ! Descriptor of the incarnation
  logical,                intent(inout) :: error  ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  integer(kind=4) :: ier
  integer(kind=address_length) :: ip
  !
  inca%type = fmt_i4
  inca%size = 1
  inca%ndim = 0
  inca%dims(:) = 0
  inca%readonly = .true.
  ier = sic_getvm(inca%size,inca%addr)
  if (ier.ne.1)  then
    error = .true.
    return
  endif
  inca%status = scratch_operand
  ip = gag_pointer(inca%addr,memory)
  call i4toi4(i4,memory(ip),1)
  !
end subroutine sic_incarnate_i4
!
subroutine sic_incarnate_i8(i8,inca,error)
  use gbl_format
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_incarnate_i8
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ public-generic sic_incarnate
  !  Creates an "incarnation" of an explicit I*8 value
  !---------------------------------------------------------------------
  integer(kind=8),        intent(in)    :: i8     ! The value to be incarnated
  type(sic_descriptor_t), intent(out)   :: inca   ! Descriptor of the incarnation
  logical,                intent(inout) :: error  ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  integer(kind=4) :: ier
  integer(kind=address_length) :: ip
  !
  inca%type = fmt_i8
  inca%size = 2
  inca%ndim = 0
  inca%dims(:) = 0
  inca%readonly = .true.
  ier = sic_getvm(inca%size,inca%addr)
  if (ier.ne.1)  then
    error = .true.
    return
  endif
  inca%status = scratch_operand
  ip = gag_pointer(inca%addr,memory)
  call i8toi8(i8,memory(ip),1)
  !
end subroutine sic_incarnate_i8
!
subroutine sic_incarnate_r8(r8,inca,error)
  use gbl_format
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_incarnate_r8
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ public-generic sic_incarnate
  !  Creates an "incarnation" of an explicit R*8 value
  !---------------------------------------------------------------------
  real(kind=8),           intent(in)    :: r8     ! The value to be incarnated
  type(sic_descriptor_t), intent(out)   :: inca   ! Descriptor of the incarnation
  logical,                intent(inout) :: error  ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  integer(kind=4) :: ier
  integer(kind=address_length) :: ip
  !
  inca%type = fmt_r8
  inca%size = 2
  inca%ndim = 0
  inca%dims(:) = 0
  inca%readonly = .true.
  ier = sic_getvm(inca%size,inca%addr)
  if (ier.ne.1)  then
    error = .true.
    return
  endif
  inca%status = scratch_operand
  ip = gag_pointer(inca%addr,memory)
  call r8tor8(r8,memory(ip),1)
  !
end subroutine sic_incarnate_r8
!
subroutine sic_incarnate_l4(l4,inca,error)
  use gbl_format
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_incarnate_l4
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ public-generic sic_incarnate
  !  Creates an "incarnation" of an explicit L*4 value
  !---------------------------------------------------------------------
  logical,                intent(in)    :: l4     ! The value to be incarnated
  type(sic_descriptor_t), intent(out)   :: inca   ! Descriptor of the incarnation
  logical,                intent(inout) :: error  ! Logical error flag
  ! Local
  logical :: found
  !
  found = .true.  ! Verbose
  if (l4) then
    call sic_descriptor('YES',inca,found)
  else
    call sic_descriptor('NO',inca,found)
  endif
end subroutine sic_incarnate_l4
!
subroutine sic_incarnate_ch(ch,inca,error)
  use gbl_format
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_incarnate_ch
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ public-generic sic_incarnate
  !  Creates an "incarnation" of an explicit C*(*) value
  !---------------------------------------------------------------------
  character(len=*),       intent(in)    :: ch     ! The string to be incarnated
  type(sic_descriptor_t), intent(out)   :: inca   ! Descriptor of the incarnation
  logical,                intent(inout) :: error  ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  integer(kind=4) :: ier,lch
  integer(kind=address_length) :: ip
  !
  lch = len(ch)
  inca%type = lch
  inca%size = (lch+3)/4
  inca%ndim = 0
  inca%dims(:) = 0
  inca%readonly = .true.
  ier = sic_getvm(inca%size,inca%addr)
  if (ier.ne.1)  then
    error = .true.
    return
  endif
  inca%status = scratch_operand
  ip = bytpnt(inca%addr,membyt)
  call bytoby(ch,membyt(ip),lch)
  !
end subroutine sic_incarnate_ch
!
subroutine sic_volatile(desc)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_volatile
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ public
  ! Free data associated to a variable if it is Scratch
  !---------------------------------------------------------------------
  type(sic_descriptor_t), intent(in) :: desc  !
  !
  if (desc%status.eq.scratch_operand) then
    ! print *,'Freeing Scratch ',desc
    call free_vm(desc%size,desc%addr)
  endif
  !
end subroutine sic_volatile
!
function sic_notsamedesc(one,two)
  use sic_types
  !---------------------------------------------------------------------
  ! @ public
  ! Check if two descriptors are equal
  !---------------------------------------------------------------------
  logical :: sic_notsamedesc  ! Function value on return
  type(sic_descriptor_t), intent(in) :: one  !
  type(sic_descriptor_t), intent(in) :: two  !
  !
  sic_notsamedesc = one%type.ne.two%type           .or.  &
                    one%ndim.ne.two%ndim           .or.  &
                    any(one%dims.ne.two%dims)      .or.  &
                    one%addr.ne.two%addr           .or.  &
                    one%size.ne.two%size           .or.  &
                    one%status.ne.two%status       .or.  &
                    (one%readonly.neqv.two%readonly)
  !
end function sic_notsamedesc
!
subroutine intege(var,inte,error)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>intege
  use gildas_def
  use sic_structures
  use sic_dictionaries
  use sic_types
  use gbl_format
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! Translate the input variable to an integer value. The routine makes
  ! sure that it is really a scalar numeric variable, and cast it to an
  ! integer if needed.
  !---------------------------------------------------------------------
  type(sic_identifier_t),     intent(inout) :: var    ! Variable to translate
  integer(kind=index_length), intent(out)   :: inte   ! Integer value on return
  logical,                    intent(out)   :: error  ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  integer*8 :: long
  integer :: in,type,ier
  integer(kind=address_length) :: ipnt
  type(sic_descriptor_t) :: descr
  character(len=message_length) :: mess
  !
  if (var%lname.gt.varname_length) then
    error = .true.
    return
  endif
  !
  ! Search for this variable
  var%level = var_level
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.ne.1) then
    var%level = 0
    ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
    if (ier.ne.1) then
      error = .true.
      return
    endif
  endif
  !
  error = .false.
  descr = dicvar(in)%desc
  type = descr%type
  ipnt = gag_pointer(descr%addr,memory)
  if (type.ge.0) then
    error = .true.
  elseif (descr%ndim.ne.0) then
    error = .true.
  elseif (type.eq.fmt_r4) then
    call r4toi8_fini(memory(ipnt),long,1,error)
  elseif (type.eq.fmt_r8) then
    call r8toi8_fini(memory(ipnt),long,1,error)
  elseif (type.eq.fmt_i4) then
    call i4toi8(memory(ipnt),long,1)
  elseif (type.eq.fmt_i8) then
    call i8toi8(memory(ipnt),long,1)
  else
    error = .true.
  endif
  if (error)  return
  !
  inte = long
  if (inte.ne.long) then
    ! One solution might be that this subroutine returns a long integer...
    write(mess,'(A,I0,A)')  &
      'Can not downcast long integer value ',long,' to standard integer'
    call sic_message(seve%e,'DIMENSION',mess)
    error = .true.
    return
  endif
  !
end subroutine intege
!
subroutine extract_array(in,ndin,indim,inoff,item_size,out,ndout,outdim,error)
  use sic_interfaces
  use gildas_def
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  !   Extract a subarray variable with arbitrary bounds and element size
  !   Valid for a maximum of 4 dimensions
  ! Code is not optimized, but could be at 2 different levels
  ! - moving constant instructions at the upper loop level (the compiler
  !   probably does it)
  ! - suppressing the inner loop
  ! This version for sic_maxdims==7
  !---------------------------------------------------------------------
  integer(kind=1),            intent(in)    :: in(*)       ! Input value array
  integer(kind=4)                           :: ndin        ! Number of dimensions to input variable (unused)
  integer(kind=index_length), intent(in)    :: indim(7)    ! Dimensions of input array
  integer(kind=index_length), intent(in)    :: inoff(7,2)  ! Offsets of subarray within input array
  integer(kind=4),            intent(in)    :: item_size   ! Size (in bytes) of array elements
  integer(kind=1),            intent(out)   :: out(*)      ! Output buffer
  integer(kind=4)                           :: ndout       ! Number of dimensions of output array (unused)
  integer(kind=index_length), intent(in)    :: outdim(7)   ! Dimensions of output array
  logical,                    intent(inout) :: error       ! Logical error flag
  ! Local
  integer(kind=index_length) :: i1,i2,i3,i4,i5,i6,i7
  integer(kind=8) :: off_in,off_out  ! Offsets in the arrays. Use kind=8 integers
  ! because kind=size_length=4 is not enough under 32 bits machines: limit would
  ! be arrays of 2**31-1 bytes = 2**29 real*4 words or 2**28 real*8 words...
  !
  do i7=1,max(outdim(7),1)
    do i6=1,max(outdim(6),1)
      do i5=1,max(outdim(5),1)
        do i4=1,max(outdim(4),1)
          do i3=1,max(outdim(3),1)
            do i2=1,max(outdim(2),1)
              do i1=1,max(outdim(1),1)
                off_in =         (i7+max(inoff(7,1),1)-2) *indim(6)
                off_in = (off_in+(i6+max(inoff(6,1),1)-2))*indim(5)
                off_in = (off_in+(i5+max(inoff(5,1),1)-2))*indim(4)
                off_in = (off_in+(i4+max(inoff(4,1),1)-2))*indim(3)
                off_in = (off_in+(i3+max(inoff(3,1),1)-2))*indim(2)
                off_in = (off_in+(i2+max(inoff(2,1),1)-2))*indim(1)
                off_in = (off_in+(i1+max(inoff(1,1),1)-2))*item_size+1
                !
                off_out =          (i7-1) *outdim(6)
                off_out = (off_out+(i6-1))*outdim(5)
                off_out = (off_out+(i5-1))*outdim(4)
                off_out = (off_out+(i4-1))*outdim(3)
                off_out = (off_out+(i3-1))*outdim(2)
                off_out = (off_out+(i2-1))*outdim(1)
                off_out = (off_out+(i1-1))*item_size+1
                ! Avoid calling a subroutine
                ! call bytoby(in(off_in),out(off_out),item_size)
                out(off_out:off_out+item_size-1) = in(off_in:off_in+item_size-1)
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  enddo
  !
end subroutine extract_array
!
subroutine copy_back(in,out,ndim,dim,name,error)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>copy_back
  use gildas_def
  use sic_structures
  use sic_dictionaries
  use sic_types
  use gbl_message
  use gbl_format
  !---------------------------------------------------------------------
  ! @ private
  !  Copy back from scratch contiguous incarnation of a subarray to the
  ! relevant fraction of the original variable.
  !---------------------------------------------------------------------
  type(sic_descriptor_t),     intent(in)    :: in     ! Descriptor of scratch incarnation of subarray
  type(sic_descriptor_t),     intent(in)    :: out    ! Descriptor of the permanent variable
  integer,                    intent(in)    :: ndim   ! Number of fixed indexes
  integer(kind=index_length), intent(in)    :: dim(sic_maxdims,2)  ! Fixed indexes
  character(len=*),           intent(in)    :: name   ! Name of variable
  logical,                    intent(inout) :: error  ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='LET'
  integer :: i,j,type,item_size
  type(sic_descriptor_t) :: new_in
  integer(kind=address_length) :: ipntin,ipntout
  character(len=message_length) :: mess
  !
  if (error) then
    ! Caller is in error condition:
    ! - do not modify the error flag
    ! - do not do anything here
    return
  endif
  !
  new_in = in
  !
  ! Check for some internal logic errors. Remove when fully tested?
  ! Full arrays should have been filled
  if (ndim.eq.0) then
    call sic_message(seve%e,rname,'Copying back a full copy of '//name)
    error = .true.
    return
  endif
  !
  ! Restore degenerate input dimensions
  j = 0
  do i=1,ndim
    ! Dummy sizes should have been substituted earlier
    if (dim(i,1).eq.0.or.dim(i,2).eq.0) then
      call sic_message(seve%e,rname,'Dummy dimensions remaining in COPY_BACK')
      error = .true.
      return
    elseif (dim(i,1).eq.dim(i,2)) then
      new_in%dims(i) = 1
      j = j+1
    elseif ((dim(i,2)-dim(i,1)+1).eq.in%dims(i-j)) then
      new_in%dims(i) = in%dims(i-j)
    else
      call sic_message(seve%e,rname,'Internal logic error detected in '//  &
      'COPY_BACK')
      error = .true.
      return
    endif
  enddo
  if (ndim.gt.out%ndim) then
    call sic_message(seve%e,rname,'Inconsistent number of dimensions '//  &
    'between scratch and permanent')
    call sic_message(seve%e,rname,'incarnations for '//name)
    write(mess,*) ndim,in%ndim,out%ndim
    call sic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  new_in%ndim = out%ndim
  !
  ! Compute element size in byte units
  type = in%type
  if (type.eq.fmt_r8 .or. type.eq.fmt_c4 .or. type.eq.fmt_i8) then ! Double
    item_size = 8
  elseif (type.gt.0) then      ! Char
    item_size = type
  else                         ! Anything else
    item_size = 4
  endif
  !
  ! Immerse a subarray. Not at all optimised.
  ipntin  = gag_pointer(in%addr,memory)
  ipntout = gag_pointer(out%addr,memory)
  call plunge_array(memory(ipntin),new_in%ndim,new_in%dims,dim,  &
    item_size,memory(ipntout),out%ndim,out%dims,error)
end subroutine copy_back
!
subroutine plunge_array(in,ndin,indim,outoff,item_size,out,ndout,outdim,error)
  use sic_interfaces
  use gildas_def
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Plunge an array into a bigger one.
  ! Code is not optimized, but could be at 2 different levels
  ! - moving constant instructions at the upper loop level (the compiler
  !   probably does it)
  ! - suppressing the inner loop
  ! This version for sic_maxdims==7
  !---------------------------------------------------------------------
  integer(kind=1),            intent(in)    :: in(*)        ! Input array
  integer(kind=4)                           :: ndin         ! Unused, but could be
  integer(kind=index_length), intent(in)    :: indim(7)     ! Array dimensions
  integer(kind=index_length), intent(in)    :: outoff(7,2)  ! Array position
  integer(kind=4),            intent(in)    :: item_size    ! Size of element in Bytes
  integer(kind=1),            intent(out)   :: out(*)       ! Output array
  integer(kind=4)                           :: ndout        ! Unused, but could be
  integer(kind=index_length), intent(in)    :: outdim(7)    ! Array dimensions
  logical,                    intent(inout) :: error        ! Unused
  ! Local
  integer(kind=index_length) :: i1,i2,i3,i4,i5,i6,i7
  integer(kind=8) :: off_in,off_out  ! Offsets in the arrays. Use kind=8 integers
  ! because kind=size_length=4 is not enough under 32 bits machines: limit would
  ! be arrays of 2**31-1 bytes = 2**29 real*4 words or 2**28 real*8 words...
  !
  do i7=1,max(indim(7),1)
    do i6=1,max(indim(6),1)
      do i5=1,max(indim(5),1)
        do i4=1,max(indim(4),1)
          do i3=1,max(indim(3),1)
            do i2=1,max(indim(2),1)
              do i1=1,max(indim(1),1)
                off_out =            (i7+max(outoff(7,1),1)-2) *outdim(6)
                off_out = (off_out + (i6+max(outoff(6,1),1)-2))*outdim(5)
                off_out = (off_out + (i5+max(outoff(5,1),1)-2))*outdim(4)
                off_out = (off_out + (i4+max(outoff(4,1),1)-2))*outdim(3)
                off_out = (off_out + (i3+max(outoff(3,1),1)-2))*outdim(2)
                off_out = (off_out + (i2+max(outoff(2,1),1)-2))*outdim(1)
                off_out = (off_out + (i1+max(outoff(1,1),1)-2))*item_size+1
                !
                off_in =         (i7-1) *indim(6)
                off_in = (off_in+(i6-1))*indim(5)
                off_in = (off_in+(i5-1))*indim(4)
                off_in = (off_in+(i4-1))*indim(3)
                off_in = (off_in+(i3-1))*indim(2)
                off_in = (off_in+(i2-1))*indim(1)
                off_in = (off_in+(i1-1))*item_size+1
                ! Avoid calling a subroutine
                ! call bytoby(in(off_in),out(off_out),item_size)
                out(off_out:off_out+item_size-1) = in(off_in:off_in+item_size-1)
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  enddo
  !
end subroutine plunge_array
