!-----------------------------------------------------------------------
! Support file for the User Section.
!-----------------------------------------------------------------------
subroutine class_user_exists(obs,iuser)
  use classcore_interfaces, except_this=>class_user_exists
  use class_types
  !---------------------------------------------------------------------
  ! @ public
  !  Search the User subsection matching the current hooks known by
  ! Class. Return index 0 if no such subsection exists.
  !---------------------------------------------------------------------
  type(observation), intent(in)  :: obs
  integer(kind=4),   intent(out) :: iuser
  !
  if (obs%head%presec(class_sec_user_id)) then
    do iuser=1,obs%user%n
      if (user_sec_match(obs%user%sub(iuser)))  return
    enddo
  endif
  !
  ! We have not returned from the loop: no such subsection
  iuser = 0
  !
end subroutine class_user_exists
!
function user_sec_match(subsection)
  use class_user
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Return .true. if the input User Subsection matches the hooks
  ! known by Class
  !---------------------------------------------------------------------
  logical :: user_sec_match  ! Function value on return
  type(class_user_sub_t), intent(in) :: subsection  !
  !
  user_sec_match = cuserhooks.ne.0                                 .and.  &
                   subsection%owner.eq.userhooks(cuserhooks)%owner .and.  &
                   subsection%title.eq.userhooks(cuserhooks)%title
  !
end function user_sec_match
!
subroutine user_sec_owner(subsection,iowner,error)
  use class_types
  use class_user
  !---------------------------------------------------------------------
  ! @ private
  !  Loop in the list of known hooks to find the one matching the input
  ! User Subsection
  !---------------------------------------------------------------------
  type(class_user_sub_t), intent(in)    :: subsection  !
  integer(kind=4),        intent(out)   :: iowner      !
  logical,                intent(inout) :: error       !
  ! Local
  integer(kind=4) :: io
  !
  iowner = 0
  do io=1,muserhooks
    if (subsection%owner.eq.userhooks(io)%owner .and.  &
        subsection%title.eq.userhooks(io)%title) then
      iowner = io
    endif
  enddo
  !
end subroutine user_sec_owner
!
subroutine classcore_user_add(obs,sversion,sdata,error)
  use gildas_def
  use gbl_message
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>classcore_user_add
  use class_buffer
  use class_types
  use class_user
  !---------------------------------------------------------------------
  ! @ public (for libclass only)
  !   Add a User Section to the input observation. The caller has no
  ! control on the number of this new user section
  !---------------------------------------------------------------------
  type(observation), intent(inout) :: obs       ! Observation
  integer(kind=4),   intent(in)    :: sversion  ! Version value
  integer(kind=4),   intent(in)    :: sdata     ! The user data (do not use "as is")
  logical,           intent(inout) :: error     ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='CLASS_USER_ADD'
  integer :: ier,nuser,iuser
  !
  if (cuserhooks.eq.0) then
    call class_message(seve%e,rname,'User Section hooks are not defined')
    error = .true.
    return
  endif
  if (userhooks(cuserhooks)%owner.eq.'') then
    call class_message(seve%e,rname,'User Section owner is not defined')
    error = .true.
    return
  endif
  if (userhooks(cuserhooks)%title.eq.'') then
    call class_message(seve%e,rname,'User Section title is not defined')
    error = .true.
    return
  endif
  !
  ! First check if such a section already exist
  call class_user_exists(obs,iuser)
  if (iuser.ne.0) then
    call class_message(seve%e,rname,  &
      'Observation already contains a user section '//  &
      trim(userhooks(cuserhooks)%owner)//' '//userhooks(cuserhooks)%title)
    error = .true.
    return
  endif
  !
  nuser = obs%user%n+1
  call reallocate_user(obs%user,nuser,.true.,error)
  if (error)  return
  obs%user%n = nuser
  !
  obs%head%presec(class_sec_user_id) = .true.
  !
  obs%user%sub(nuser)%owner   = userhooks(cuserhooks)%owner
  obs%user%sub(nuser)%title   = userhooks(cuserhooks)%title
  obs%user%sub(nuser)%version = sversion
  !
  ! Transfer and align the user data into uwork
  unext = 1
  call userhooks(cuserhooks)%toclass(sdata,sversion,error)
  if (error) return
  if (unext.le.1) then
    call class_message(seve%e,rname,'User section length is null')
    error = .true.
    return
  endif
  !
  ! Save uwork in our structure
  obs%user%sub(nuser)%ndata = unext-1
  allocate(obs%user%sub(nuser)%data(unext-1),stat=ier)
  if (failed_allocate(rname,'OBS%SUB(NUSER)%DATA',ier,error))  return
  obs%user%sub(nuser)%data(1:unext-1) = uwork(1:unext-1)
  !
end subroutine classcore_user_add
!
subroutine reallocate_user(user,nuser,keep,error)
  use classcore_dependencies_interfaces
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  ! Allocates or reallocates the section user depending on the
  ! 'nuser' value. In case of reallocation, previous data is preserved.
  !---------------------------------------------------------------------
  type(class_user_t), intent(inout) :: user   !
  integer(kind=4),    intent(in)    :: nuser  ! Number of User Subsections needed
  logical,            intent(in)    :: keep   ! Keep the previous data when enlarging?
  logical,            intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='REALLOCATE_USER'
  integer :: ier,iuser
  type(class_user_sub_t), allocatable :: sub(:)
  !
  if (nuser.le.0)  return
  !
  if (.not.allocated(user%sub)) then
    allocate(user%sub(nuser),stat=ier)
    if (failed_allocate(rname,'USER%SUB',ier,error))  return
    do iuser=1,nuser
      user%sub(iuser)%data => null()
    enddo
    !
  elseif (nuser.gt.size(user%sub)) then
    if (keep) then
      allocate(sub(user%n),stat=ier)
      if (failed_allocate(rname,'SUB',ier,error))  return
      ! Make a copy
      do iuser=1,user%n
        sub(iuser)%owner   =  user%sub(iuser)%owner
        sub(iuser)%title   =  user%sub(iuser)%title
        sub(iuser)%version =  user%sub(iuser)%version
        sub(iuser)%ndata   =  user%sub(iuser)%ndata
        sub(iuser)%data    => user%sub(iuser)%data
      enddo
      ! Free the extra ones (if any)
      do iuser=user%n+1,size(user%sub)
        if (associated(user%sub(iuser)%data))  &
          deallocate(user%sub(iuser)%data)
      enddo
    else
      ! Free all
      do iuser=1,size(user%sub)
        if (associated(user%sub(iuser)%data))  &
          deallocate(user%sub(iuser)%data)
      enddo
    endif
    !
    ! Free
    deallocate(user%sub)
    ! Enlarge
    allocate(user%sub(nuser),stat=ier)
    if (failed_allocate(rname,'USER%SUB',ier,error))  return
    ! Initialize
    do iuser=1,nuser
      user%sub(iuser)%data => null()
    enddo
    !
    if (keep) then
      ! Copy back the values
      do iuser=1,user%n
        user%sub(iuser)%owner   =  sub(iuser)%owner
        user%sub(iuser)%title   =  sub(iuser)%title
        user%sub(iuser)%version =  sub(iuser)%version
        user%sub(iuser)%ndata   =  sub(iuser)%ndata
        user%sub(iuser)%data    => sub(iuser)%data
      enddo
      deallocate(sub)
    endif
  endif
  !
end subroutine reallocate_user
!
subroutine reallocate_user_sub(sub,error)
  use classcore_dependencies_interfaces
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Reallocate sub%data according to sub%ndata
  !---------------------------------------------------------------------
  type(class_user_sub_t), intent(inout) :: sub
  logical,                intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='REALLOCATE>USER>SUB'
  logical :: realloc
  integer(kind=4) :: ier
  !
  if (associated(sub%data)) then
    realloc = sub%ndata.gt.size(sub%data)
    if (realloc)  deallocate(sub%data)
  else
    realloc = .true.
  endif
  !
  if (realloc) then
    allocate(sub%data(sub%ndata),stat=ier)
    if (failed_allocate(rname,'SUB%DATA',ier,error))  return
  endif
  !
end subroutine reallocate_user_sub
!
subroutine newdat_user(set,obs,error)
  use gildas_def
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>newdat_user
  use class_buffer
  use class_types
  use class_user
  !---------------------------------------------------------------------
  ! @ public (for libclass only)
  ! Recompute the User Section related data, typically when a new
  ! observation is loaded.
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set
  type(observation),   intent(in)    :: obs
  logical,             intent(inout) :: error
  ! Local
  integer(kind=4) :: iuser
  logical :: done_ruser
  ! Data
  data done_ruser /.false./
  !
  if (.not.obs%is_R)  return
  !
  if (done_ruser) then
    ! Delete the previous instance
    call sic_delvariable('R%USER',.false.,error)
    error = .false.  ! Attempt to delete non-existent variables is not an error
    done_ruser = .false.  ! R%USER deleted
  endif
  !
  if (set%varpresec(class_sec_user_id).eq.setvar_off)  return  ! SET VAR USER OFF
  if (obs%user%n.eq.0)                                 return  ! No user section!
  if (cuserhooks.eq.0)                                 return  ! No current hooks defined!
  if (.not.associated(userhooks(cuserhooks)%setvar))   return  ! No SET VAR hook
  !
  ! Find which user subsection
  call class_user_exists(obs,iuser)
  if (iuser.eq.0)  return
  !
  ! Create the new instance
  call sic_defstructure('R%USER',.true.,error)
  call sic_defstructure('R%USER%'//userhooks(cuserhooks)%owner,.true.,error)
  if (error)  return
  !
  usub = iuser  ! The User Subsection number
  unext = 1     ! The offset in the 'r%user%sub(iuser)%data' array,
                ! for each variable
  call userhooks(cuserhooks)%setvar(obs%user%sub(iuser)%version,error)
  !
  done_ruser = .true.  ! R%USER created
  !
end subroutine newdat_user
!
subroutine rzero_user(obs)
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  ! Reset the User Section to default value
  !---------------------------------------------------------------------
  type(observation), intent(inout) :: obs  !
  !
  obs%user%n = 0
  !
  !  Do not deallocate obs%user%sub nor obs%user%sub(:)%data: we keep
  ! them allocated for later reuse.
  !
end subroutine rzero_user
!
subroutine copy_user(inuser,outuser,error)
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>copy_user
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  ! Copy the User Section from the input observation to the output one.
  ! User Section is enlarged if needed.
  !---------------------------------------------------------------------
  type(class_user_t), intent(in)    :: inuser   ! Input user section
  type(class_user_t), intent(inout) :: outuser  ! Output user section
  logical,            intent(inout) :: error    ! Logical error flag
  ! Local
  integer :: iuser,l,ier
  logical :: realloc
  !
  ! First allocate or enlarge the section (only if needed)
  call reallocate_user(outuser,inuser%n,.false.,error)
  if (error)  return
  !
  ! Then, copy the section
  outuser%n = inuser%n
  do iuser=1,inuser%n
    outuser%sub(iuser)%owner   = inuser%sub(iuser)%owner
    outuser%sub(iuser)%title   = inuser%sub(iuser)%title
    outuser%sub(iuser)%version = inuser%sub(iuser)%version
    outuser%sub(iuser)%ndata   = inuser%sub(iuser)%ndata
    !
    ! Then, the allocatable block of data
    l = outuser%sub(iuser)%ndata
    if (associated(outuser%sub(iuser)%data)) then
      realloc = size(outuser%sub(iuser)%data).lt.size(inuser%sub(iuser)%data)
      if (realloc) then
        deallocate(outuser%sub(iuser)%data,stat=ier)
        if (failed_allocate('COPY_USER','DATA (1)',ier,error))  return
      endif
    else
      realloc = .true.
    endif
    if (realloc) then
      allocate(outuser%sub(iuser)%data(l),stat=ier)
      if (failed_allocate('COPY_USER','DATA (2)',ier,error))  return
    endif
    !
    outuser%sub(iuser)%data(1:l) = inuser%sub(iuser)%data(1:l)
  enddo
  !
end subroutine copy_user
!
subroutine classcore_user_update(obs,sversion,sdata,error)
  use gildas_def
  use gbl_message
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>classcore_user_update
  use class_buffer
  use class_types
  use class_user
  !---------------------------------------------------------------------
  ! @ public  (for libclass only)
  !  Update the User Section in the input observation. The caller has no
  ! control on the number of this new user section
  !---------------------------------------------------------------------
  type(observation), intent(inout) :: obs       ! Observation
  integer(kind=4),   intent(in)    :: sversion  ! Version value
  integer(kind=4),   intent(in)    :: sdata     ! The user data (do not use "as is")
  logical,           intent(inout) :: error     ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='CLASS_USER_UPDATE'
  integer :: ier,snum
  !
  if (cuserhooks.eq.0) then
    call class_message(seve%e,rname,'User Section hooks are not defined')
    error = .true.
    return
  endif
  if (userhooks(cuserhooks)%owner.eq.'') then
    call class_message(seve%e,rname,'User Section owner is not defined')
    error = .true.
    return
  endif
  if (userhooks(cuserhooks)%title.eq.'') then
    call class_message(seve%e,rname,'User Section title is not defined')
    error = .true.
    return
  endif
  !
  ! First check if such a section already exist
  call class_user_exists(obs,snum)
  if (snum.eq.0) then
    call class_message(seve%e,rname,  &
      'Observation has no such section '//  &
      trim(userhooks(cuserhooks)%owner)//' '//userhooks(cuserhooks)%title)
    error = .true.
    return
  endif
  !
  ! obs%user%sub(snum)%owner   = userhooks(cuserhooks)%owner  ! No need
  ! obs%user%sub(snum)%title   = userhooks(cuserhooks)%title  ! No need
  obs%user%sub(snum)%version = sversion
  !
  ! Transfer and align the user data into uwork
  unext = 1
  call userhooks(cuserhooks)%toclass(sdata,sversion,error)
  if (error)  return
  if (unext.le.1) then
    call class_message(seve%e,rname,'User section length is null')
    error = .true.
    return
  endif
  !
  ! Save uwork in our structure
  if (obs%user%sub(snum)%ndata.ne.unext-1) then
    deallocate(obs%user%sub(snum)%data)
    obs%user%sub(snum)%ndata = unext-1
    allocate(obs%user%sub(snum)%data(unext-1),stat=ier)
    if (failed_allocate(rname,'OBS%SUB(SNUM)%DATA',ier,error))  return
  endif
  obs%user%sub(snum)%data(1:unext-1) = uwork(1:unext-1)
  !
end subroutine classcore_user_update
!
subroutine user_sec_dump(obs,error)
  use gbl_message
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>user_sec_dump
  use class_buffer
  use class_types
  use class_user
  !---------------------------------------------------------------------
  ! @ private
  !   Dump all the User Sections from the input observation. Data is
  ! not displayed if there is no hook provided by the user.
  !---------------------------------------------------------------------
  type(observation), intent(in)    :: obs    ! Observation
  logical,           intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='USER_SEC_DUMP'
  integer(kind=4) :: iuser,iowner
  character(len=message_length) :: mess
  !
  if (obs%user%n.eq.0) then
    call class_message(seve%w,rname,'Observation has no User Section defined')
    return
    !
  else
    !
    write(mess,'(2X,A,1X,I0)') 'Number of subsections:',obs%user%n
    call class_message(seve%r,rname,mess)
    !
    do iuser=1,obs%user%n
      write(mess,'(2X,A,T20,I0)') 'User Section #',iuser
      call class_message(seve%r,rname,mess)
      write(mess,'(4X,A,T20,A)')   'Owner:',obs%user%sub(iuser)%owner
      call class_message(seve%r,rname,mess)
      write(mess,'(4X,A,T20,A)')   'Title:',obs%user%sub(iuser)%title
      call class_message(seve%r,rname,mess)
      write(mess,'(4X,A,T20,I0)')  'Version:',obs%user%sub(iuser)%version
      call class_message(seve%r,rname,mess)
      write(mess,'(4X,A,T20,I0)')  'Data length:',obs%user%sub(iuser)%ndata
      call class_message(seve%r,rname,mess)
      ! Now, the data:
      write(mess,'(4X,A)')         'Data:'
      call class_message(seve%r,rname,mess)
      !
      ! Find the correct owner and use it:
      call user_sec_owner(obs%user%sub(iuser),iowner,error)
      if (iowner.ne.0 .and.  &
          associated(userhooks(iowner)%dump)) then
        ! Transfer the data to uwork
        unext = 1
        uwork(1:obs%user%sub(iuser)%ndata) = obs%user%sub(iuser)%data
        ! Call the user hook, which will read uwork by itself
        call userhooks(iowner)%dump(obs%user%sub(iuser)%version,error)
      else
        call class_message(seve%r,rname,'      (can not list)')
      endif
    enddo
    !
  endif
  !
end subroutine user_sec_dump
!
subroutine user_sec_setvar(set,obs,delete,error)
  use gbl_message
  use classcore_interfaces, except_this=>user_sec_setvar
  use class_types
  use class_user
  !---------------------------------------------------------------------
  ! @ private
  !  Support subroutine for
  !   SET VARIABLE USER
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set     !
  type(observation),   intent(in)    :: obs     ! Observation
  logical,             intent(in)    :: delete  ! Delete structure only?
  logical,             intent(inout) :: error   ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='USER_SEC_SETVAR'
  !
  if (obs%user%n.eq.0)  return  ! No user section!
  if (cuserhooks.eq.0)  return  ! No current hooks defined!
  if (.not.associated(userhooks(cuserhooks)%setvar)) then
    call class_message(seve%e,rname,'No user function set for SET VAR USER')
    error = .true.
    return
  endif
  !
  call newdat_user(set,obs,error)
  !
end subroutine user_sec_setvar
!
subroutine user_sec_fix(obs,found,error)
  use gbl_message
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>user_sec_fix
  use class_buffer
  use class_types
  use class_user
  !---------------------------------------------------------------------
  ! @ private
  !   Select or not the input observation according to its user section
  !---------------------------------------------------------------------
  type(observation), intent(in)    :: obs    ! Observation
  logical,           intent(out)   :: found  !
  logical,           intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='USER_SEC_FIX'
  integer :: iuser
  !
  found = .false.
  !
  if (obs%user%n.eq.0)  return  ! No user section!
  if (cuserhooks.eq.0)  return  ! No current hooks defined!
  if (.not.associated(userhooks(cuserhooks)%fix))  return  ! No user function!
  !
  call class_user_exists(obs,iuser)
  if (iuser.eq.0)  return
  !
  ! Transfer the data to uwork
  unext = 1
  uwork(1:obs%user%sub(iuser)%ndata) = obs%user%sub(iuser)%data
  ! Call the user hook, which will read uwork by itself
  call userhooks(cuserhooks)%fix(obs%user%sub(iuser)%version,found,error)
  if (error)  return
  !
end subroutine user_sec_fix
!
subroutine user_sec_find(line,error)
  use gbl_message
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>user_sec_find
  use class_user
  !---------------------------------------------------------------------
  ! @ private
  !  Command line parsing for option FIND /USER
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line  !
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='USER_SEC_FIND'
  integer(kind=4), parameter :: optuser=16
  integer(kind=4), parameter :: muarg=10
  integer(kind=4) :: iarg,nuarg,nc
  character(len=32) :: uarg(muarg)
  !
  nuarg = sic_narg(optuser)
  if (nuarg.gt.muarg) then
    call class_message(seve%e,rname,'Too many arguments for option /USER')
    error = .true.
    return
  endif
  !
  ! Parse the command line and store arguments as strings
  do iarg=1,nuarg
    call sic_ch(line,16,iarg,uarg(iarg),nc,.true.,error)
    if (error)  return
  enddo
  !
  if (cuserhooks.eq.0 .or.  & ! No current hooks defined!
      .not.associated(userhooks(cuserhooks)%find)) then
    call class_message(seve%e,rname,'No user function for FIND /USER')
    error = .true.
    return
  endif
  !
  ! Send the string list to the user hook
  call userhooks(cuserhooks)%find(uarg,nuarg,error)
  if (error)  return
  !
end subroutine user_sec_find
!
subroutine user_sec_varidx_fill(obs,ient,error)
  use gildas_def
  use gbl_message
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>user_sec_varidx_fill
  use class_buffer
  use class_types
  use class_user
  !---------------------------------------------------------------------
  ! @ private
  !  Fill the VARIABLE /INDEX support array(s) for user section
  !---------------------------------------------------------------------
  type(observation),          intent(in)    :: obs    ! Observation
  integer(kind=entry_length), intent(in)    :: ient   ! Entry number in index
  logical,                    intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='USER_SEC_VARIDX_FILL'
  integer(kind=4) :: iuser
  !
  if (obs%user%n.eq.0)  return  ! No user section!
  if (cuserhooks.eq.0)  return  ! No current hooks defined!
  if (.not.associated(userhooks(cuserhooks)%varidx_fill))  return  ! No user function!
  !
  call class_user_exists(obs,iuser)
  if (iuser.eq.0)  return
  !
  ! Transfer the data to uwork
  unext = 1
  uwork(1:obs%user%sub(iuser)%ndata) = obs%user%sub(iuser)%data
  ! Call the user hook, which will read uwork by itself
  call userhooks(cuserhooks)%varidx_fill(obs%user%sub(iuser)%version,ient,error)
  if (error)  return
  !
end subroutine user_sec_varidx_fill
!
subroutine user_sec_varidx_defvar(error)
  use gildas_def
  use gbl_message
  use classic_api
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>user_sec_varidx_defvar
  use class_user
  !---------------------------------------------------------------------
  ! @ private
  !  Define the VARIABLE /INDEX sic arrays for user section
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='VARIABLE'
  character(len=64) :: name
  !
  if (cuserhooks.eq.0)  error = .true.  ! No current hooks defined!
  if (.not.associated(userhooks(cuserhooks)%varidx_defvar))  error = .true.  ! No user function!
  if (error) then
    call class_message(seve%e,rname,'No user hook defined')
    return
  endif
  !
  name = 'IDX%USER'
  call sic_defstructure(name,.true.,error)
  if (error)  return
  !
  name = trim(name)//'%'//userhooks(cuserhooks)%owner
  call sic_defstructure(name,.true.,error)
  if (error)  return
  !
  name = trim(name)//'%'//userhooks(cuserhooks)%title
  call sic_defstructure(name,.true.,error)
  if (error)  return
  !
  ! Call the user hook
  call userhooks(cuserhooks)%varidx_defvar(error)
  if (error)  return
  !
end subroutine user_sec_varidx_defvar
!
subroutine user_sec_varidx_realloc(nent,error)
  use gildas_def
  use classic_api
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>user_sec_varidx_realloc
  use class_user
  !---------------------------------------------------------------------
  ! @ private
  !  Re/Deallocate the VARIABLE /INDEX support arrays for user section
  !---------------------------------------------------------------------
  integer(kind=entry_length), intent(in)    :: nent   ! Size of arrays
  logical,                    intent(inout) :: error  ! Logical error flag
  ! Local
  !
  if (cuserhooks.eq.0)  return  ! No current hooks defined!
  if (.not.associated(userhooks(cuserhooks)%varidx_realloc))  return  ! No user function!
  !
  ! Call the user hook
  call userhooks(cuserhooks)%varidx_realloc(nent,error)
  if (error)  return
  !
end subroutine user_sec_varidx_realloc
!
subroutine classcore_user_owner(sowner,stitle)
  use class_user
  !---------------------------------------------------------------------
  ! @ public (for libclass only)
  !  Set the userhooks(cuserhooks)%owner character variable
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: sowner  ! Section owner
  character(len=*), intent(in) :: stitle  ! Section title
  ! Local
  integer(kind=4) :: ihook
  !
  cuserhooks = 0
  do ihook=1,nuserhooks
    if (userhooks(ihook)%owner.eq.sowner .and.  &
        userhooks(ihook)%title.eq.stitle) then
      ! Update old hooks
      cuserhooks = ihook
      exit
    endif
  enddo
  !
  if (cuserhooks.eq.0) then
    ! Define new hooks
    nuserhooks = nuserhooks+1
    cuserhooks = nuserhooks
    userhooks(cuserhooks)%owner = sowner
    userhooks(cuserhooks)%title = stitle
  endif
  !
end subroutine classcore_user_owner
!
subroutine classcore_user_toclass(usertoclass)
  use classcore_dependencies_interfaces
  use class_user
  !---------------------------------------------------------------------
  ! @ public (for libclass only)
  !  Set the userhooks(cuserhooks)%toclass procedure to the input procedure
  !---------------------------------------------------------------------
  external usertoclass
  !
  userhooks(cuserhooks)%toclass => usertoclass
  !
end subroutine classcore_user_toclass
!
subroutine classcore_user_dump(userdump)
  use classcore_dependencies_interfaces
  use class_user
  !---------------------------------------------------------------------
  ! @ public (for libclass only)
  !  Set the userhooks(cuserhooks)%dump procedure to the input procedure
  !---------------------------------------------------------------------
  external userdump
  !
  userhooks(cuserhooks)%dump => userdump
  !
end subroutine classcore_user_dump
!
subroutine classcore_user_setvar(set,usersetvar)
  use classcore_dependencies_interfaces
  use class_types
  use class_user
  !---------------------------------------------------------------------
  ! @ public (for libclass only)
  !  Set the userhooks(cuserhooks)%setvar procedure to the input procedure
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in) :: set
  external                        :: usersetvar
  ! Local
  logical :: error
  !
  if (set%varpresec(class_sec_user_id).ne.setvar_off) then
    error = .false.
    call sic_delvariable('R%USER',.false.,error)
  endif
  !
  userhooks(cuserhooks)%setvar => usersetvar
  !
end subroutine classcore_user_setvar
!
subroutine classcore_user_fix(userfix)
  use classcore_dependencies_interfaces
  use class_user
  !---------------------------------------------------------------------
  ! @ public (for libclass only)
  !  Set the userhooks(cuserhooks)%fix procedure to the input procedure
  !---------------------------------------------------------------------
  external userfix
  !
  userhooks(cuserhooks)%fix => userfix
  !
end subroutine classcore_user_fix
!
subroutine classcore_user_find(userfind)
  use classcore_dependencies_interfaces
  use class_user
  !---------------------------------------------------------------------
  ! @ public (for libclass only)
  !  Set the userhooks(cuserhooks)%find procedure to the input procedure
  !---------------------------------------------------------------------
  external userfind
  !
  userhooks(cuserhooks)%find => userfind
  !
end subroutine classcore_user_find
!
subroutine classcore_user_varidx_fill(uservaridx_fill)
  use classcore_dependencies_interfaces
  use class_user
  !---------------------------------------------------------------------
  ! @ public (for libclass only)
  !  Set the userhooks(cuserhooks)%varidx_fill procedure to the input
  ! procedure
  !---------------------------------------------------------------------
  external uservaridx_fill
  !
  userhooks(cuserhooks)%varidx_fill => uservaridx_fill
  !
end subroutine classcore_user_varidx_fill
!
subroutine classcore_user_varidx_defvar(uservaridx_defvar)
  use classcore_dependencies_interfaces
  use class_user
  !---------------------------------------------------------------------
  ! @ public (for libclass only)
  !  Set the userhooks(cuserhooks)%varidx_defvar procedure to the input
  ! procedure
  !---------------------------------------------------------------------
  external uservaridx_defvar
  !
  userhooks(cuserhooks)%varidx_defvar => uservaridx_defvar
  !
end subroutine classcore_user_varidx_defvar
!
subroutine classcore_user_varidx_realloc(uservaridx_realloc)
  use classcore_dependencies_interfaces
  use class_user
  !---------------------------------------------------------------------
  ! @ public (for libclass only)
  !  Set the userhooks(cuserhooks)%varidx_realloc procedure to the input
  ! procedure
  !---------------------------------------------------------------------
  external uservaridx_realloc
  !
  userhooks(cuserhooks)%varidx_realloc => uservaridx_realloc
  !
end subroutine classcore_user_varidx_realloc
!
subroutine class_user_reset(set)
  use classcore_dependencies_interfaces
  use class_types
  use class_user
  !---------------------------------------------------------------------
  ! @ private
  !  Reset the User Subsection hooks, i.e. forget how to handle a
  ! specific User Subsection
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in) :: set
  ! Local
  logical :: error
  !
  userhooks(cuserhooks)%owner = ''
  userhooks(cuserhooks)%title = ''
  userhooks(cuserhooks)%toclass        => null()
  userhooks(cuserhooks)%dump           => null()
  userhooks(cuserhooks)%setvar         => null()
  userhooks(cuserhooks)%find           => null()
  userhooks(cuserhooks)%fix            => null()
  userhooks(cuserhooks)%varidx_fill    => null()
  userhooks(cuserhooks)%varidx_defvar  => null()
  userhooks(cuserhooks)%varidx_realloc => null()
  !
  if (set%varpresec(class_sec_user_id).ne.setvar_off) then
    error = .false.
    call sic_delvariable('R%USER',.false.,error)
  endif
  !
end subroutine class_user_reset
!
subroutine classcore_user_def_inte(set,obs,suffix,ndim,dims,error)
  use gildas_def
  use classcore_dependencies_interfaces
  use class_buffer
  use class_types
  use class_user
  !---------------------------------------------------------------------
  ! @ public
  !  Define the Sic integer variable R%USER%OWNER%SUFFIX
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set      !
  type(observation),   intent(in)    :: obs      !
  character(len=*),    intent(in)    :: suffix   ! Component name
  integer(kind=4),     intent(in)    :: ndim     ! Number of dimensions (0=scalar)
  integer(kind=4),     intent(in)    :: dims(4)  ! Dimensions (if needed)
  logical,             intent(inout) :: error    ! Logical error flag
  ! Local
  character(len=32) :: name
  integer(kind=index_length) :: mydims(4)
  !
  name = 'R%USER%'//trim(userhooks(cuserhooks)%owner)//'%'//suffix
  mydims(:) = dims(:)
  call sic_def_inte_addr (name,obs%user%sub(usub)%data(unext),ndim,mydims,  &
    set%varpresec(class_sec_user_id).ne.setvar_write,error)
  unext = unext+product(dims(1:ndim))  ! If ndim==0, product is 1
  !
end subroutine classcore_user_def_inte
!
subroutine classcore_user_def_real(set,obs,suffix,ndim,dims,error)
  use gildas_def
  use classcore_dependencies_interfaces
  use class_buffer
  use class_types
  use class_user
  !---------------------------------------------------------------------
  ! @ public
  !  Define the Sic real variable R%USER%OWNER%SUFFIX
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set      !
  type(observation),   intent(in)    :: obs      !
  character(len=*),    intent(in)    :: suffix   ! Component name
  integer(kind=4),     intent(in)    :: ndim     ! Number of dimensions (0=scalar)
  integer(kind=4),     intent(in)    :: dims(4)  ! Dimensions (if needed)
  logical,             intent(inout) :: error    ! Logical error flag
  ! Local
  character(len=32) :: name
  integer(kind=index_length) :: mydims(4)
  !
  name = 'R%USER%'//trim(userhooks(cuserhooks)%owner)//'%'//suffix
  mydims(:) = dims(:)
  call sic_def_real_addr (name,obs%user%sub(usub)%data(unext),ndim,mydims,  &
    set%varpresec(class_sec_user_id).ne.setvar_write,error)
  unext = unext+product(dims(1:ndim))  ! If ndim==0, product is 1
  !
end subroutine classcore_user_def_real
!
subroutine classcore_user_def_dble(set,obs,suffix,ndim,dims,error)
  use gildas_def
  use classcore_dependencies_interfaces
  use class_buffer
  use class_types
  use class_user
  !---------------------------------------------------------------------
  ! @ public
  !  Define the Sic double variable R%USER%OWNER%SUFFIX
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set      !
  type(observation),   intent(in)    :: obs      !
  character(len=*),    intent(in)    :: suffix   ! Component name
  integer(kind=4),     intent(in)    :: ndim     ! Number of dimensions (0=scalar)
  integer(kind=4),     intent(in)    :: dims(4)  ! Dimensions (if needed)
  logical,             intent(inout) :: error    ! Logical error flag
  ! Local
  character(len=32) :: name
  integer(kind=index_length) :: mydims(4)
  !
  name = 'R%USER%'//trim(userhooks(cuserhooks)%owner)//'%'//suffix
  mydims(:) = dims(:)
  call sic_def_dble_addr (name,obs%user%sub(usub)%data(unext),ndim,mydims,  &
    set%varpresec(class_sec_user_id).ne.setvar_write,error)
  unext = unext+2*product(dims(1:ndim))  ! If ndim==0, product is 1
  !
end subroutine classcore_user_def_dble
!
subroutine classcore_user_def_char(set,obs,suffix,lchain,error)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_types
  use class_user
  !---------------------------------------------------------------------
  ! @ public
  !  Define the Sic character variable R%USER%OWNER%SUFFIX
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set      !
  type(observation),   intent(in)    :: obs      !
  character(len=*),    intent(in)    :: suffix   ! Component name
  integer(kind=4),     intent(in)    :: lchain   ! String length in the 'data' buffer
  logical,             intent(inout) :: error    ! Logical error flag
  ! Local
  character(len=32) :: name
  !
  name = 'R%USER%'//trim(userhooks(cuserhooks)%owner)//'%'//suffix
  call sic_def_strn (name,obs%user%sub(usub)%data(unext),lchain,  &
    set%varpresec(class_sec_user_id).ne.setvar_write,error)
  unext = unext+lchain/4
  !
end subroutine classcore_user_def_char
!
subroutine class_user_varidx_def_inte_1d(suffix,array,error)
  use gildas_def
  use classcore_dependencies_interfaces
  use class_index
  use class_user
  !---------------------------------------------------------------------
  ! @ public-generic class_user_varidx_def_inte
  !  Define the Sic integer array IDX%USER%OWNER%TITLE%SUFFIX[:]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: suffix    ! Component name
  integer(kind=4),  intent(in)    :: array(:)  ! Target 1D array
  logical,          intent(inout) :: error     ! Logical error flag
  ! Local
  character(len=64) :: name
  integer(kind=4) :: ndim
  integer(kind=index_length) :: dims(4)
  !
  name = 'IDX%USER%'//                             &
         trim(userhooks(cuserhooks)%owner)//'%'//  &
         trim(userhooks(cuserhooks)%title)//'%'//  &
         suffix
  !
  ndim = 1
  dims(1) = cx%next-1  ! Last dimension: limit to CX size (because
                       ! reallocation routines do not shrink arrays)
  call sic_def_inte(name,array,ndim,dims,.true.,error)
  if (error)  return
  !
end subroutine class_user_varidx_def_inte_1d
!
subroutine class_user_varidx_def_inte_2d(suffix,array,error)
  use gildas_def
  use classcore_dependencies_interfaces
  use class_index
  use class_user
  !---------------------------------------------------------------------
  ! @ public-generic class_user_varidx_def_inte
  !  Define the Sic integer array IDX%USER%OWNER%TITLE%SUFFIX[:,:]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: suffix      ! Component name
  integer(kind=4),  intent(in)    :: array(:,:)  ! Target 2D array
  logical,          intent(inout) :: error       ! Logical error flag
  ! Local
  character(len=64) :: name
  integer(kind=4) :: ndim
  integer(kind=index_length) :: dims(4)
  !
  name = 'IDX%USER%'//                             &
         trim(userhooks(cuserhooks)%owner)//'%'//  &
         trim(userhooks(cuserhooks)%title)//'%'//  &
         suffix
  !
  ndim = 2
  dims(1) = ubound(array,1)
  dims(2) = cx%next-1  ! Last dimension: limit to CX size (because
                       ! reallocation routines do not shrink arrays)
  call sic_def_inte(name,array,ndim,dims,.true.,error)
  if (error)  return
  !
end subroutine class_user_varidx_def_inte_2d
!
subroutine class_user_varidx_def_real_1d(suffix,array,error)
  use gildas_def
  use classcore_dependencies_interfaces
  use class_index
  use class_user
  !---------------------------------------------------------------------
  ! @ public-generic class_user_varidx_def_real
  !  Define the Sic real array IDX%USER%OWNER%TITLE%SUFFIX[:]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: suffix    ! Component name
  real(kind=4),     intent(in)    :: array(:)  ! Target 1D array
  logical,          intent(inout) :: error     ! Logical error flag
  ! Local
  character(len=64) :: name
  integer(kind=4) :: ndim
  integer(kind=index_length) :: dims(4)
  !
  name = 'IDX%USER%'//                             &
         trim(userhooks(cuserhooks)%owner)//'%'//  &
         trim(userhooks(cuserhooks)%title)//'%'//  &
         suffix
  !
  ndim = 1
  dims(1) = cx%next-1  ! Last dimension: limit to CX size (because
                       ! reallocation routines do not shrink arrays)
  call sic_def_real(name,array,ndim,dims,.true.,error)
  if (error)  return
  !
end subroutine class_user_varidx_def_real_1d
!
subroutine class_user_varidx_def_real_2d(suffix,array,error)
  use gildas_def
  use classcore_dependencies_interfaces
  use class_index
  use class_user
  !---------------------------------------------------------------------
  ! @ public-generic class_user_varidx_def_real
  !  Define the Sic real array IDX%USER%OWNER%TITLE%SUFFIX[:,:]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: suffix      ! Component name
  real(kind=4),     intent(in)    :: array(:,:)  ! Target 2D array
  logical,          intent(inout) :: error       ! Logical error flag
  ! Local
  character(len=64) :: name
  integer(kind=4) :: ndim
  integer(kind=index_length) :: dims(4)
  !
  name = 'IDX%USER%'//                             &
         trim(userhooks(cuserhooks)%owner)//'%'//  &
         trim(userhooks(cuserhooks)%title)//'%'//  &
         suffix
  !
  ndim = 2
  dims(1) = ubound(array,1)
  dims(2) = cx%next-1  ! Last dimension: limit to CX size (because
                       ! reallocation routines do not shrink arrays)
  call sic_def_real(name,array,ndim,dims,.true.,error)
  if (error)  return
  !
end subroutine class_user_varidx_def_real_2d
!
subroutine class_user_varidx_def_dble_1d(suffix,array,error)
  use gildas_def
  use classcore_dependencies_interfaces
  use class_index
  use class_user
  !---------------------------------------------------------------------
  ! @ public-generic class_user_varidx_def_dble
  !  Define the Sic double array IDX%USER%OWNER%TITLE%SUFFIX[:]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: suffix    ! Component name
  real(kind=8),     intent(in)    :: array(:)  ! Target 1D array
  logical,          intent(inout) :: error     ! Logical error flag
  ! Local
  character(len=64) :: name
  integer(kind=4) :: ndim
  integer(kind=index_length) :: dims(4)
  !
  name = 'IDX%USER%'//                             &
         trim(userhooks(cuserhooks)%owner)//'%'//  &
         trim(userhooks(cuserhooks)%title)//'%'//  &
         suffix
  !
  ndim = 1
  dims(1) = cx%next-1  ! Last dimension: limit to CX size (because
                       ! reallocation routines do not shrink arrays)
  call sic_def_dble(name,array,ndim,dims,.true.,error)
  if (error)  return
  !
end subroutine class_user_varidx_def_dble_1d
!
subroutine class_user_varidx_def_dble_2d(suffix,array,error)
  use gildas_def
  use classcore_dependencies_interfaces
  use class_index
  use class_user
  !---------------------------------------------------------------------
  ! @ public-generic class_user_varidx_def_dble
  !  Define the Sic double array IDX%USER%OWNER%TITLE%SUFFIX[:,:]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: suffix      ! Component name
  real(kind=8),     intent(in)    :: array(:,:)  ! Target 2D array
  logical,          intent(inout) :: error       ! Logical error flag
  ! Local
  character(len=64) :: name
  integer(kind=4) :: ndim
  integer(kind=index_length) :: dims(4)
  !
  name = 'IDX%USER%'//                             &
         trim(userhooks(cuserhooks)%owner)//'%'//  &
         trim(userhooks(cuserhooks)%title)//'%'//  &
         suffix
  !
  ndim = 2
  dims(1) = ubound(array,1)
  dims(2) = cx%next-1  ! Last dimension: limit to CX size (because
                       ! reallocation routines do not shrink arrays)
  call sic_def_dble(name,array,ndim,dims,.true.,error)
  if (error)  return
  !
end subroutine class_user_varidx_def_dble_2d
!
subroutine class_user_varidx_def_charn_1d(suffix,array,error)
  use gildas_def
  use classcore_dependencies_interfaces
  use class_index
  use class_user
  !---------------------------------------------------------------------
  ! @ public-generic class_user_varidx_def_charn
  !  Define the Sic character array IDX%USER%OWNER%TITLE%SUFFIX[:]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: suffix    ! Component name
  character(len=*), intent(in)    :: array(:)  ! Target 1D array
  logical,          intent(inout) :: error     ! Logical error flag
  ! Local
  character(len=64) :: name
  integer(kind=4) :: ndim
  integer(kind=index_length) :: dims(4)
  !
  name = 'IDX%USER%'//                             &
         trim(userhooks(cuserhooks)%owner)//'%'//  &
         trim(userhooks(cuserhooks)%title)//'%'//  &
         suffix
  !
  ndim = 1
  dims(1) = cx%next-1  ! Last dimension: limit to CX size (because
                       ! reallocation routines do not shrink arrays)
  call sic_def_charn(name,array,ndim,dims,.true.,error)
  if (error)  return
  !
end subroutine class_user_varidx_def_charn_1d
!
subroutine class_user_varidx_def_charn_2d(suffix,array,error)
  use gildas_def
  use classcore_dependencies_interfaces
  use class_index
  use class_user
  !---------------------------------------------------------------------
  ! @ public-generic class_user_varidx_def_charn
  !  Define the Sic character array IDX%USER%OWNER%TITLE%SUFFIX[:,:]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: suffix      ! Component name
  character(len=*), intent(in)    :: array(:,:)  ! Target 2D array
  logical,          intent(inout) :: error       ! Logical error flag
  ! Local
  character(len=64) :: name
  integer(kind=4) :: ndim
  integer(kind=index_length) :: dims(4)
  !
  name = 'IDX%USER%'//                             &
         trim(userhooks(cuserhooks)%owner)//'%'//  &
         trim(userhooks(cuserhooks)%title)//'%'//  &
         suffix
  !
  ndim = 2
  dims(1) = ubound(array,1)
  dims(2) = cx%next-1  ! Last dimension: limit to CX size (because
                       ! reallocation routines do not shrink arrays)
  call sic_def_charn(name,array,ndim,dims,.true.,error)
  if (error)  return
  !
end subroutine class_user_varidx_def_charn_2d
!
subroutine classtoi4_0d(i4)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_classtodata
  ! Write scalar integer*4 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  integer(kind=4), intent(out) :: i4
  call filein%conv%read%i4(uwork(unext),i4,1)
  unext = unext+1
end subroutine classtoi4_0d
!
subroutine classtor4_0d(r4)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_classtodata
  ! Write scalar real*4 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  real(kind=4), intent(out) :: r4
  call filein%conv%read%r4(uwork(unext),r4,1)
  unext = unext+1
end subroutine classtor4_0d
!
subroutine classtor8_0d(r8)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_classtodata
  ! Write scalar real*8 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  real(kind=8), intent(out) :: r8
  call filein%conv%read%r8(uwork(unext),r8,1)
  unext = unext+2
end subroutine classtor8_0d
!
subroutine classtocc_0d(cc)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_classtodata
  ! Write scalar character(len=*) at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  character(len=*), intent(out) :: cc
  ! Local
  integer(kind=4) :: cclen
  cclen = len(cc)/4  ! ZZZ Check if a multiple of 4? Round to upper 4-bytes?
  call filein%conv%read%cc(uwork(unext),cc,cclen)
  unext = unext+cclen
end subroutine classtocc_0d
!
subroutine classtoi4_1d(i4)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_classtodata
  ! Write 1D array integer*4 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  integer(kind=4), intent(out) :: i4(:)
  ! Local
  integer(kind=4) :: l
  l = size(i4)
  call filein%conv%read%i4(uwork(unext),i4,l)
  unext = unext+l
end subroutine classtoi4_1d
!
subroutine classtor4_1d(r4)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_classtodata
  ! Write 1D array real*4 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  real(kind=4), intent(out) :: r4(:)
  ! Local
  integer(kind=4) :: l
  l = size(r4)
  call filein%conv%read%r4(uwork(unext),r4,l)
  unext = unext+l
end subroutine classtor4_1d
!
subroutine classtor8_1d(r8)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_classtodata
  ! Write 1D array real*8 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  real(kind=8), intent(out) :: r8(:)
  ! Local
  integer(kind=4) :: l
  l = size(r8)
  call filein%conv%read%r8(uwork(unext),r8,l)
  unext = unext+2*l
end subroutine classtor8_1d
!
subroutine classtocc_1d(cc)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_classtodata
  ! Write 1D array character(len=*) at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  character(len=*), intent(out) :: cc(:)
  ! Local
  integer(kind=4) :: cclen
  integer(kind=4) :: l
  l = size(cc)
  cclen = l*(len(cc(1))/4)  ! ZZZ Check if a multiple of 4? Round to upper 4-bytes?
  call filein%conv%read%cc(uwork(unext),cc,cclen)
  unext = unext+cclen
end subroutine classtocc_1d
!
subroutine classtoi4_2d(i4)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_classtodata
  ! Write 2D array integer*4 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  integer(kind=4), intent(out) :: i4(:,:)
  ! Local
  integer(kind=4) :: l
  l = size(i4)
  call filein%conv%read%i4(uwork(unext),i4,l)
  unext = unext+l
end subroutine classtoi4_2d
!
subroutine classtor4_2d(r4)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_classtodata
  ! Write 2D array real*4 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  real(kind=4), intent(out) :: r4(:,:)
  ! Local
  integer(kind=4) :: l
  l = size(r4)
  call filein%conv%read%r4(uwork(unext),r4,l)
  unext = unext+l
end subroutine classtor4_2d
!
subroutine classtor8_2d(r8)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_classtodata
  ! Write 2D array real*8 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  real(kind=8), intent(out) :: r8(:,:)
  ! Local
  integer(kind=4) :: l
  l = size(r8)
  call filein%conv%read%r8(uwork(unext),r8,l)
  unext = unext+2*l
end subroutine classtor8_2d
!
subroutine classtocc_2d(cc)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_classtodata
  ! Write 2D array character(len=*) at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  character(len=*), intent(out) :: cc(:,:)
  ! Local
  integer(kind=4) :: cclen
  integer(kind=4) :: l
  l = size(cc)
  cclen = l*(len(cc(1,1))/4)  ! ZZZ Check if a multiple of 4? Round to upper 4-bytes?
  call filein%conv%read%cc(uwork(unext),cc,cclen)
  unext = unext+cclen
end subroutine classtocc_2d
!
subroutine i4toclass_0d(i4)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_datatoclass
  ! Write scalar integer*4 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: i4
  ! Local
  logical :: error
  !
  error = .false.
  call reallocate_uwork(unext,.true.,error)
  if (error)  return
  !
  call fileout%conv%writ%i4(i4,uwork(unext),1)
  unext = unext+1
end subroutine i4toclass_0d
!
subroutine r4toclass_0d(r4)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_datatoclass
  ! Write scalar real*4 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  real(kind=4), intent(in) :: r4
  ! Local
  logical :: error
  !
  error = .false.
  call reallocate_uwork(unext,.true.,error)
  if (error)  return
  !
  call fileout%conv%writ%r4(r4,uwork(unext),1)
  unext = unext+1
end subroutine r4toclass_0d
!
subroutine r8toclass_0d(r8)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_datatoclass
  ! Write scalar real*8 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  real(kind=8), intent(in) :: r8
  ! Local
  logical :: error
  !
  error = .false.
  call reallocate_uwork(unext+1,.true.,error)
  if (error)  return
  !
  call fileout%conv%writ%r8(r8,uwork(unext),1)
  unext = unext+2
end subroutine r8toclass_0d
!
subroutine cctoclass_0d(cc)
  use gbl_message
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_datatoclass
  ! Write scalar character(len=*) at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: cc
  ! Local
  integer(kind=4) :: cclen
  character(len=message_length) :: mess
  logical :: error
  !
  cclen = len(cc)/4  ! Truncate
  error = .false.
  call reallocate_uwork(unext+cclen-1,.true.,error)
  if (error)  return
  !
  call fileout%conv%writ%cc(cc,uwork(unext),cclen)
  unext = unext+cclen
  !
  if (cclen*4.ne.len(cc)) then
    write(mess,'(A,I0,A)')  &
      'String variable truncated to ',cclen*4,' characters'
    call class_message(seve%w,'USER',mess)
  endif
end subroutine cctoclass_0d
!
subroutine i4toclass_1d(i4)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_datatoclass
  ! Write 1D array integer*4 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: i4(:)
  ! Local
  integer(kind=4) :: l
  logical :: error
  !
  l = size(i4)
  error = .false.
  call reallocate_uwork(unext+l-1,.true.,error)
  if (error)  return
  !
  call fileout%conv%writ%i4(i4,uwork(unext),l)
  unext = unext+l
end subroutine i4toclass_1d
!
subroutine r4toclass_1d(r4)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_datatoclass
  ! Write 1D array real*4 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  real(kind=4), intent(in) :: r4(:)
  ! Local
  integer(kind=4) :: l
  logical :: error
  !
  l = size(r4)
  error = .false.
  call reallocate_uwork(unext+l-1,.true.,error)
  if (error)  return
  !
  call fileout%conv%writ%r4(r4,uwork(unext),l)
  unext = unext+l
end subroutine r4toclass_1d
!
subroutine r8toclass_1d(r8)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_datatoclass
  ! Write 1D array real*8 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  real(kind=8), intent(in) :: r8(:)
  ! Local
  integer(kind=4) :: l
  logical :: error
  !
  l = size(r8)
  error = .false.
  call reallocate_uwork(unext+2*l-1,.true.,error)
  if (error)  return
  !
  call fileout%conv%writ%r8(r8,uwork(unext),l)
  unext = unext+2*l
end subroutine r8toclass_1d
!
subroutine cctoclass_1d(cc)
  use gbl_message
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_datatoclass
  ! Write 1D array character(len=*) at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: cc(:)
  ! Local
  integer(kind=4) :: cclen
  character(len=message_length) :: mess
  integer(kind=4) :: l
  logical :: error
  !
  l = size(cc)
  cclen = l*(len(cc(1))/4)  ! Truncate
  error = .false.
  call reallocate_uwork(unext+cclen-1,.true.,error)
  if (error)  return
  !
  call fileout%conv%writ%cc(cc,uwork(unext),cclen)
  unext = unext+cclen
  !
  if (cclen*4.ne.len(cc)) then
    write(mess,'(A,I0,A)')  &
      'String variable truncated to ',cclen*4,' characters'
    call class_message(seve%w,'USER',mess)
  endif
end subroutine cctoclass_1d
!
subroutine i4toclass_2d(i4)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_datatoclass
  ! Write 2D array integer*4 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: i4(:,:)
  ! Local
  integer(kind=4) :: l
  logical :: error
  !
  l = size(i4)
  error = .false.
  call reallocate_uwork(unext+l-1,.true.,error)
  if (error)  return
  !
  call fileout%conv%writ%i4(i4,uwork(unext),l)
  unext = unext+l
end subroutine i4toclass_2d
!
subroutine r4toclass_2d(r4)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_datatoclass
  ! Write 2D array real*4 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  real(kind=4), intent(in) :: r4(:,:)
  ! Local
  integer(kind=4) :: l
  logical :: error
  !
  l = size(r4)
  error = .false.
  call reallocate_uwork(unext+l-1,.true.,error)
  if (error)  return
  !
  call fileout%conv%writ%r4(r4,uwork(unext),l)
  unext = unext+l
end subroutine r4toclass_2d
!
subroutine r8toclass_2d(r8)
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_datatoclass
  ! Write 2D array real*8 at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  real(kind=8), intent(in) :: r8(:,:)
  ! Local
  integer(kind=4) :: l
  logical :: error
  !
  l = size(r8)
  error = .false.
  call reallocate_uwork(unext+2*l-1,.true.,error)
  if (error)  return
  !
  call fileout%conv%writ%r8(r8,uwork(unext),l)
  unext = unext+2*l
end subroutine r8toclass_2d
!
subroutine cctoclass_2d(cc)
  use gbl_message
  use classcore_dependencies_interfaces
  use class_buffer
  use class_common
  !---------------------------------------------------------------------
  ! @ public-generic class_user_datatoclass
  ! Write 2D array character(len=*) at next position in buffer 'uwork'
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: cc(:,:)
  ! Local
  integer(kind=4) :: cclen
  character(len=message_length) :: mess
  integer(kind=4) :: l
  logical :: error
  !
  l = size(cc)
  cclen = l*(len(cc(1,1))/4)  ! Truncate
  error = .false.
  call reallocate_uwork(unext+cclen-1,.true.,error)
  if (error)  return
  !
  call fileout%conv%writ%cc(cc,uwork(unext),cclen)
  unext = unext+cclen
  !
  if (cclen*4.ne.len(cc)) then
    write(mess,'(A,I0,A)')  &
      'String variable truncated to ',cclen*4,' characters'
    call class_message(seve%w,'USER',mess)
  endif
end subroutine cctoclass_2d
!
subroutine reallocate_uwork(newlen,twice,error)
  use classcore_dependencies_interfaces
  use class_buffer
  !---------------------------------------------------------------------
  ! @ private
  !  Reallocate the 'uwork' working buffer
  !---------------------------------------------------------------------
  integer(kind=data_length), intent(in)    :: newlen  !
  logical,                   intent(in)    :: twice   ! Strict reallocation or twice more?
  logical,                   intent(inout) :: error   !
  ! Local
  logical :: dokeep
  integer(kind=data_length) :: oldlen,dolen
  integer(kind=4), allocatable :: tmp(:)
  integer(kind=4) :: ier
  !
  if (allocated(uwork)) then
    oldlen = size(uwork)
    if (oldlen.ge.newlen) then
      ! Already enough size, nothing to do
      return
    else
      allocate(tmp(oldlen),stat=ier)
      if (failed_allocate('REALLOCATE>USER','tmp buffer',ier,error))  return
      tmp(:) = uwork(:)
      deallocate(uwork)
      dokeep = .true.
      if (twice) then
        dolen = max(oldlen*2,newlen)
      else
        dolen = newlen
      endif
    endif
  else
    dokeep = .false.
    dolen = newlen
  endif
  !
  allocate(uwork(dolen),stat=ier)
  if (failed_allocate('REALLOCATE>USER','uwork buffer',ier,error))  return
  !
  if (dokeep) then
    uwork(1:oldlen) = tmp(1:oldlen)
    deallocate(tmp)
  endif
  !
end subroutine reallocate_uwork
