!-----------------------------------------------------------------------
! Support file for the File Descriptor
!-----------------------------------------------------------------------
subroutine classic_filedesc_init(file,fkind,lsingle,lsize,vind,lind,gex,error)
  use gildas_def
  use gbl_format
  use gbl_message
  use gkernel_interfaces
  use classic_interfaces, except_this=>classic_filedesc_init
  use classic_params
  use classic_types
  use classic_vars
  !---------------------------------------------------------------------
  ! @ public
  !   Initialize a new File Descriptor.
  !   The following elements must have been set before:
  !       file%lun, file%spec, file%nspec
  !   On return, those are set:
  !       file%desc, file%conv
  !---------------------------------------------------------------------
  type(classic_file_t),       intent(inout) :: file     !
  integer(kind=4),            intent(in)    :: fkind    ! File kind
  logical,                    intent(in)    :: lsingle  ! Single or multiple
  integer(kind=entry_length), intent(in)    :: lsize    ! Total number of entries (linear growth)
  integer(kind=4),            intent(in)    :: vind     ! Index version
  integer(kind=4),            intent(in)    :: lind     ! Index length (words)
  real(kind=4),               intent(in)    :: gex      ! Extension growth
  logical,                    intent(inout) :: error    ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='FILE'
  !
  ! Set up the conversion routines
  file%conv%code = 0    ! New File = Native = No conversion
  call classic_conv(file%conv,error)
  if (error)  return
  !
  ! Set up the File Descriptor structure
  call filedesc_init_common(fkind,vind,lind,lsingle,gex,file%desc,error)
  if (error)  return
  if (file%desc%version.eq.1) then
    call filedesc_init_v1(file%desc,error)
  else
    call filedesc_init_v2(file%desc,error)
  endif
  if (error)  return
  call filedesc_init_lex1(lsize,file%desc,error)  ! Must come last
  if (error)  return
  !
  ! No need to set up the first extension: it will be done when writing
  ! the first entry (i.e. symmetric to what happens when setting any
  ! extension).
  !
  ! Write the File Descriptor to the file
  call classic_filedesc_write(file,error)
  if (error)  return
  !
  ! Flush first records
  call classic_file_fflush(file,error)
  if (error)  return
  !
end subroutine classic_filedesc_init
!
subroutine filedesc_init_common(fkind,vind,lind,lsingle,gex,fdesc,error)
  use gbl_message
  use classic_interfaces, except_this=>filedesc_init_common
  use classic_params
  use classic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Initialize the common part of File Descriptor structure in memory
  ! (i.e. V2), suited for any File Version
  !---------------------------------------------------------------------
  integer(kind=4),          intent(in)    :: fkind    ! File kind
  integer(kind=4),          intent(in)    :: vind     ! Index version
  integer(kind=4),          intent(in)    :: lind     ! Index length (words)
  logical,                  intent(in)    :: lsingle  ! Single or multiple?
  real(kind=4),             intent(in)    :: gex      ! Extension growth
  type(classic_filedesc_t), intent(inout) :: fdesc    ! File Descriptor
  logical,                  intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='FILE'
  character(len=message_length) :: mess
  integer(kind=4) :: gex10
  !
  if (fkind.ne.classic_kind_demo  .and.  &
      fkind.ne.classic_kind_class .and.  &
      fkind.ne.classic_kind_clic  .and.  &
      fkind.ne.classic_kind_mrtcal) then
    write(mess,'(A,I0)')  'Unknown File Kind #',fkind
    call classic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  if (lind.le.0) then
    write(mess,'(A,I0)')  'Programming error: illegal Entry Index length ',lind
    call classic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  gex10 = nint(10.0*gex)
  if (gex10.ne.10 .and. gex10.ne.20) then
    write(mess,'(A,F0.1)')  &
      'Programming error: unimplemented Extension Growth ',gex
    call classic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! fdesc%reclen has been set before
  fdesc%kind   = fkind    !
  fdesc%vind   = vind     !
  fdesc%lind   = lind     !
  fdesc%single = lsingle  !
  fdesc%flags  = 0        ! Set the 32 bits to 0
  if (fdesc%single)  fdesc%flags = ibset(fdesc%flags,0)  ! Set 1st bit
  fdesc%xnext  = 1        ! Next available entry number
  fdesc%nex    = 0        ! Current number of extensions used
  fdesc%gex    = gex10    ! 10*gex, rounded to nearest integer
  !
end subroutine filedesc_init_common
!
subroutine filedesc_init_v1(fdesc,error)
  use gbl_message
  use classic_interfaces, except_this=>filedesc_init_v1
  use classic_params
  use classic_types
  use classic_vars
  !---------------------------------------------------------------------
  ! @ private
  !  Initialize the File Descriptor structure in memory (i.e. V2),
  ! suited for Version 1 files
  !---------------------------------------------------------------------
  type(classic_filedesc_t), intent(inout) :: fdesc  ! File Descriptor
  logical,                  intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='FILE'
  character(len=message_length) :: mess
  !
  if (fdesc%lind.ne.classic_lind_v1) then
    write(mess,'(A,I0,A,I0,A)')  &
      'Programming error: Index length must be ',classic_lind_v1,  &
      ' for Version 1 files (got ',fdesc%lind,')'
    call classic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  if (fdesc%vind.ne.classic_vind_v1) then
    write(mess,'(A,I0,A,I0,A)')  &
      'Programming error: Index version must be ',classic_vind_v1,  &
      ' for Version 1 files (got ',fdesc%vind,')'
    call classic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  if (fdesc%gex.ne.10) then
    write(mess,'(A,A,F0.1,A)')  &
      'Programming error: Extension Growth must be linear (1.0)',  &
      ' for Version 1 files (got ',fdesc%gex/10.,')'
    call classic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  fdesc%version = 1
  !
  if (fdesc%single) then
    fdesc%code = code_file_v1_single
  else
    fdesc%code = code_file_v1_multiple
  endif
  fdesc%nextrec = 3   ! V1: the File Descriptor takes 2 records, next available is 3
  fdesc%nextword = 1
  !
  ! Set fdesc%mex and define fdesc%aex(:)
  call reallocate_aex(fdesc,mex_v1,error)
  if (error)  return
  !
end subroutine filedesc_init_v1
!
subroutine filedesc_init_v2(fdesc,error)
  use gbl_message
  use gkernel_interfaces
  use classic_interfaces, except_this=>filedesc_init_v2
  use classic_types
  use classic_vars
  !---------------------------------------------------------------------
  ! @ private
  !  Initialize the File Descriptor structure in memory (i.e. V2),
  ! suited for Version 2 files
  !---------------------------------------------------------------------
  type(classic_filedesc_t), intent(inout) :: fdesc  ! File Descriptor
  logical,                  intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='FILE'
  character(len=message_length) :: mess
  integer(kind=4) :: reclenmin,mex
  !
  ! There should be room for at least 1 extension address in the file
  ! descriptor AND for at least 1 entry index in the 1st extension
  ! index (linear or exponential growth)
  reclenmin = max(filedescv2_nw1+2,fdesc%lind)
  !
  if (fdesc%reclen.lt.reclenmin) then
    write(mess,'(A,I0,A,I0,A)')  &
      'Programming error: record length must be at least ',reclenmin,  &
      ' for Version 2 files (got ',fdesc%reclen,')'
    call classic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  fdesc%version = 2
  fdesc%code = code_file_v2
  fdesc%nextrec = 2  ! V2: the File Descriptor takes 1 record
  fdesc%nextword = 1
  !
  ! Set fdesc%mex and define fdesc%aex(:)
  mex = (fdesc%reclen-filedescv2_nw1)/2  ! Size of aex(:) (2 words per element)
  call reallocate_aex(fdesc,mex,error)
  if (error)  return
  !
end subroutine filedesc_init_v2
!
subroutine filedesc_init_lex1(lsize,fdesc,error)
  use gbl_message
  use classic_interfaces, except_this=>filedesc_init_lex1
  use classic_params
  use classic_types
  !---------------------------------------------------------------------
  ! @ private
  !   Compute the extension length. mex, gex and several parameters must
  ! have already been set.
  !---------------------------------------------------------------------
  integer(kind=entry_length), intent(in)    :: lsize  ! Max number of entries in the file
  type(classic_filedesc_t),   intent(inout) :: fdesc  ! File Descriptor
  logical,                    intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='FILE'
  integer(kind=entry_length), parameter :: maxi=2147483647
  character(len=message_length) :: mess
  integer(kind=8) :: lex1_e,lex1_r
  !
  if (fdesc%version.eq.1 .and. lsize.gt.maxi) then
    write(mess,'(A,I0,A)')  &
      'Version 1 files must not have more than 2147483647 entries (got ',lsize,')'
    call classic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  if (fdesc%gex.eq.10) then
    ! Linear growth. Compute 'lex1' from 'lsize'. 'lex1' is the length of
    ! 1st (and all for linear growth) extension. Use up-rounding so that
    ! the index can hold at least 'lsize' entries.
    ! Desired number of entries per extension (up-rounded):
    lex1_e = (lsize-1)/fdesc%mex+1
    ! Desired number of records per extension (up-rounded):
    lex1_r = (lex1_e*fdesc%lind+fdesc%reclen-1)/fdesc%reclen
    ! NB: there can be a non-integer number of entry index per record
  else
    ! Exponential growth. There is currently no way to add a scaling factor:
    ! use the minimum possible i.e. 1 record fully devoted to the Index
    lex1_r = 1
  endif
  !  Compute number of entries in first extension. When creating new files,
  ! the libclassic uses at best the records devoted to the first extension
  ! index, for V1 and for V2.
  !  NB: other applications writing Classic files may not do this, so
  ! we can not assume this at re-read time.
  fdesc%lex1 = (lex1_r*fdesc%reclen)/fdesc%lind  ! Integer division
  !
end subroutine filedesc_init_lex1
!
subroutine filedesc_incr(lun,fdesc,full,error)
  use gbl_message
  use classic_interfaces, except_this=>filedesc_incr
  use classic_types
  use classic_vars
  !---------------------------------------------------------------------
  ! @ private
  ! Increment the File Descriptor, i.e. add 1 new extension
  !---------------------------------------------------------------------
  integer(kind=4),          intent(in)    :: lun    ! File logical unit
  type(classic_filedesc_t), intent(inout) :: fdesc  ! File Descriptor
  logical,                  intent(out)   :: full   ! Is the index full?
  logical,                  intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='FILEDESC'
  character(len=message_length) :: mess
  integer(kind=4) :: abuf(fdesc%reclen)  ! Automatic array. 'reclen' words = 1 record
  integer(kind=4) :: ier
  integer(kind=8) :: kbl,irec,nrec,nent
  !
  full = fdesc%nex.eq.fdesc%mex
  if (full) then
    ! All the 'mex' extensions have been filled
    write (mess,'(a,i0,a)')  &
      'File is full (index exhausted: ',fdesc%mex,' extensions filled)'
    call classic_message(seve%e,rname,mess)
    write (mess,'(a,i0,a)')  &
      'Attempt to write more than ',fdesc%lexn(fdesc%nex),' entries in file'
    call classic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  fdesc%nex            = fdesc%nex+1  ! One more extension
  if (fdesc%nextword.ne.1) then
    ! Extensions always start at the beginning of a record
    fdesc%nextrec = fdesc%nextrec+1
    fdesc%nextword = 1
  endif
  fdesc%aex(fdesc%nex) = fdesc%nextrec   ! Address of the new extension
  if (fdesc%gex.eq.10) then
    ! Linear case
    nent = fdesc%lex1
  elseif (fdesc%gex.eq.20) then
    ! Exponential case. Only growth with mantissa 2.0 is supported
    nent = int(fdesc%lex1,kind=8) * 2_8**(fdesc%nex-1)
  else
    call classic_message(seve%e,rname,  &
      'Only growth modes gex==10 and gex==20 are supported')
    error = .true.
    return
  endif
  nrec = (nent*fdesc%lind-1)/fdesc%reclen+1  ! Number of records devoted to the
                                             ! Entry Indexes in this new extension
  fdesc%lexn(fdesc%nex) = fdesc%lexn(fdesc%nex-1) + nent
  !
  ! Fill Entry Indexes of the new extension with 0
  abuf(:) = 0
  !
  write(mess,'(4(A,I0),A)')  &
    'Expand Index to ',fdesc%nex,' at record ',fdesc%nextrec,', ',  &
    nent,' new Entry Indexes in index, ',nrec,' records'
  call classic_message(seve%d,rname,mess)
  !
  do irec=1,nrec
    kbl = fdesc%aex(fdesc%nex)+irec-1
    write(lun,rec=kbl,iostat=ier) abuf
    if (ier.ne.0) then
      write(mess,'(A,I0)') 'Write error record #',kbl
      call classic_message(seve%e,rname,mess)
      call classic_iostat(seve%e,rname,ier)
      error = .true.
      exit
    endif
  enddo
  !
  if (error) then
    ! Try to recover from error
    fdesc%aex(fdesc%nex) = 0
    fdesc%nex = fdesc%nex-1
  else
    fdesc%nextrec = fdesc%nextrec+nrec  ! Next available record after operation
    fdesc%nextword = 1
  endif
  !
end subroutine filedesc_incr
!
subroutine classic_filedesc_open(file,error)
  use gbl_message
  use classic_interfaces, except_this=>classic_filedesc_open
  use classic_types
  use classic_vars
  !---------------------------------------------------------------------
  ! @ public
  ! Open and read the File Descriptor, namely:
  ! - Get the File Code and set the File-Data-Type-to-System-Data-Type
  !   conversion code,
  ! - Read the File Descriptor from the file, and take care of the
  !   possible conversion.
  ! Fortran-open the file itself if needed.
  !---------------------------------------------------------------------
  type(classic_file_t), intent(inout) :: file   !
  logical,              intent(out)   :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='FILE'
  integer(kind=4) :: ier
  logical :: lpdp11
  !
  error = .false.
  !
  read(file%lun,rec=1,iostat=ier) file%desc%code  ! Read only one word from the record
  if (ier.ne.0) then
    call classic_message(seve%e,rname,'Read error record 1')
    call classic_iostat(seve%e,rname,ier)
    error = .true.
    return
  endif
  !
  ! Set up the conversion routines
  call classic_convcod(file%desc%code,file%desc%version,file%desc%single,  &
    lpdp11,file%conv%code,error)
  if (error)  return
  if (file%conv%code.lt.0) then
    call classic_message(seve%e,rname,'Non-standard file')
    error = .true.
    return
  endif
  if (lpdp11) then
     call classic_message(seve%e,rname,'Old PDP 11 format not supported')
     error = .true.
     return
  endif
  call classic_conv(file%conv,error)
  if (error)  return
  !
  call classic_filedesc_read(file,error)
  if (error)  return
  !
end subroutine classic_filedesc_open
!
subroutine classic_filedesc_read(file,error)
  use gbl_message
  use gkernel_interfaces
  use classic_interfaces, except_this=>classic_filedesc_read
  use classic_types
  use classic_vars
  !---------------------------------------------------------------------
  ! @ public
  !   Read the File Descriptor from the file, and take care of the
  ! possible conversion. The file itself must have been opened before.
  ! The conversion code is not reevaluated.
  !   It may be useful to re-read a File Descriptor because another
  ! program might have updated it since last classic_filedesc_open or
  ! classic_filedesc_read.
  !---------------------------------------------------------------------
  type(classic_file_t), intent(inout) :: file   !
  logical,              intent(inout) :: error  ! Logical error flag
  ! Local
  integer(kind=4) :: ier
  integer(kind=8) :: descsize,filesize
  character(len=message_length) :: mess
  !
  if (file%desc%version.eq.1) then
    call filedesc_read_v1(file,error)
  else
    call filedesc_read_v2(file,error)
  endif
  !
  descsize = classic_file_size(file)
  ier = gag_filsize(file%spec,filesize)
  if (ier.ne.0)  return  ! Could not retrieve the file size on disk...
  !
  if (filesize.lt.descsize) then
    write(mess,'(3A,I0,A,I0,A)')  'File ',trim(file%spec),  &
      ' has wrong size (expected ',descsize,' bytes, found ',filesize,')'
    call classic_message(seve%w,'FILE',mess)
  endif
  !
end subroutine classic_filedesc_read
!
subroutine filedesc_read_v1(file,error)
  use gildas_def
  use gbl_message
  use gkernel_interfaces
  use classic_interfaces, except_this=>filedesc_read_v1
  use classic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Read the File Descriptor from the file, version 1 + conversion to
  ! structure in memory, version 2
  !---------------------------------------------------------------------
  type(classic_file_t), intent(inout) :: file   !
  logical,              intent(out)   :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='FILE'
  integer(kind=4) :: abuf(classic_reclen_v1)  ! Automatic array
  integer(kind=4) :: ier
  type(filedesc_v1_t) :: fdesc
#if !defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
  integer(kind=address_length) :: adi4
  integer(kind=1) :: membyt(8)
  !
  adi4 = bytpnt(file%conv%read%i4,membyt)
#endif
  !
  error = .false.
  !
  ! Record 1: fdesc%code, fdesc%next, fdesc%lex, fdesc%nex, fdesc%xnext, fdesc%aex(1:reclen-5)
  read(file%lun,rec=1,iostat=ier) abuf
  if (ier.ne.0) then
    call classic_message(seve%e,rname,'Read error record #1')
    call classic_iostat(seve%e,rname,ier)
    error = .true.
    return
  endif
  ! 1: fdesc%code (no conversion)
  fdesc%code = abuf(1)  ! File code bytes, in the File Data Type
  ! 2: fdesc%next, fdesc%lex, fdesc%nex, fdesc%xnext, fdesc%aex(1:reclen-5) (converted)
#if defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
  call file%conv%read%i4(abuf(2),fdesc%next,classic_reclen_v1-1)
#else
  call convert_buf(membyt(adi4),abuf(2),fdesc%next,classic_reclen_v1-1)
#endif
  !
  ! Record 2: fdesc%aex(:)  (continued)
  read(file%lun,rec=2,iostat=ier) abuf
  if (ier.ne.0) then
    call classic_message(seve%e,rname,'Read error record #2')
    call classic_iostat(seve%e,rname,ier)
    error = .true.
    return
  endif
#if defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
  call file%conv%read%i4(abuf,fdesc%aex(classic_reclen_v1-4),classic_reclen_v1)
#else
  call convert_buf(membyt(adi4),abuf,fdesc%aex(classic_reclen_v1-4),classic_reclen_v1)
#endif
  !
  ! Fill the V2 memory structure
  call filedesc_v1tov2(fdesc,file%desc,error)
  if (error)  return
  !
end subroutine filedesc_read_v1
!
subroutine filedesc_v1tov2(fdesc1,fdesc2,error)
  use classic_interfaces, except_this=>filedesc_v1tov2
  use classic_params
  use classic_types
  use classic_vars
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(filedesc_v1_t),      intent(in)    :: fdesc1  !
  type(classic_filedesc_t), intent(inout) :: fdesc2  ! INOUT because of allocatable AEX(:)
  logical,                  intent(inout) :: error   !
  ! Local
  integer(kind=4) :: iex
  !
  fdesc2%version  = 1
  fdesc2%code     = fdesc1%code
  fdesc2%reclen   = classic_reclen_v1
  fdesc2%kind     = classic_kind_unknown
  fdesc2%vind     = classic_vind_v1
  fdesc2%lind     = classic_lind_v1
  ! fdesc2%single = should come from the code above (on return of
  !   'classic_convcod'). Assume UNCHANGED (inout).
  fdesc2%flags    = 0        ! Set the 32 bits to 0
  if (fdesc2%single)  fdesc2%flags = ibset(fdesc2%flags,0)  ! Set 1st bit
  fdesc2%xnext    = fdesc1%xnext
  fdesc2%nextrec  = fdesc1%next
  fdesc2%nextword = 1
  fdesc2%lex1     = fdesc1%lex  ! in number of entries
  fdesc2%nex      = fdesc1%nex
  fdesc2%gex      = 10  ! Linear growth
  !
  call reallocate_aex(fdesc2,mex_v1,error)
  if (error)  return
  fdesc2%aex(:)  = fdesc1%aex(:)
  !
  ! Version 1 uses Extensions of same size (linear growth)
  fdesc2%lexn(0) = 0
  do iex=1,fdesc1%nex
    fdesc2%lexn(iex) = fdesc2%lexn(iex-1) + fdesc2%lex1
  enddo
  !
end subroutine filedesc_v1tov2
!
subroutine filedesc_read_v2(file,error)
  use gildas_def
  use gbl_format
  use gbl_message
  use gkernel_interfaces
  use classic_interfaces, except_this=>filedesc_read_v2
  use classic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Read the File Descriptor from the file, version 2
  !---------------------------------------------------------------------
  type(classic_file_t), intent(inout) :: file   !
  logical,              intent(out)   :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='FILE'
  integer(kind=4), allocatable :: abuf(:)
  integer(kind=4) :: ier,iex,mex,code,reclen
  integer(kind=8) :: nent
#if !defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
  integer(kind=address_length) :: adi4,adi8
  integer(kind=1) :: membyt(8)
  !
  adi4 = bytpnt(file%conv%read%i4,membyt)
  adi8 = bytpnt(file%conv%read%i8,membyt)
#endif
  !
  error = .false.
  !
  ! Read the 2 first words in 1st record
  read(file%lun,rec=1,iostat=ier) code,reclen
  if (ier.ne.0) then
    call classic_message(seve%e,rname,'Read error record #1 (1)')
    call classic_iostat(seve%e,rname,ier)
    error = .true.
    return
  endif
  !
  ! code (no conversion)
  file%desc%code = code  ! File code bytes, in the File Data Type
  ! reclen
#if defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
  call file%conv%read%i4(reclen,file%desc%reclen,1)
#else
  call convert_buf(membyt(adi4),reclen,file%desc%reclen,1)
#endif
  !
  ! Check if the file is opened with correct record length
  inquire(unit=file%lun,recl=reclen,iostat=ier)
  if (ier.ne.0) then
    call classic_message(seve%e,rname,'File access error')
    call classic_iostat(seve%e,rname,ier)
    error = .true.
    return
  endif
  if (reclen.ne.facunf*file%desc%reclen) then
    ! Reopen the file with correct record length
    call classic_file_fclose(file,error)
    if (error)  return
    call classic_file_fopen(file,'OLD',error)
    if (error)  return
  endif
  !
  allocate(abuf(file%desc%reclen),stat=ier)
  if (ier.ne.0) then
    call classic_message(seve%e,rname,'Error allocating buffer')
    error = .true.
    return
  endif
  !
  ! Now read all the first record
  read(file%lun,rec=1,iostat=ier) abuf
  if (ier.ne.0) then
    call classic_message(seve%e,rname,'Read error record #1 (2)')
    call classic_iostat(seve%e,rname,ier)
    error = .true.
    goto 99
  endif
  !
#if defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
  call file%conv%read%i4(abuf(3), file%desc%kind,    1)
  call file%conv%read%i4(abuf(4), file%desc%vind,    1)
  call file%conv%read%i4(abuf(5), file%desc%lind,    1)
  call file%conv%read%i4(abuf(6), file%desc%flags,   1)
  call file%conv%read%i8(abuf(7), file%desc%xnext,   1)
  call file%conv%read%i8(abuf(9), file%desc%nextrec, 1)
  call file%conv%read%i4(abuf(11),file%desc%nextword,1)
  call file%conv%read%i4(abuf(12),file%desc%lex1,    1)
  call file%conv%read%i4(abuf(13),file%desc%nex,     1)
  call file%conv%read%i4(abuf(14),file%desc%gex,     1)
#else
  call convert_buf(membyt(adi4),abuf(3), file%desc%kind,    1)
  call convert_buf(membyt(adi4),abuf(4), file%desc%vind,    1)
  call convert_buf(membyt(adi4),abuf(5), file%desc%lind,    1)
  call convert_buf(membyt(adi4),abuf(6), file%desc%flags,   1)
  call convert_buf(membyt(adi8),abuf(7), file%desc%xnext,   1)
  call convert_buf(membyt(adi8),abuf(9), file%desc%nextrec, 1)
  call convert_buf(membyt(adi4),abuf(11),file%desc%nextword,1)
  call convert_buf(membyt(adi4),abuf(12),file%desc%lex1,    1)
  call convert_buf(membyt(adi4),abuf(13),file%desc%nex,     1)
  call convert_buf(membyt(adi4),abuf(14),file%desc%gex,     1)
#endif
  ! Flags:
  file%desc%single = btest(file%desc%flags,0)  ! Test 1st bit
  !
  mex = (file%desc%reclen-filedescv2_nw1)/2
  call reallocate_aex(file%desc,mex,error)
  if (error)  goto 99
  !
  ! Read extension addresses
#if defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
  call file%conv%read%i8(abuf(filedescv2_nw1+1),file%desc%aex(1),mex)
#else
  call convert_buf(membyt(adi8),abuf(filedescv2_nw1+1),file%desc%aex(1),mex)
#endif
  !
  file%desc%lexn(0) = 0
  if (file%desc%gex.eq.10) then
    ! Linear growth
    do iex=1,file%desc%nex
      file%desc%lexn(iex) = file%desc%lexn(iex-1) + file%desc%lex1
    enddo
  else
    ! Exponential growth. Only growth with mantissa 2.0 is supported
    do iex=1,file%desc%nex
      nent = int(file%desc%lex1,kind=8) * 2_8**(iex-1)
      file%desc%lexn(iex) = file%desc%lexn(iex-1) + nent
    enddo
  endif
  !
99 continue
  deallocate(abuf)
  !
end subroutine filedesc_read_v2
!
subroutine classic_filedesc_write(file,error)
  use classic_interfaces, except_this=>classic_filedesc_write
  use classic_types
  use classic_vars
  !---------------------------------------------------------------------
  ! @ public
  ! Write the File Descriptor to the file.
  ! The file itself must have been opened before
  !---------------------------------------------------------------------
  type(classic_file_t), intent(in)    :: file   !
  logical,              intent(inout) :: error  ! Logical error flag
  !
  if (file%desc%version.eq.1) then
    call filedesc_write_v1(file,error)
  else
    call filedesc_write_v2(file,error)
  endif
  !
end subroutine classic_filedesc_write
!
subroutine filedesc_write_v1(file,error)
  use gildas_def
  use gbl_format
  use gbl_message
  use gkernel_interfaces
  use classic_interfaces, except_this=>filedesc_write_v1
  use classic_types
  !---------------------------------------------------------------------
  ! @ private
  ! Write the File Descriptor to the file, version 1.
  !---------------------------------------------------------------------
  type(classic_file_t), intent(in)    :: file   !
  logical,              intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='FILE'
  integer(kind=4) :: abuf(classic_reclen_v1)  ! Automatic array
  integer(kind=4) :: ier
  type(filedesc_v1_t) :: fdesc
#if !defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
  integer(kind=address_length) :: adi4
  integer(kind=1) :: membyt(8)
  !
  adi4 = bytpnt(file%conv%writ%i4,membyt)
#endif
  !
  call filedesc_v2tov1(file%desc,fdesc,error)
  if (error)  return
  !
  ! Record 1: fdesc%code, fdesc%next, fdesc%lex, fdesc%nex, fdesc%xnext, fdesc%aex(1:reclen-5)
  abuf(1) = fdesc%code
#if defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
  call file%conv%writ%i4(fdesc%next,abuf(2),classic_reclen_v1-1)
#else
  call convert_buf(membyt(adi4),fdesc%next,abuf(2),classic_reclen_v1-1)
#endif
  write(file%lun,rec=1,iostat=ier) abuf
  if (ier.ne.0) then
    call classic_message(seve%e,rname,'Write error record #1')
    call classic_iostat(seve%e,rname,ier)
    error = .true.
    return
  endif
  !
  ! Record 2: fdesc%aex(:)  (continued)
#if defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
  call file%conv%writ%i4(fdesc%aex(classic_reclen_v1-4),abuf,classic_reclen_v1)
#else
  call convert_buf(membyt(adi4),fdesc%aex(classic_reclen_v1-4),abuf,classic_reclen_v1)
#endif
  write(file%lun,rec=2,iostat=ier) abuf
  if (ier.ne.0) then
    call classic_message(seve%e,rname,'Write error record #2')
    call classic_iostat(seve%e,rname,ier)
    error = .true.
    return
  endif
  !
end subroutine filedesc_write_v1
!
subroutine filedesc_v2tov1(fdesc2,fdesc1,error)
  use gbl_message
  use classic_interfaces, except_this=>filedesc_v2tov1
  use classic_types
  use classic_vars
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(classic_filedesc_t), intent(in)    :: fdesc2  !
  type(filedesc_v1_t),      intent(out)   :: fdesc1  !
  logical,                  intent(inout) :: error   !
  ! Local
  character(len=*), parameter :: rname='V2TOV1'
  character(len=message_length) :: mess
  integer(kind=8) :: nperrec
  !
  if (fdesc2%version.ne.1) then
    call classic_message(seve%e,rname,  &
      'Internal error: attempt to write version 2 to a V1 file')
    error = .true.
    return
  endif
  !
  fdesc1%code = fdesc2%code
  call i8toi4_fini(fdesc2%nextrec,fdesc1%next,1,error)
  if (error)  return
  if (fdesc2%nextword.ne.1) then
    write(mess,'(A,I0,A)')  &
      'Internal error: next available word should be 1 for V1 file (got ',fdesc2%nextword,')'
    call classic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  nperrec = fdesc2%reclen/fdesc2%lind  ! Integer division
  fdesc1%lex  = fdesc2%lex1
  fdesc1%nex  = fdesc2%nex
  call i8toi4_fini(fdesc2%xnext,fdesc1%xnext,1,error)
  if (error)  return
  !
  if (fdesc2%nex.gt.mex_v1) then
    call classic_message(seve%e,rname,'Too many extensions')
    error = .true.
    return
  endif
  fdesc1%aex(1:fdesc2%nex) = fdesc2%aex(1:fdesc2%nex)
  fdesc1%aex(fdesc2%nex+1:mex_v1) = 0
  !
end subroutine filedesc_v2tov1
!
subroutine filedesc_write_v2(file,error)
  use gildas_def
  use gbl_format
  use gbl_message
  use gkernel_interfaces
  use classic_interfaces, except_this=>filedesc_write_v2
  use classic_types
  !---------------------------------------------------------------------
  ! @ private
  ! Write the File Descriptor to the file, version 2.
  !---------------------------------------------------------------------
  type(classic_file_t), intent(in)    :: file   !
  logical,              intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='FILE'
  integer(kind=4) :: abuf(file%desc%reclen)  ! Automatic array. 'reclen' words = 1 record
  integer(kind=4) :: ier,mex
#if !defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
  integer(kind=address_length) :: adi4,adi8
  integer(kind=1) :: membyt(8)
  !
  adi4 = bytpnt(file%conv%writ%i4,membyt)
  adi8 = bytpnt(file%conv%writ%i8,membyt)
#endif
  !
  mex = (file%desc%reclen-filedescv2_nw1)/2
  !
  abuf(1) = file%desc%code  ! File code, no conversion
  !
#if defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
  call file%conv%writ%i4(file%desc%reclen,  abuf(2), 1)
  call file%conv%writ%i4(file%desc%kind,    abuf(3), 1)
  call file%conv%writ%i4(file%desc%vind,    abuf(4), 1)
  call file%conv%writ%i4(file%desc%lind,    abuf(5), 1)
  call file%conv%writ%i4(file%desc%flags,   abuf(6), 1)
  call file%conv%writ%i8(file%desc%xnext,   abuf(7), 1)
  call file%conv%writ%i8(file%desc%nextrec, abuf(9), 1)
  call file%conv%writ%i4(file%desc%nextword,abuf(11),1)
  call file%conv%writ%i4(file%desc%lex1,    abuf(12),1)
  call file%conv%writ%i4(file%desc%nex,     abuf(13),1)
  call file%conv%writ%i4(file%desc%gex,     abuf(14),1)
  call file%conv%writ%i8(file%desc%aex(1),  abuf(filedescv2_nw1+1),mex)
#else
  call convert_buf(membyt(adi4),file%desc%reclen,  abuf(2), 1)
  call convert_buf(membyt(adi4),file%desc%kind,    abuf(3), 1)
  call convert_buf(membyt(adi4),file%desc%vind,    abuf(4), 1)
  call convert_buf(membyt(adi4),file%desc%lind,    abuf(5), 1)
  call convert_buf(membyt(adi4),file%desc%flags,   abuf(6), 1)
  call convert_buf(membyt(adi8),file%desc%xnext,   abuf(7), 1)
  call convert_buf(membyt(adi8),file%desc%nextrec, abuf(9), 1)
  call convert_buf(membyt(adi4),file%desc%nextword,abuf(11),1)
  call convert_buf(membyt(adi4),file%desc%lex1,    abuf(12),1)
  call convert_buf(membyt(adi4),file%desc%nex,     abuf(13),1)
  call convert_buf(membyt(adi4),file%desc%gex,     abuf(14),1)
  call convert_buf(membyt(adi8),file%desc%aex(1),  abuf(filedescv2_nw1+1),mex)
#endif
  !
  write(file%lun,rec=1,iostat=ier) abuf
  if (ier.ne.0) then
    call classic_message(seve%e,rname,'Write error record #1')
    call classic_iostat(seve%e,rname,ier)
    error = .true.
    return
  endif
  !
end subroutine filedesc_write_v2
!
subroutine filedesc_update(buf,nword,fdesc,error)
  use classic_interfaces, except_this=>filedesc_update
  use classic_params
  use classic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Update the file descriptor (nextrec, nextword) after a buffer has
  ! been written.
  !---------------------------------------------------------------------
  type(classic_recordbuf_t), intent(in)    :: buf    !
  integer(kind=data_length), intent(in)    :: nword  !
  type(classic_filedesc_t),  intent(inout) :: fdesc  !
  logical,                   intent(inout) :: error  ! Logical error flag
  ! Local
  integer(kind=8) :: newrec
  integer(kind=4) :: newword
  !
  ! Compute next rec and word after the buffer
  newrec  = buf%rstart+(buf%wstart-1+nword)/buf%len
  newword = mod(buf%wstart+nword-1,buf%len)+1
  !
  if (newrec.gt.fdesc%nextrec) then
    ! Buffer was used to write beyond the last used record
    fdesc%nextrec = newrec
    fdesc%nextword = newword
  elseif (newrec.eq.fdesc%nextrec) then
    ! Buffer was used to write in the last used record
    ! fdesc%nextrec = unchanged
    fdesc%nextword = max(fdesc%nextword,newword)
  else
    ! Buffer was used to write in records already used. No update needed.
  endif
  !
end subroutine filedesc_update
!
subroutine classic_filedesc_dump(fdesc,name)
  use gbl_message
  use classic_interfaces, except_this=>classic_filedesc_dump
  use classic_params
  use classic_types
  !---------------------------------------------------------------------
  ! @ public
  ! Dump the content of the File Descriptor
  !---------------------------------------------------------------------
  type(classic_filedesc_t), intent(in) :: fdesc  ! The File Descriptor
  character(len=*),         intent(in) :: name   ! The File Descriptor name (some prefix)
  ! Local
  character(len=*), parameter :: rname='DUMP'
  character(len=4) :: cfile
  character(len=12) :: ckind
  character(len=message_length) :: mess
  integer(kind=4) :: i,j
  !
  call bytoch(fdesc%code,cfile,4)
  select case (fdesc%kind)
  case (classic_kind_demo)
    ckind = 'DEMO'
  case (classic_kind_class)
    ckind = 'CLASS'
  case (classic_kind_clic)
    ckind = 'CLIC'
  case (classic_kind_mrtcal)
    ckind = 'MRTCAL'
  case default
    ckind = 'UNKNOWN'
  end select
  !
  write(mess,'(1X,(A,I0,A),2(A,I0,A,A,A))')  &
    name//'version = ',fdesc%version,', ',               &
    name//'code = ',   fdesc%code,' (''',cfile,'''), ',  &
    name//'kind = ',   fdesc%kind,' (',trim(ckind),')'
  call classic_message(seve%r,rname,mess)
  write(mess,'(1X,3(A,I0,A),(A,L,A),2(A,I0,A))')  &
    name//'reclen = ', fdesc%reclen, ', ',  &
    name//'vind = ',   fdesc%vind,   ', ',  &
    name//'lind = ',   fdesc%lind,   ', ',  &
    name//'single = ', fdesc%single, ', ',  &
    name//'xnext = ',  fdesc%xnext,  ', ',  &
    name//'nextrec = ',fdesc%nextrec
  call classic_message(seve%r,rname,mess)
  write(mess,'(1X,5(A,I0,A))')  &
    name//'nextword = ', fdesc%nextword, ', ',  &
    name//'lex1 = ',     fdesc%lex1,     ', ',  &
    name//'nex = ',      fdesc%nex,      ', ',  &
    name//'mex = ',      fdesc%mex,      ', ',  &
    name//'gex = ',      fdesc%gex
  call classic_message(seve%r,rname,mess)
  !
  write(mess,*) name//'aex(:) ='
  call classic_message(seve%r,rname,mess)
  do j=1,fdesc%nex/6
    write(mess,'(5X,6(I0,1X))') (fdesc%aex((j-1)*6+i),i=1,6)
    call classic_message(seve%r,rname,mess)
  enddo
  write(mess,'(5X,6(I0,1X))') (fdesc%aex(i),i=(fdesc%nex/6)*6+1,fdesc%nex)
  call classic_message(seve%r,rname,mess)
  !
  write(mess,*) name//'lexN(:) ='
  call classic_message(seve%r,rname,mess)
  do j=1,fdesc%nex/6
    write(mess,'(5X,6(I0,1X))') (fdesc%lexn((j-1)*6+i),i=1,6)
    call classic_message(seve%r,rname,mess)
  enddo
  write(mess,'(5X,6(I0,1X))') (fdesc%lexn(i),i=(fdesc%nex/6)*6+1,fdesc%nex)
  call classic_message(seve%r,rname,mess)
  !
end subroutine classic_filedesc_dump
!
#if !defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
subroutine convert_buf(conv,din,dout,n)
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Call the input conversion routine on the elements given. Generic
  ! subroutine which can be called for both reading and writing.
  !---------------------------------------------------------------------
  interface
    subroutine conv(din,dout,n)  ! The conversion routine
    integer         :: din
    integer         :: dout
    integer(kind=4) :: n
    end subroutine conv
  end interface
  integer         :: din   ! Data in (dummy kind)
  integer         :: dout  ! Data out (dummy kind)
  integer(kind=4) :: n     ! Number of elements to be copied (words)
  call conv(din,dout,n)
end subroutine convert_buf
!
subroutine convert_chtow4(conv,din,dout,n)
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Call the input conversion routine on the elements given. Generic
  ! subroutine which can be called for both reading and writing.
  !---
  ! Ad-hoc subroutine when input is a character string. Must be used
  ! when we do not assume the memory design of the character strings.
  !---------------------------------------------------------------------
  interface
    subroutine conv(din,dout,n)  ! The conversion routine
    character(len=*) :: din
    integer          :: dout
    integer(kind=4)  :: n
    end subroutine conv
  end interface
  character(len=*) :: din   ! Data in
  integer          :: dout  ! Data out (dummy kind)
  integer(kind=4)  :: n     ! Number of elements to be copied (words)
  call conv(din,dout,n)
end subroutine convert_chtow4
!
subroutine convert_w4toch(conv,din,dout,n)
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Call the input conversion routine on the elements given. Generic
  ! subroutine which can be called for both reading and writing.
  !---
  ! Ad-hoc subroutine when output is a character string. Must be used
  ! when we do not assume the memory design of the character strings.
  !---------------------------------------------------------------------
  interface
    subroutine conv(din,dout,n)  ! The conversion routine
    integer          :: din
    character(len=*) :: dout
    integer(kind=4)  :: n
    end subroutine conv
  end interface
  integer          :: din   ! Data in (dummy kind)
  character(len=*) :: dout  ! Data out
  integer(kind=4)  :: n     ! Number of elements to be copied (words)
  call conv(din,dout,n)
end subroutine convert_w4toch
#endif  /* FORTRAN2003_PP */
!
subroutine reallocate_recordbuf(buf,len,error)
  use gbl_message
  use classic_types
  use classic_interfaces, except_this=>reallocate_recordbuf
  !---------------------------------------------------------------------
  ! @ public
  !  Allocate or reallocate the input working buffer
  !---------------------------------------------------------------------
  type(classic_recordbuf_t), intent(inout) :: buf    !
  integer(kind=4),           intent(in)    :: len    ! New length required
  logical,                   intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='RECORDBUF'
  logical :: alloc
  integer(kind=4) :: ier
  !
  if (len.le.0) then
    call classic_message(seve%e,rname,'Internal error: negative record size!')
    error = .true.
    return
  endif
  !
  alloc = .false.
  if (allocated(buf%data)) then
    if (size(buf%data).ne.len) then
      deallocate(buf%data)
      alloc = .true.
    endif
  else
    alloc = .true.
  endif
  !
  if (alloc) then
    allocate(buf%data(len),stat=ier)
    if (ier.ne.0) then
      call classic_iostat(seve%e,rname,ier)
      error = .true.
      return
    endif
  endif
  !
  call classic_recordbuf_nullify(buf)
  buf%len = len
  buf%data(:) = 0
  !
end subroutine reallocate_recordbuf
!
subroutine deallocate_recordbuf(buf,error)
  use classic_types
  use classic_interfaces, except_this=>deallocate_recordbuf
  !---------------------------------------------------------------------
  ! @ public
  !  Deallocate the input working buffer
  !---------------------------------------------------------------------
  type(classic_recordbuf_t), intent(inout) :: buf    !
  logical,                   intent(inout) :: error  ! Logical error flag
  !
  call classic_recordbuf_nullify(buf)
  buf%len = 0
  if (allocated(buf%data))  deallocate(buf%data)
  !
end subroutine deallocate_recordbuf
!
subroutine reallocate_aex(fdesc,len,error)
  use gbl_message
  use classic_types
  use classic_interfaces, except_this=>reallocate_aex
  !---------------------------------------------------------------------
  ! @ private
  !  (Re)allocate the fdesc%aex(:) and fdesc%lexn(:) arrays
  !---------------------------------------------------------------------
  type(classic_filedesc_t), intent(inout) :: fdesc  !
  integer(kind=4),          intent(in)    :: len    ! New length required
  logical,                  intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='EXTENSIONS'
  integer(kind=4) :: ier,olen
  !
  if (len.le.0) then
    call classic_message(seve%e,rname,'Internal error: negative record size!')
    error = .true.
    return
  endif
  !
  if (allocated(fdesc%aex)) then
    olen = size(fdesc%aex)
    ! Array is already allocated
    if (olen.gt.len) then
      ! Arrays is too large. Shrink and lose its data
      deallocate(fdesc%aex,fdesc%lexn)
      allocate(fdesc%aex(len),fdesc%lexn(0:len),stat=ier)
      if (ier.ne.0)  goto 10
      fdesc%aex(:) = 0
      fdesc%lexn(:) = 0  ! lexn(0) = 0 is required
      !
    elseif (olen.eq.len) then
      ! Array has correct size, leave unchanged
      continue
      ! fdesc%aex(:) = 0
      ! fdesc%lexn(:) = 0
      !
    else
      ! Array is too small but we don't care about data
      deallocate(fdesc%aex,fdesc%lexn)
      allocate(fdesc%aex(len),fdesc%lexn(0:len),stat=ier)
      if (ier.ne.0)  goto 10
      fdesc%aex(:) = 0
      fdesc%lexn(:) = 0  ! lexn(0) = 0 is required
      !
    endif
  else
    ! No previous allocation
    allocate(fdesc%aex(len),fdesc%lexn(0:len),stat=ier)
    if (ier.ne.0)  goto 10
    fdesc%aex(:) = 0
    fdesc%lexn(:) = 0  ! lexn(0) = 0 is required
  endif
  !
  fdesc%mex = len
  !
  return
  !
  ! Error
10 continue
  error = .true.
  call classic_iostat(seve%e,rname,ier)
  !
end subroutine reallocate_aex
!
subroutine deallocate_aex(fdesc,error)
  use gbl_message
  use classic_types
  use classic_interfaces, except_this=>deallocate_aex
  !---------------------------------------------------------------------
  ! @ private
  !  Deallocate (if needed) the fdesc%aex(:) and fdesc%lexn(:) arrays
  !---------------------------------------------------------------------
  type(classic_filedesc_t), intent(inout) :: fdesc  !
  logical,                  intent(inout) :: error  !
  !
  if (allocated(fdesc%aex))   deallocate(fdesc%aex)
  if (allocated(fdesc%lexn))  deallocate(fdesc%lexn)
  !
end subroutine deallocate_aex
!
subroutine classic_file_loss(file,unused,error)
  use classic_interfaces, except_this=>classic_file_loss
  use classic_types
  use classic_vars
  !---------------------------------------------------------------------
  ! @ public
  ! Parse the input file and search for unused (lost) bytes
  !---------------------------------------------------------------------
  type(classic_file_t), intent(inout) :: file    !
  integer(kind=4),      intent(in)    :: unused  ! Number of unused bytes per Index
  logical,              intent(inout) :: error   !
  !
  if (file%desc%version.eq.1) then
    call classic_file_loss_v1(file,unused,error)
  else
    call classic_file_loss_v2(file,unused,error)
  endif
  !
end subroutine classic_file_loss
!
subroutine classic_file_loss_v1(file,unused,error)
  use gbl_message
  use gkernel_interfaces
  use gkernel_types
  use classic_interfaces, except_this=>classic_file_loss_v1
  use classic_params
  use classic_types
  !---------------------------------------------------------------------
  ! @ private
  ! Parse the input file and search for unused (lost) bytes
  !---------------------------------------------------------------------
  type(classic_file_t), intent(inout) :: file    !
  integer(kind=4),      intent(in)    :: unused  ! Number of unused bytes per Index
  logical,              intent(inout) :: error   !
  ! Local
  character(len=*), parameter :: rname='FILELOSS'
  character(len=message_length) :: mess
  integer(kind=entry_length) :: ient,nent
  integer(kind=8) :: nf1,ni1,ne1,no1,nt1, nf2,ni2,ne2,no2,nt2, edend,nrec
  type(classic_entrydesc_t) :: ed
  type(classic_recordbuf_t) :: bufobs,bufind
  type(indx_basic_v2_t) :: ind
  type(time_t) :: time
  integer(kind=4) :: databi(file%desc%lind)  ! Automatic array
  !
  ! 1) Losses in file descriptor
  call filedesc_read_v1(file,error)
  if (error)  return
  nf1 = 4*(file%desc%mex-file%desc%nex)
  nf2 = 4*2*file%desc%reclen
  !
  ! 2) Losses in File Index
  call classic_file_loss_index(file%desc,unused,ni1,ni2)
  !
  ! 3) Losses in entries
  call reallocate_recordbuf(bufobs,file%desc%reclen,error)
  if (error)  return
  call reallocate_recordbuf(bufind,file%desc%reclen,error)
  if (error)  return
  !
  call classic_recordbuf_nullify(bufind)
  call classic_recordbuf_nullify(bufobs)
  ne1 = 0
  ne2 = 0
  no1 = 0
  no2 = 0
  nent = file%desc%xnext-1
  !
  call gtime_init(time,nent,error)
  if (error)  return
  !
  do ient=1,nent
    if (sic_ctrlc()) then  ! NB: initialization must have been done once with trap_ctrlc
      call classic_message(seve%w,rname,'CTRL-C trapped, incomplete entries analysis')
      exit
    endif
    !
    call gtime_current(time)
    !
    ! Where is the Entry (address = record and starting word)? It is found in the
    ! Index (1st and 2nd word). Use our generic reading subroutine which can read
    ! this element (only). Use buffer 'bufind' to read the Index.
    call classic_entryindex_read(file,ient,databi,bufind,error)
    if (error)  goto 100
    !
    call indexaddr_frombuf_v1(databi,ind,file%conv,error)
    if (error)  goto 100
    !
    ! Initialize the obs reading buffer
    call classic_recordbuf_open(file,ind%rec,ind%word,bufobs,error)
    if (error)  goto 100
    !
    ! Now read the Entry Header.
    call entrydesc_read_v1(file,bufobs,ed,error)
    if (error)  goto 100
    !
    ! Words lost in Entry Descriptor (because of space allocated for 'msec'
    ! sections). Should make this test more robust: what if data comes before
    ! 1st section?
    if (ed%nsec.le.0) then
      ! No section present. Ok, why not.
      edend = ed%nword
    else
      edend = ed%secaddr(1)-1        ! End of Entry Descriptor
    endif
    ne1 = ne1 + edend-(entrydescv1_nw1-2+entrydescv1_nw2*ed%nsec)  ! 2 words unused in entrydescv1_nw1
    ne2 = ne2 + edend
    ! Unused words lost at end of last record
    nrec = (ed%nword-1)/classic_reclen_v1+1
    no1 = no1 + nrec*file%desc%reclen-ed%nword
    no2 = no2 + nrec*file%desc%reclen-edend
  enddo
  ne1 = 4*ne1  ! Bytes
  ne2 = 4*ne2
  no1 = 4*no1
  no2 = 4*no2
  !
  ! Total
  nt1 = nf1+ni1+ne1+no1
  nt2 = classic_file_size(file)
  !
  ! Messages
  call classic_message(seve%r,rname,'Unused bytes in:')
  write(mess,200)  '  File Descriptor: ',  nf1,nf2,1e2*nf1/nf2
  call classic_message(seve%r,rname,mess)
  write(mess,200)  '  File Index: ',       ni1,ni2,1e2*ni1/ni2
  call classic_message(seve%r,rname,mess)
  write(mess,200)  '  Entry Descriptors: ',ne1,ne2,1e2*ne1/ne2
  call classic_message(seve%r,rname,mess)
  write(mess,200)  '  Entries: ',          no1,no2,1e2*no1/no2
  call classic_message(seve%r,rname,mess)
  write(mess,200)  '  Total: ',            nt1,nt2,1d2*nt1/nt2
  call classic_message(seve%r,rname,mess)
  !
100 continue
  call deallocate_recordbuf(bufobs,error)
  call deallocate_recordbuf(bufind,error)
  if (error) then
    write(mess,'(A,I0)')  'Error reading entry #',ient
    call classic_message(seve%e,rname,mess)
  endif
  !
200 format(A,T25,I12,' / ',I12,T54,'(',F0.1,'%)')
end subroutine classic_file_loss_v1
!
subroutine classic_file_loss_v2(file,unused,error)
  use gbl_message
  use gkernel_interfaces
  use gkernel_types
  use classic_interfaces, except_this=>classic_file_loss_v2
  use classic_params
  use classic_types
  !---------------------------------------------------------------------
  ! @ private
  ! Parse the input file and search for unused (lost) bytes
  !---------------------------------------------------------------------
  type(classic_file_t), intent(inout) :: file    !
  integer(kind=4),      intent(in)    :: unused  ! Number of unused bytes per Index
  logical,              intent(inout) :: error   !
  ! Local
  character(len=*), parameter :: rname='FILELOSS'
  character(len=message_length) :: mess
  integer(kind=entry_length) :: ient,nent
  integer(kind=8) :: nf1,ni1,ne1,no1,nt1, nf2,ni2,ne2,no2,nt2, edend
  type(classic_entrydesc_t) :: ed
  type(classic_recordbuf_t) :: bufobs,bufind
  type(indx_basic_v2_t) :: ind
  type(time_t) :: time
  integer(kind=4) :: databi(file%desc%lind)  ! Automatic array
  !
  ! 1) Losses in file descriptor
  call filedesc_read_v2(file,error)
  if (error)  return
  nf1 = 8*(file%desc%mex-file%desc%nex)
  nf2 = 4*file%desc%reclen
  !
  ! 2) Losses in File Index
  call classic_file_loss_index(file%desc,unused,ni1,ni2)
  !
  ! 3) Losses in entries
  call reallocate_recordbuf(bufobs,file%desc%reclen,error)
  if (error)  return
  call reallocate_recordbuf(bufind,file%desc%reclen,error)
  if (error)  return
  !
  call classic_recordbuf_nullify(bufind)
  call classic_recordbuf_nullify(bufobs)
  ne1 = 0
  ne2 = 0
  no1 = 0
  no2 = 0
  nent = file%desc%xnext-1
  !
  call gtime_init(time,nent,error)
  if (error)  return
  !
  do ient=1,nent
    if (sic_ctrlc()) then  ! NB: initialization must have been done once with trap_ctrlc
      call classic_message(seve%w,rname,'CTRL-C trapped, incomplete entries analysis')
      exit
    endif
    !
    call gtime_current(time)
    !
    ! Where is the Entry (address = record and starting word)? It is found in the
    ! Index (1st and 2nd word). Use our generic reading subroutine which can read
    ! this element (only). Use buffer 'bufind' to read the Index.
    call classic_entryindex_read(file,ient,databi,bufind,error)
    if (error)  goto 100
    !
    call indexaddr_frombuf_v2(databi,ind,file%conv,error)
    if (error)  goto 100
    !
    ! Initialize the obs reading buffer
    call classic_recordbuf_open(file,ind%rec,ind%word,bufobs,error)
    if (error)  goto 100
    !
    ! Now read the Entry Header.
    call entrydesc_read_v2(file,bufobs,ed,error)
    if (error)  goto 100
    !
    ! Words lost in Entry Descriptor (because of space allocated for 'msec'
    ! sections). Should make this test more robust: what if data comes before
    ! 1st section?
    if (ed%nsec.le.0) then
      ! No section present. Ok, why not.
      edend = ed%nword
    else
      edend = ed%secaddr(1)-1        ! End of Entry Descriptor
    endif
    ne1 = ne1 + edend-(entrydescv2_nw1+entrydescv2_nw2*ed%nsec)
    ne2 = ne2 + edend
    ! Unused words lost at end of last record: none (in theory, but can we make
    ! sure of that)?
    ! no1 = no1 + 0
    no2 = no2 + ed%nword-edend
  enddo
  ne1 = 4*ne1  ! Bytes
  ne2 = 4*ne2
  no1 = 4*no1
  no2 = 4*no2
  !
  ! Total
  nt1 = nf1+ni1+ne1+no1
  nt2 = classic_file_size(file)
  !
  ! Messages
  call classic_message(seve%r,rname,'Unused bytes in:')
  write(mess,200)  '  File Descriptor: ',  nf1,nf2,1e2*nf1/nf2
  call classic_message(seve%r,rname,mess)
  write(mess,200)  '  File Index: ',       ni1,ni2,1e2*ni1/ni2
  call classic_message(seve%r,rname,mess)
  write(mess,200)  '  Entry Descriptors: ',ne1,ne2,1e2*ne1/ne2
  call classic_message(seve%r,rname,mess)
  write(mess,200)  '  Entries: ',          no1,no2,1e2*no1/no2
  call classic_message(seve%r,rname,mess)
  write(mess,200)  '  Total: ',            nt1,nt2,1d2*nt1/nt2
  call classic_message(seve%r,rname,mess)
  !
100 continue
  call deallocate_recordbuf(bufobs,error)
  call deallocate_recordbuf(bufind,error)
  if (error) then
    write(mess,'(A,I0)')  'Error reading entry #',ient
    call classic_message(seve%e,rname,mess)
  endif
  !
200 format(A,T24,I13,' / ',I13,T54,'(',F0.1,'%)')
end subroutine classic_file_loss_v2
!
subroutine classic_file_loss_index(fdesc,unused,nlost,ntot)
  use gbl_message
  use classic_params
  use classic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Compute the bytes lost in the File Index. This is a function of
  ! the Index growth, not of the File Version.
  !---------------------------------------------------------------------
  type(classic_filedesc_t), intent(in)    :: fdesc   ! The File Descriptor
  integer(kind=4),          intent(in)    :: unused  ! Number of unused bytes per Index
  integer(kind=8),          intent(out)   :: nlost   ! Number of bytes lost
  integer(kind=8),          intent(out)   :: ntot    ! Total number of bytes
  ! Local
  integer(kind=entry_length) :: maxent,nrec
  integer(kind=4) :: nentperrec
  !
  maxent = fdesc%lexn(fdesc%nex)  ! Total number of entries in the Index
  nentperrec = fdesc%reclen/fdesc%lind  ! Number of Entry Index per record (int division)
  nrec = maxent/nentperrec  ! Number of records devoted to the Index
  !
  ! Unused words in Entry Index:
  nlost = (fdesc%xnext-1)*unused
  ! + Unused Indexes in last extension
  nlost = nlost + (maxent-fdesc%xnext+1)*fdesc%lind
  ! + Unused bytes at end of records in the File Index
  nlost = nlost + (fdesc%reclen-nentperrec*fdesc%lind)*nrec
  !
  ntot = fdesc%reclen*nrec
  !
  nlost = 4*nlost  ! Convert words to bytes
  ntot  = 4*ntot
  !
end subroutine classic_file_loss_index
!
subroutine classic_file_copy(in,ou,error)
  use classic_types
  !---------------------------------------------------------------------
  ! @ public
  !  Copy the input classic_file_t into the output one, taking care
  ! of some special elements like pointers and allocatables.
  !---------------------------------------------------------------------
  type(classic_file_t), intent(in)    :: in     !
  type(classic_file_t), intent(inout) :: ou     !
  logical,              intent(inout) :: error  ! Logical error flag
  !
  ! First level elements
  ou%spec       = in%spec
  ou%nspec      = in%nspec
  ou%lun        = in%lun
  ou%readwrite  = in%readwrite
  ou%update     = in%update
  !
  ! File descriptor
  ou%desc%code     = in%desc%code
  ou%desc%reclen   = in%desc%reclen
  ou%desc%kind     = in%desc%kind
  ou%desc%vind     = in%desc%vind
  ou%desc%lind     = in%desc%lind
  ou%desc%flags    = in%desc%flags
  ou%desc%xnext    = in%desc%xnext
  ou%desc%nextrec  = in%desc%nextrec
  ou%desc%nextword = in%desc%nextword
  ou%desc%lex1     = in%desc%lex1
  ou%desc%nex      = in%desc%nex
  ou%desc%gex      = in%desc%gex
  ou%desc%version  = in%desc%version
  ou%desc%single   = in%desc%single
  ou%desc%mex      = in%desc%mex
  if (allocated(in%desc%aex)) then
    call reallocate_aex(ou%desc,in%desc%mex,error)
    if (error)  return
    ou%desc%aex(1:in%desc%mex)  = in%desc%aex(1:in%desc%mex)
    ou%desc%lexn(0:in%desc%mex) = in%desc%lexn(0:in%desc%mex)
  endif
  !
  ! File conversion
  ou%conv%code = in%conv%code
#if defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
  ! NB: a simple ou%conv = in%conv is probably enough
  ou%conv%read%i4 => in%conv%read%i4
  ou%conv%read%i8 => in%conv%read%i8
  ou%conv%read%r4 => in%conv%read%r4
  ou%conv%read%r8 => in%conv%read%r8
  ou%conv%read%cc => in%conv%read%cc
  ou%conv%writ%i4 => in%conv%writ%i4
  ou%conv%writ%i8 => in%conv%writ%i8
  ou%conv%writ%r4 => in%conv%writ%r4
  ou%conv%writ%r8 => in%conv%writ%r8
  ou%conv%writ%cc => in%conv%writ%cc
#else
  ou%conv%read%i4 = in%conv%read%i4
  ou%conv%read%i8 = in%conv%read%i8
  ou%conv%read%r4 = in%conv%read%r4
  ou%conv%read%r8 = in%conv%read%r8
  ou%conv%read%cc = in%conv%read%cc
  ou%conv%writ%i4 = in%conv%writ%i4
  ou%conv%writ%i8 = in%conv%writ%i8
  ou%conv%writ%r4 = in%conv%writ%r4
  ou%conv%writ%r8 = in%conv%writ%r8
  ou%conv%writ%cc = in%conv%writ%cc
#endif
  !
end subroutine classic_file_copy
!
function classic_file_size(file)
  use gildas_def
  use classic_types
  !---------------------------------------------------------------------
  ! @ public
  ! Return the file size (according to its descriptor) in bytes
  !---------------------------------------------------------------------
  integer(kind=size_length) :: classic_file_size
  type(classic_file_t), intent(in) :: file
  !
  if (file%desc%nextword.eq.1) then
    classic_file_size = 4*(file%desc%nextrec-1)*file%desc%reclen
  else
    classic_file_size = 4*file%desc%nextrec*file%desc%reclen
  endif
  !
end function classic_file_size
