module examine_parameters
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private
  ! Support module for command SIC\EXAMINE
  !---------------------------------------------------------------------
  logical :: global   ! /GLOBAL
  logical :: header   ! /HEADER
  logical :: address  ! /ADDRESS
  logical :: dopage   ! /PAGE
  logical :: dosave   ! /SAVE
  character(len=filename_length) :: savname  ! Output file for /SAVE
  integer(kind=4) :: savlun=0
  !
  ! Display mode
  integer, parameter :: summary = 1
  integer, parameter :: short   = 2
  integer, parameter :: full    = 3
  integer, parameter :: save    = 4
  !
end module examine_parameters
!
subroutine examine_variable(line,error)
  use gildas_def
  use sic_structures
  use sic_dictionaries
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>examine_variable
  use gbl_message
  use gbl_format
  use examine_parameters
  !---------------------------------------------------------------------
  ! @ private
  ! SIC  Support routine for command
  ! SIC\EXAMINE [Variable]
  ! 1           [/GLOBAL]
  ! 2           [/FUNCTION]
  ! 3           [/HEADER]
  ! 4           [/ADDRESS]
  ! 5           [/ALIAS]
  ! 6           [/PAGE]
  ! 7           [/SAVE]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  integer(kind=4) :: nn,iarg,ier
  character(len=64) :: name
  character(len=filename_length) :: tmpname
  integer(kind=4), parameter :: optglob=1
  integer(kind=4), parameter :: optfunc=2
  integer(kind=4), parameter :: opthead=3
  integer(kind=4), parameter :: optaddr=4
  integer(kind=4), parameter :: optalia=5
  integer(kind=4), parameter :: optpage=6
  integer(kind=4), parameter :: optsave=7
  !
  ! /FUNCTION obsolete since 14-apr-2016
  if (sic_present(optfunc,0)) then
    call sic_message(seve%e,'EXAMINE','/FUNCTION is obsolete, use HELP FUNCTION [Name] instead')
    error = .true.
    return
  endif
  !
  ! /GLOBAL
  global = sic_present(optglob,0)
  !
  ! /ALIAS
  if (sic_present(optalia,0)) then
    call sic_list_alias
    return
  endif
  !
  if (pfvar(27).eq.0) then
    call sic_message(seve%w,'EXAMINE','No known variables')
    return
  endif
  !
  ! /HEADER
  header = sic_present(opthead,0)
  !
  ! /ADDRESS
  address = sic_present(optaddr,0)
  !
  ! /PAGE
  dopage = sic_present(optpage,0)
  !
  ! /SAVE
  dosave = sic_present(optsave,0)
  if (dosave) then
    call sic_ch(line,optsave,1,tmpname,nn,.true.,error)
    if (error)  return
    ! Open new one
    ier = sic_getlun(savlun)
    if (mod(ier,2).eq.0) then
      error=.true.
      return
    endif
    call sic_parse_file(tmpname,' ','.sic',savname)
    ier = sic_open(savlun,savname,'NEW',.false.)
    if (ier.ne.0) then
      call putios('E-SIC, ',ier)
      call sic_output_close(error)
      error = .true.
    endif
  endif
  !
  ! Arguments
  if (sic_present(0,1)) then
    do iarg=1,sic_narg(0)
      call sic_ke(line,0,iarg,name,nn,.true.,error)
      if (error)  return
      call sic_examine(name,error)
      if (error)  return
    enddo
  else
    ! No arguments, list all
    call sic_examine('*',error)
    if (error)  return
  endif
  !
  ! /SAVE
  if (savlun.ne.0) then
    ! Close the unit
    ier = sic_close(savlun)
    if (ier.ne.0) then
      call putios('E-SAY, ',ier)
      error = .true.
      ! continue
    endif
    !
    ! Free the unit
    call sic_frelun(savlun)
    savlun = 0
  endif
  !
end subroutine examine_variable
!
subroutine sic_examine(name,error)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_examine
  use sic_structures
  use sic_dictionaries
  use examine_parameters
  !---------------------------------------------------------------------
  ! @ private
  ! Support subroutine for command SIC\EXAMINE
  ! Given an input name or pattern, list one or all associated
  ! variables. Verbosity relies on the kind of input.
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: name   ! Name or pattern to find
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  integer(kind=4) :: list(maxvar),vtype,ivar,in,level,nn,ik,tt_lines
  integer(kind=4) :: nlisted,first,last,step
  logical :: notastruct,wilcarded,verbose_struct
  !
  nn = len_trim(name)
  verbose_struct = nn.ge.2 .and. name(nn-1:nn).eq.'%*'
  if (verbose_struct)  nn = nn-1   ! Strip the *
  notastruct = name(nn:nn).ne.'%'
  wilcarded = index(name(1:nn),'*').ne.0
  tt_lines = sic_ttynlin()-1
  !
  if (notastruct .and. .not.wilcarded) then
    ! Input name is a standard variable
    if (dosave) then
      call sic_examine_save(name,error)
    elseif (address) then
      call sic_examine_summary(name,error)
    else
      call sic_examine_full(name,error)
      if (error) call sic_exambigs(name,error)
    endif
    !
  elseif (.not.wilcarded) then
    ! Input name is a structure
    !
    call sic_examine_short(name(1:nn-1),error)
    if (error)  return
    !
    call sic_examine_type(name(1:nn-1),vtype,error)
    if (error)  return
    if (vtype.eq.8) then
      ! Special case for Header and Images:
      ! 1) Turn on full verbose mode
      verbose_struct = .true.
      ! 2a) Use the unsorted list (i.e. keep the list as it was defined;
      !     note that this is a side effect of the way hashing is done
      !     today, this may not work anymore when hashing is modified).
      call gag_haslis(maxvar,pfvar,pnvar,list,in)
      ! 2b) Revert the list, so that we see the first defined first
      first = in
      last = 1
      step = -1
    else
      ! Other structures: sort alphabetically
      call sic_hassort(maxvar,pfvar,pnvar,dicvar,list,in)
      first = 1
      last = in
      step = +1
    endif
    !
    ! Loop over all variables
    nlisted = 0
    do ivar=first,last,step
      ik = list(ivar)
      !
      ! Check name
      if (name(1:nn).ne.dicvar(ik)%id%name(1:nn))  cycle  ! Next variable
      !
      nlisted = nlisted+1
      if (dopage) then
        if (mod(nlisted,tt_lines).eq.0) then
          if (hlp_more().ne.0)  return
        endif
      endif
      !
      if (dosave) then
        call sic_examine_save(dicvar(ik)%id%name,error)
      elseif (address) then
        call sic_examine_summary(dicvar(ik)%id%name,error)
      else
        if (verbose_struct) then
          ! Short output for %U and %V which are too long in UVDATA
          if (dicvar(ik)%id%name(nn:nn+2).eq.'%U ' .or.  &
              dicvar(ik)%id%name(nn:nn+2).eq.'%V ') then
            call sic_examine_short(dicvar(ik)%id%name,error)
          else
            ! i.e. fully examine this member of the structure
            call sic_examine_full(dicvar(ik)%id%name,error)
          endif
        else
          ! Valued output, in one line
          call sic_examine_short(dicvar(ik)%id%name,error)
        endif
      endif
    enddo
    !
  else
    ! Wilcarded search
    if (global) then
      level = 0
    else
      level = var_level
    endif
    !
    ! Check if one is listing all variables
    call sic_hassort(maxvar,pfvar,pnvar,dicvar,list,in)
    nlisted = 0
    do ivar=1,in
      ik = list(ivar)
      !
      ! Check name
      if (.not.match_string(dicvar(ik)%id%name(1:dicvar(ik)%id%lname),name(1:nn)))  &
                                                 cycle  ! Next variable
      !
      ! Check level
      if (dicvar(ik)%id%level.ne.level)          cycle  ! Next variable
      !
      ! List only variable having a header (/HEADER)
      if (header .and. dicvar(ik)%desc%status.le.0)  cycle  ! Next variable
      !
      ! Drop structure members, but not structure itself.
      ! Be carefull: I want the output when typing EXA SIC%IN*
      if (index(dicvar(ik)%id%name,'%').ne.0 .and.  &  ! Found a structure member
          index(name,'%').eq.0)                     &  ! but the pattern has no '%'
        cycle  ! Next variable
      !
      ! Ok, examine it
      nlisted = nlisted+1
      if (dopage) then
        if (mod(nlisted,tt_lines).eq.0) then
          if (hlp_more().ne.0)  return
        endif
      endif
      !
      call sic_examine_brief(ik,error)
      if (error)  return
      !
    enddo
  endif
  !
end subroutine sic_examine
!
subroutine sic_examine_brief(ik,error)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_examine_brief
  use sic_dictionaries
  use gbl_format
  use examine_parameters
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command SIC\EXAMINE
  ! Print out in short format e.g.
  ! PI              DOUBLE                                       GBL,RD
  !---------------------------------------------------------------------
  integer, intent(in)    :: ik     ! Variable index in dicvar
  logical, intent(inout) :: error  ! Error flag
  ! Local
  integer :: ls,ms,ird
  character(len=2) :: status
  character(len=132) :: msg
  character(len=2) :: rd(2)
  ! Data
  data rd /'RD','WR'/
  !
  ls = dicvar(ik)%id%lname
  ms = 15
  do while (ms.lt.ls)
    ms = ms+8
  enddo
  ls=ms  ! Short variable names will be nicely listed
  if (dicvar(ik)%desc%readonly) then
    ird = 1
  else
    ird = 2
  endif
  !
  call sic_examine_strtype_byid(ik,msg)
  !
  if (address) then
    if (dicvar(ik)%id%level.eq.0) then
      status = 'G'
    else
      write(status,'(I0)') dicvar(ik)%id%level
    endif
    write(6,110) dicvar(ik)%id%name(1:ls),status,trim(msg),  &
      dicvar(ik)%desc%type,     &
      dicvar(ik)%desc%addr,     &
      dicvar(ik)%desc%ndim,     &
      dicvar(ik)%desc%dims(:),  &
      dicvar(ik)%desc%size,     &
      dicvar(ik)%desc%status
  else
    if (dicvar(ik)%id%level.eq.0) then
      write (6,100) dicvar(ik)%id%name(1:ls),trim(msg),'GBL,',rd(ird)
    else
      write(status,'(I0)') dicvar(ik)%id%level
      write (6,109) dicvar(ik)%id%name(1:ls),trim(msg),'LCL('//status//'),',rd(ird)
    endif
  endif
  !
100 format(a,1x,a,t72,a,a,a)
109 format(a,1x,a,t69,a,a,a)
110 format(a,1x,a,a,i5,2x,i0,i2,7(2x,i0),2x,i0,i3)  ! This format for sic_maxdims==7
  !
end subroutine sic_examine_brief
!
subroutine sic_examine_strtype_byname(varname,global,verbose,chain,error)
  use gbl_message
  use sic_interfaces, except_this=>sic_examine_strtype_byname
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ private
  !   Return a type description suited e.g. for EXAMINE. See
  ! sic_examine_strtype_byid for examples
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: varname  ! Variable name
  logical,          intent(in)    :: global   ! Search for global or local?
  logical,          intent(in)    :: verbose  ! Verbose in case of error?
  character(len=*), intent(out)   :: chain    !
  logical,          intent(inout) :: error    ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='EXAMINE'
  integer(kind=4) :: ier,in
  type(sic_identifier_t) :: var
  !
  chain = ""
  !
  ! Should we parse name from dimensions? See sic_parse_dim
  var%name = varname
  var%lname = len_trim(varname)
  if (global) then
    var%level = 0
  else
    var%level = var_level
  endif
  !
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.ne.1) then
    if (verbose)  &
      call sic_message(seve%e,rname,'No such variable '//varname)
    error = .true.
    return
  endif
  !
  call sic_examine_strtype_byid(in,chain)
  !
end subroutine sic_examine_strtype_byname
!
subroutine sic_examine_strtype_byid(ik,msg)
  use gbl_format
  use sic_interfaces, except_this=>sic_examine_strtype_byid
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ private
  ! Return a type description suited e.g. for EXAMINE. Examples:
  !    LOGICAL
  !    CHARACTER*64
  !    INTEGER[3,4]
  !    (STRUCTURE)
  !    (IMAGE)REAL[512,512]
  !    etc
  !---------------------------------------------------------------------
  integer(kind=4),  intent(in)  :: ik   ! Position in global dictionary
  character(len=*), intent(out) :: msg  ! Returned string
  ! Local
  character(len=12) :: stype,what(10)
  integer(kind=4) :: j,utype,n
  ! Data
  data what /'REAL','DOUBLE','INTEGER','LONG','LOGICAL','CHARACTER',  &
             'COMPLEX','(HEADER)','(STRUCTURE)','(TABLE)'/
  !
  msg = ' '
  n = 1
  utype = 0
  if (dicvar(ik)%desc%status.gt.0) then
    stype = '(IMAGE)'
  else
    stype = ' '
  endif
  !
  if (dicvar(ik)%desc%type.eq.0) then
    if (dicvar(ik)%desc%status.gt.0) then
      utype = 8
      write(msg,104) what(utype)
    else
      utype = 9
      write(msg,104) what(utype)
    endif
  elseif (dicvar(ik)%desc%type.gt.0) then
    utype = 6
    write(msg,102) trim(stype),trim(what(utype)),dicvar(ik)%desc%type
  else
    if (dicvar(ik)%desc%type.eq.fmt_r4) then
      utype = 1
    elseif (dicvar(ik)%desc%type.eq.fmt_r8) then
      utype = 2
    elseif (dicvar(ik)%desc%type.eq.fmt_i4) then
      utype = 3
    elseif (dicvar(ik)%desc%type.eq.fmt_i8) then
      utype = 4
    elseif (dicvar(ik)%desc%type.eq.fmt_l) then
      utype = 5
    elseif (dicvar(ik)%desc%type.eq.fmt_c4) then
      utype = 7
    endif
    write(msg,103) trim(stype),what(utype)
  endif
  !
  n = len_trim(msg)
  if (dicvar(ik)%desc%ndim.gt.0) then
    write(msg(n+1:),101) (dicvar(ik)%desc%dims(j),j=1,dicvar(ik)%desc%ndim)
    n = len_trim(msg)
    msg(n:n)=']'
  endif
  !
101 format('[',i0,',',i0,',',i0,',',i0,',',i0,',',i0,',',i0,']')
102 format(a,a,'*',i0)
103 format(a,a)
104 format(a)
end subroutine sic_examine_strtype_byid
!
subroutine sic_examine_summary(name,error)
  use sic_interfaces, except_this=>sic_examine_summary
  use examine_parameters
  !---------------------------------------------------------------------
  ! @ private
  ! Examine the input variable. Output does not display the value and
  ! must fit in one line.
  ! PI                    ! Double  GLOBAL RO
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: name   ! Variable to examine
  logical,          intent(inout) :: error  ! Logical error flag
  !
  call sic_examine_print(name,summary,.false.,6,error)
  !
end subroutine sic_examine_summary
!
subroutine sic_examine_short(name,error)
  use sic_interfaces, except_this=>sic_examine_short
  use examine_parameters
  !---------------------------------------------------------------------
  ! @ private
  ! Examine the input variable. Output (tries to) display the value but
  ! must fit in one line, e.g.
  ! SIC%EDITOR      = emacs            ...  ! Character*  256 GLOBAL RO
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: name   ! Variable to examine
  logical,          intent(inout) :: error  ! Logical error flag
  !
  call sic_examine_print(name,short,.false.,6,error)
  !
end subroutine sic_examine_short
!
subroutine sic_examine_full(name,error)
  use sic_interfaces, except_this=>sic_examine_full
  use examine_parameters
  !---------------------------------------------------------------------
  ! @ private
  ! Examine the input variable. Output can fit in several lines,
  ! e.g. arrays or long strings. Example:
  ! PI              =     3.141592653589793      ! Double  GLOBAL RO
  !---------------------------------------------------------------------
  character(len=*)                :: name   ! Variable to examine
  logical,          intent(inout) :: error  ! Logical error flag
  !
  call sic_examine_print(name,full,.true.,6,error)
  !
end subroutine sic_examine_full
!
subroutine sic_examine_save(name,error)
  use sic_interfaces, except_this=>sic_examine_save
  use examine_parameters
  !---------------------------------------------------------------------
  ! @ private
  ! Examine the input variable. Output is suited for re-execution by Sic
  ! itself. Example:
  ! PI              =     3.141592653589793
  !---------------------------------------------------------------------
  character(len=*)                :: name   ! Variable to examine
  logical,          intent(inout) :: error  ! Logical error flag
  !
  call sic_examine_print(name,full,.false.,savlun,error)
  !
end subroutine sic_examine_save
!
subroutine sic_examine_print(name,mode,incarnable,olun,error)
  use sic_dependencies_interfaces
  use gildas_def
  use sic_structures
  use sic_dictionaries
  use sic_interfaces, except_this=>sic_examine_print
  use sic_types
  use gbl_message
  use gbl_format
  use examine_parameters
  !---------------------------------------------------------------------
  ! @ private
  ! List the variable of specified name. Output displays the value or
  ! not, on 1 or several lines, depending on the tuned mode.
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: name        ! Variable to examine
  integer,          intent(in)    :: mode        ! Verbosity mode
  logical,          intent(in)    :: incarnable  ! Incarnations are allowed?
  integer(kind=4),  intent(in)    :: olun        ! Output LUN
  logical,          intent(inout) :: error       ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='EXAMINE'
  logical :: verbose,isscalar,logi
  integer(kind=4) :: lt,ier,in,type,i,ic,ls,inte,nc
  type(sic_dimensions_t) :: spec
  character(len=11) :: text
  integer(kind=address_length) :: ipnt,addr
  type(sic_descriptor_t) :: desc
  character(len=11) :: what
  character(len=12) :: struct_type
  type(sic_identifier_t) :: var
  integer, parameter :: ll=25
  character(len=ll) :: oneline
  character(len=1024) :: bigline
  character(len=:), allocatable :: str
  real*8 :: double
  real*4 :: value,complex(2)
  integer*8 :: long
  !
  ! Parse name from dimensions...
  spec%do%strict   = .true.   ! Can not be an expression like A[1].eq.B[1]
  spec%do%range    = .true.   ! e.g. A[3:5] allowed
  spec%do%subset   = .true.   ! e.g. A[2,] allowed
  spec%do%implicit = .false.  ! e.g. A[i] forbidden
  spec%do%twospec  = .true.   ! e.g. A[i][j:k] allowed
  verbose  = .true.
  call sic_parse_dim(name,var,spec,verbose,error)
  if (error) return
  !
  ! Find the variable
  if (var_level.eq.0 .or. global) then
    var%level = 0
    text = 'GLOBAL'
    lt = 8
  else
    var%level = var_level
    write(text,'(A,I2)') 'LOCAL ',var_level
    lt = 10
  endif
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.ne.1 .and. var_level.ne.0) then
    var%level = 0
    ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
    text = 'GLOBAL'
    lt = 8
  endif
  if (ier.ne.1) then
    call sic_message(seve%e,rname,'No such variable '//name)
    error =.true.
    return
  endif
  !
  ! Get its incarnation
  call extract_descr(desc,dicvar(in)%desc,spec%done,var%name,incarnable,0,error)
  if (error) then
    if (.not.incarnable)  &
      call sic_message(seve%e,rname,'Incarnation not allowed in this context')
    return
  endif
  !
  ! Kind?
  ! If DESC%OLD = DICVAR(IN)%DESC%OLD, the variable is considered in its entirety:
  what=' Array'
  if (sic_notsamedesc(desc,dicvar(in)%desc))  what=' Sub-Array'
  !
  ! Read-only?
  type = desc%type
  if (desc%readonly)  text(lt:) = 'RO'
  !
  ! Short variable names will be nicely aligned
  ls = len_trim(name)
  if (.not.dosave)  ls = max(15,ls)  ! For alignment cosmetics to screen
  !
  ! Alias?
  if (desc%status.eq.alias_defined) then
    do i=1,nalias
      if (alias(i).eq.in) then
        write (olun,'(A)') name(1:ls)//' is an alias of '//trim(dicali(i)%name)
        exit
      endif
    enddo
  endif
  !
  isscalar = dicvar(in)%desc%ndim.eq.0
  !
  if (type.eq.0) then
    if (desc%status.gt.0) then
      struct_type='! Header'
    else
      ! Retrieve the information associated with the structure name:
      struct_type='! Structure'
    endif
    if (.not.dosave)  &
      write (olun,100) name(1:ls),struct_type,text
  !
  ! CHARACTER
  elseif (type.gt.0) then
    if (dosave) then
      nc = desc%type
      addr = desc%addr
      ic = 1
      do i=1,desc_nelem(desc)
        call destoc(nc,addr,oneline)
        bigline(ic:) = ' "'//trim(oneline)//'"'
        ic = len_trim(bigline)+1
        addr = addr+desc%type
      enddo
      write (olun,102) name(1:ls),' =',bigline(1:ic-1)
    elseif (isscalar) then
      if (mode.eq.short) then  ! Fit in one line
        type = min(type,ll)
        call destoc(type,desc%addr,oneline)
        if (type.gt.ll) oneline(ll-2:ll) = '...'
        write (olun,110) name(1:ls),' = ',oneline,'  ! Character*',desc%type,' ',text
      elseif (mode.eq.full) then
        if (type.gt.ll) then
          write (olun,101) name(1:ls),'       ! Character*',desc%type,' ',text
          allocate(character(desc%type)::str)
          call destoc(desc%type,desc%addr,str)
          write (olun,'(A)') trim(str(1:desc%type))
          deallocate(str)
        else
          call destoc(type,desc%addr,oneline)
          write (olun,102) name(1:ls),' = ',oneline,'  ! Character*',  &
          desc%type,' ',text
        endif
      else
        write (olun,101) name(1:ls),'       ! Character*',desc%type,' ',text
      endif
    else
      write (olun,103) name(1:ls),' is a character*',desc%type,what,  &
      'of dimensions',(desc%dims(i),i=1,desc%ndim)
      if (mode.eq.full) then
        call say_array_ch(desc%addr,desc%type,desc_nelem(desc),'(A)',olun,bigline,.true.,error)
        goto 999
      endif
    endif
  !
  ! LOGICAL
  elseif (type.eq.fmt_l) then
    if (dosave) then
      ipnt = bytpnt(dicvar(in)%desc%addr,membyt)
      ic = 1
      do i=1,desc_nelem(desc)
        call l4tol4(membyt(ipnt),logi,1)
        if (logi) then
          bigline(ic:) = ' yes'
          ic = ic+4
        else
          bigline(ic:) = ' no'
          ic = ic+3
        endif
        ipnt = ipnt+4
      enddo
      write (olun,102) name(1:ls),' =',bigline(1:ic-1)
    elseif (isscalar) then
      if (mode.ge.short) then
        ipnt = bytpnt(dicvar(in)%desc%addr,membyt)
        call l4tol4(membyt(ipnt),logi,1)
        write (olun,104) name(1:ls),' = ',logi,  &
        '                          ! Logical ',text
      else
        write (olun,100) name(1:ls),'       ! Logical ',text
      endif
    else
      write (olun,105) name(1:ls),' is a logical',what,'of dimensions',  &
      (desc%dims(i),i=1,desc%ndim)
      if (mode.eq.full) then
        ipnt = bytpnt(desc%addr,membyt)
        call l_type(desc%size,membyt(ipnt))
      endif
    endif
  !
  ! INTEGER
  elseif (type.eq.fmt_i4) then
    if (dosave) then
      ipnt = bytpnt(dicvar(in)%desc%addr,membyt)
      ic = 1
      do i=1,desc_nelem(desc)
        call i4toi4(membyt(ipnt),inte,1)
        write(bigline(ic:),'(1X,I0)')  inte
        ic = len_trim(bigline)+1
        ipnt = ipnt+4
      enddo
      write (olun,102) name(1:ls),' =',bigline(1:ic-1)
    elseif (isscalar) then
      if (mode.ge.short) then
        ipnt = bytpnt(dicvar(in)%desc%addr,membyt)
        call i4toi4(membyt(ipnt),inte,1)
        write (olun,106) name(1:ls),' = ',inte,'               ! Integer ',text
      else
        write (olun,100) name(1:ls),'       ! Integer ',text
      endif
    else
      write (olun,105) name(1:ls),' is an integer',what,'of dimensions',  &
      (desc%dims(i),i=1,desc%ndim)
      if (mode.eq.full) then
        ipnt = bytpnt(desc%addr,membyt)
        call i4_type(desc%size,membyt(ipnt))
      endif
    endif
  !
  ! LONG
  elseif (type.eq.fmt_i8) then
    if (dosave) then
      ipnt = bytpnt(dicvar(in)%desc%addr,membyt)
      ic = 1
      do i=1,desc_nelem(desc)
        call i8toi8(membyt(ipnt),long,1)
        write(bigline(ic:),'(1X,I0)')  long
        ic = len_trim(bigline)+1
        ipnt = ipnt+8
      enddo
      write (olun,102) name(1:ls),' =',bigline(1:ic-1)
    elseif (isscalar) then
      if (mode.ge.short) then
        ipnt = bytpnt(dicvar(in)%desc%addr,membyt)
        call i8toi8(membyt(ipnt),long,1)
        write (olun,111) name(1:ls),' = ',long,'       ! Long    ',text
      else
        write (olun,100) name(1:ls),'       ! Long    ',text
      endif
    else
      write (olun,105) name(1:ls),' is a long integer',what,'of dimensions',  &
      (desc%dims(i),i=1,desc%ndim)
      if (mode.eq.full) then
        ipnt = bytpnt(desc%addr,membyt)
        call i8_type(desc%size/2,membyt(ipnt))
      endif
    endif
  !
  ! REAL*4
  elseif (type.eq.fmt_r4) then
    if (dosave) then
      ipnt = bytpnt(dicvar(in)%desc%addr,membyt)
      ic = 1
      do i=1,desc_nelem(desc)
        call r4tor4(membyt(ipnt),value,1)
        write(bigline(ic:),'(1X,1PG0.7)')  value
        ic = len_trim(bigline)+1
        ipnt = ipnt+4
      enddo
      write (olun,102) name(1:ls),' =',bigline(1:ic-1)
    elseif (isscalar) then
      if (mode.ge.short) then
        ipnt = bytpnt(dicvar(in)%desc%addr,membyt)
        call r4tor4(membyt(ipnt),value,1)
        write (olun,107) name(1:ls),' = ',value,'            ! Real    ',text
      else
        write (olun,100) name(1:ls),'       ! Real    ',text
      endif
    else
      write (olun,105) name(1:ls),' is a real',what,'of dimensions',  &
      (desc%dims(i),i=1,desc%ndim)
      if (mode.eq.full) then
        ipnt = bytpnt(desc%addr,membyt)
        call r4_type(desc%size,membyt(ipnt))
      endif
    endif
  !
  ! REAL*8
  elseif (type.eq.fmt_r8) then
    if (dosave) then
      ipnt = bytpnt(dicvar(in)%desc%addr,membyt)
      ic = 1
      do i=1,desc_nelem(desc)
        call r8tor8(membyt(ipnt),double,1)
        write(bigline(ic:),'(1X,1PG0.16)')  double
        ic = len_trim(bigline)+1
        ipnt = ipnt+8
      enddo
      write (olun,102) name(1:ls),' =',bigline(1:ic-1)
    elseif (isscalar) then
      if (mode.ge.short) then
        ipnt = bytpnt(dicvar(in)%desc%addr,membyt)
        call r8tor8(membyt(ipnt),double,1)
        write (olun,108) name(1:ls),' = ',double,'  ! Double  ',text
      else
        write (olun,100) name(1:ls),'       ! Double  ',text
      endif
    else
      write (olun,105) name(1:ls),' is a double precision',what,'of dimensions', &
      (desc%dims(i),i=1,desc%ndim)
      if (mode.eq.full) then
        ipnt = bytpnt(desc%addr,membyt)
        call r8_type(desc%size/2,membyt(ipnt))
      endif
    endif
  !
  ! COMPLEX*4
  elseif (type.eq.fmt_c4) then
    if (dosave) then
      write (olun,102) '! ',name(1:ls),' = ?  ! Complex values not available'
    elseif (isscalar) then
      if (mode.ge.short) then
        ipnt = bytpnt(dicvar(in)%desc%addr,membyt)
        call c4toc4(membyt(ipnt),complex,1)
        write (olun,109) name(1:ls),' = ',complex(1),complex(2),  &
        '  ! Complex ',text
      else
        write (olun,100) name(1:ls),'       ! Complex  ',text
      endif
    else
      write (olun,105) name(1:ls),' is a complex',what,'of dimensions',  &
      (desc%dims(i),i=1,desc%ndim)
      if (mode.eq.full) then
        ipnt = bytpnt(desc%addr,membyt)
        call c4_type(desc%size/2,membyt(ipnt))
      endif
    endif
  !
  ! Unknown
  else
    call sic_message(seve%e,rname,'Invalid data format, internal logic error')
  endif
  !
  if (address) then
    ! Print out the descriptor + level
    write(olun,'(A,T28,3(I0,2X))')      'Data type, address, size:',desc%type,desc%addr,desc%size
    write(olun,'(A,T28,L)')             'Header associated:',associated(desc%head)
    write(olun,'(A,T28,8(I0,2X))')      'Ndim, dims:',desc%ndim,desc%dims(:)  ! This format for sic_maxdims==7
    write(olun,'(A,T28,I0,2X,L,2X,I0)') 'Status, read-only, level:',desc%status,desc%readonly,var%level
  endif
  !
  ! Remove scracth memory returned by extract_descr...
999 call sic_volatile(desc)
  return
  !
100 format (20(a))
101 format (a,a,i0,a,a)
102 format (a,a,a,a,i2,a,a)
103 format (a,a,i0,a,a,7(2x,i0))  ! This format for sic_maxdims==7
104 format (a,a,l1,a,a)
105 format (a,a,a,a,7(2x,i0))  ! This format for sic_maxdims==7
106 format (a,a,i12,a,a)   ! 1 standard integer
111 format (a,a,i20,a,a)   ! 1 long integer
107 format (a,a,1pg15.7,a,a)
108 format (a,a,1pg25.16,a,a)
109 format (a,a,'(',1pg15.7,',',1pg15.7,')',a,a)
110 format (a,a,a,a,i0,a,a)
end subroutine sic_examine_print
!
subroutine sic_examine_type(name,utype,error)
  use sic_interfaces, except_this=>sic_examine_type
  use gildas_def
  use sic_structures
  use sic_dictionaries
  use sic_types
  use gbl_message
  use gbl_format
  use examine_parameters
  !---------------------------------------------------------------------
  ! @ private
  ! List the variable of specified name, Local and Globals
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: name    !
  integer,          intent(out)   :: utype   !
  logical,          intent(inout) :: error   ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='EXAMINE'
  integer(kind=4) :: in,ier,type
  logical :: verbose
  type(sic_identifier_t) :: var
  type(sic_descriptor_t) :: desc
  type(sic_dimensions_t) :: spec
  !
  utype = 0
  !
  ! Parse name from dimensions...
  spec%do%strict   = .true.   ! Can not be an expression like A[1].eq.B[1]
  spec%do%range    = .true.   ! e.g. A[3:5] allowed
  spec%do%subset   = .true.   ! e.g. A[2,] allowed
  spec%do%implicit = .false.  ! e.g. A[i] forbidden
  spec%do%twospec  = .true.   ! e.g. A[i][j:k] allowed
  verbose  = .true.
  call sic_parse_dim(name,var,spec,verbose,error)
  if (error) return
  !
  if (var_level.eq.0 .or. global) then
    var%level = 0
  else
    var%level = var_level
  endif
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.ne.1 .and. var_level.ne.0) then
    var%level = 0
    ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  endif
  if (ier.ne.1) then
    call sic_message(seve%e,rname,'Undefined variable '//name)
    error =.true.
    return
  endif
  !
  ! Do not allow incarnation or transposition here
  call extract_descr(desc,dicvar(in)%desc,spec%done,var%name,.false.,0,error)
  if (error) return
  type = desc%type
  !
  if (type.eq.0) then
    if (desc%status.gt.0) then
      ! Header
      utype = 8
    else
      ! Retrieve the information associated with the structure name:
      ! Structure
      utype = 9
    endif
    ! What about utype=10 (table)?
    !
  ! Character variable
  elseif (type.gt.0) then
    utype = 6
    !
  elseif (type.eq.fmt_l) then
    utype = 5
    !
  elseif (type.eq.fmt_i8) then
    utype = 4
    !
  elseif (type.eq.fmt_i4) then
    utype = 3
    !
  elseif (type.eq.fmt_r4) then
    utype = 1
    !
  elseif (type.eq.fmt_r8) then
    utype = 2
    !
  elseif (type.eq.fmt_c4) then
    utype = 7
    !
  else
    call sic_message(seve%e,rname,'Invalid data format, internal logic error')
  endif
  !
end subroutine sic_examine_type
!
subroutine sic_exambigs(name,error)
  use sic_interfaces, except_this=>sic_exambigs
  use sic_structures
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ private
  ! List all matches of specified name, Local and Globals
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: name   !
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  integer :: in,il,ier
  !
  ! List ambiguities...
  ier = sic_hasambigs(maxvar,pfvar,pnvar,dicvar,name,in,il)
  if (ier.eq.0)  error = .true.
  !
end subroutine sic_exambigs
!
subroutine sic_list_alias
  use sic_interfaces, except_this=>sic_list_alias
  use sic_structures
  use sic_dictionaries
  use examine_parameters
  !---------------------------------------------------------------------
  ! @ private
  ! List all the known aliases
  !---------------------------------------------------------------------
  ! Local
  integer :: i,ls,level
  !
  if (nalias.eq.0) return
  !
  if (global) then
    level = 0
  else
    level = var_level
  endif
  !
  do i=1,nalias
    if ( dicvar(alias(i))%id%level.ne.level )  cycle
    !
    ls = index(dicvar(alias(i))%id%name,' ')
    ls = max(ls,15)
    write(6,'(A,A,A)') dicvar(alias(i))%id%name(1:ls),'  =>  ',trim(dicali(i)%name)
  enddo
  !
end subroutine sic_list_alias
!
subroutine sic_debug_variables
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_debug_variables
  use sic_structures
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ private
  !  Support routine for command
  !   SIC DEBUG VARIABLES
  !---------------------------------------------------------------------
  ! Local
  integer(kind=4) :: list(maxvar),ivar,in,ik
  !
  call sic_hassort(maxvar,pfvar,pnvar,dicvar,list,in)
  write(*,'(A)')  '         #  Lev Stat Name'
  do ivar=1,in
    ik = list(ivar)
    call onevar(ik)
  enddo
  ! write(*,'(A,I0,A)') 'Total: ',in,' variables'
  !
  write(*,'(A)')  ' '
  write(*,'(A)')  'Local user-defined variables:'
  do ivar=1,var_n
    ik = var_pointer(ivar)
    call onevar(ik)
  enddo
  !
  write(*,'(A)')  ' '
  write(*,'(A)')  'Global user-defined variables:'
  do ivar=maxvar,var_g,-1
    ik = var_pointer(ivar)
    call onevar(ik)
  enddo
  !
contains
  subroutine onevar(ik)
    integer(kind=4) :: ik
    write(*,'(I4,A,3I4,1X,A)')  &
      ivar,': ',ik,dicvar(ik)%id%level,dicvar(ik)%desc%status,trim(dicvar(ik)%id%name)
  end subroutine onevar
  !
end subroutine sic_debug_variables
