subroutine sicsay (line,nline,error)
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sicsay
  use sic_interactions
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command SAY
  !   SAY 'Expression' "String" 'Character_variable' ...
  ! 1 [/FORMAT  a10 i2 f5.2 ...]
  ! 2 [/NOADVANCE]
  !---------------------------------------------------------------------
  character(len=*)                :: line   !
  integer                         :: nline  !
  logical,          intent(inout) :: error  !
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='SAY'
  ! Note: ARGUM must have at least a length equal to TEXTLENGTH parameter
  ! in 'gwidget.h' .
  character(len=1024) :: argum,chain,string
  integer :: nleft,nchara,nfirst,nremain,iarg,narg,curwidth,lstring,outlun
  integer(kind=address_length) :: ia,ja
  character(len=message_length) :: mess
  logical :: noadvance
  integer(kind=4), parameter :: optformat=1
  integer(kind=4), parameter :: optnoadvance=2
  !
  if (siclun.eq.0) then
    curwidth = sic_ttyncol()
  else
    curwidth = len(chain)
  endif
  !
  noadvance = sic_present(optnoadvance,0)
  !
  ! /FORMAT Option
  if (sic_present(optformat,0)) then
    if (lxwindow) then
      outlun = 0
    else if (siclun.ne.0) then
      outlun = siclun
    else
      outlun = 6  ! stdout
    endif
    narg = sic_narg(0)
    nfirst = 1
    do iarg=1,narg
      ! Concatenate the formatted arguments in a single string
      call say_format_arg(line,iarg,iarg,outlun,string,lstring,error)
      if (error) return
      !
      if (outlun.eq.0) then
        argum(nfirst:) = string(:lstring)
        nfirst = nfirst+lstring
      endif
    enddo
    !
    ! Check for widget creation
    if (lxwindow) then
      if (nfirst.eq.1) then
        call xgag_separator (noptscr)
      else
        ia = locstr(argum)
        ja = bytpnt(ia,membyt)
        call xgag_show (membyt(ja),nfirst-1,noptscr)
      endif
    else if (noadvance) then
      continue
    else
      write(outlun,'(A)') ''  ! Simple carriage return
    endif
  else
    !
    ! Automatic format
    if (lxwindow) then
      curwidth = len(chain)
    endif
    nleft = curwidth           ! Pas 0
    nfirst = 0
    narg = sic_narg(0)
    do iarg=1,narg
      call sic_ch (line,0,iarg,argum,nchara,.true.,error)
      if (error) then
        write(mess,'(A,I0)')  'Could not read argument #',iarg
        call sic_message(seve%e,rname,mess)
        return
      endif
      if (nchara.le.nleft) then
        chain (nfirst+1:) = argum(1:nchara)
        nleft = nleft-nchara-1
        nfirst = nfirst+nchara+1
      else
        if (nfirst.gt.0) then
          if (siclun.ne.0) then
            write(siclun,101) chain(1:nfirst-1)  ! Drop last blank
          else
            write(6,100) chain(1:nfirst-1)  ! Drop last blank
          endif
        endif
        nfirst = 0
        nremain = nchara
        do while (nfirst.lt.nchara)
          if (nremain.le.curwidth) then
            chain = argum(nfirst+1:nchara)
            nleft = curwidth-nremain-1
            nfirst = nchara+2
          else
            !
            if (lxwindow) then
              argum(nfirst+curwidth+1:nfirst+curwidth+1) = char(0)
              ia = locstr(argum)
              ja = bytpnt(ia,membyt)+nfirst
              call xgag_show (membyt(ja),curwidth,noptscr)
            else
              if (siclun.ne.0) then
                write(siclun,101) argum(nfirst+1:nfirst+curwidth)
              else
                write(6,100) argum(nfirst+1:nfirst+curwidth)
              endif
              nfirst = nfirst+curwidth
              nremain = nremain-curwidth
            endif
          endif
        enddo
      endif
    enddo
    !
    ! Check for widget creation
    if (nfirst.gt.0) then
      if (lxwindow) then
        nfirst = len_trim(argum)
        if (nfirst.gt.0) then
          nfirst = nfirst+1
          argum(nfirst:nfirst) = char(0)
          ia = locstr(argum)
          ja = bytpnt(ia,membyt)
          call xgag_show (membyt(ja),nfirst,noptscr)
        else
          call xgag_separator(noptscr)
        endif
      else
        if (siclun.ne.0) then
          write(siclun,101) chain(1:nfirst-1)  ! Drop last blank
        else
          write(6,100) chain(1:nfirst-1)  ! Drop last blank
        endif
      endif
    elseif (lxwindow) then
      call xgag_separator(noptscr)
    endif
  endif
  !
100 format(20(a))
101 format(a)
end subroutine sicsay
!
subroutine sicmsg(line)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sicmsg
  use sic_interactions
  use sic_structures
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  ! Local
  integer :: nl,nt,n1,tt_width
  !
  if (sic_quiet) return
  !
  tt_width = sic_ttyncol()
  nl = len_trim(line)
  n1 = 1
  nt = nl
  do while (n1.le.nl)
    if (nt.le.tt_width) then
      write(6,100) line(n1:nl)
      return
    else
      write(6,100) line(n1:n1+tt_width-1)
      n1 = n1+tt_width
      nt = nt-tt_width
    endif
  enddo
  !
100 format(20(a))
end subroutine sicmsg
!
subroutine say_format_arg(line,iarg,iform,outlun,fmtd_string,lstring,error)
  use sic_dependencies_interfaces
  use gildas_def
  use gbl_format
  use gbl_message
  use sic_interfaces, except_this=>say_format_arg
  use sic_types
  !---------------------------------------------------------------------
  ! @private
  ! From input line, format the iarg-th argument of the command
  ! according to the iform-th format of the option /FORMAT. Formatted
  ! string is returned in fmtd_string, and its usefull length is lstring.
  ! Warnings!
  !  1) /FORMAT option must be the 1st option of the calling command
  !  2) In return, fmtd_string(1:lstring) != fmtd_string
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line         ! Line to analyze
  integer,          intent(in)    :: iarg         ! The arg number to analyze
  integer,          intent(in)    :: iform        ! The format number to be used
  integer,          intent(in)    :: outlun       ! Logical unit to write to (if > 0)
  character(len=*), intent(out)   :: fmtd_string  ! Output string (if outlun == 0)
  integer,          intent(out)   :: lstring      ! Output string usefull length
  logical,          intent(inout) :: error        ! Error status
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='/FORMAT'
  character(len=64) :: forma
  integer(kind=4) :: lforma
  integer(kind=size_length) :: nelem
  integer(kind=address_length) :: ia
  type(sic_descriptor_t) :: inca
  logical :: advance
  character(len=message_length) :: mess
  !
  fmtd_string = ''
  lstring = 0
  !
  call say_getformat(line,iform,forma,lforma,error)
  if (error)  return
  !
  call say_incarnate_arg(line,iarg,forma(1:lforma),inca,error)
  if (error)  return
  !
  nelem = desc_nelem(inca)
  if (inca%type.ge.0) then  ! Character strings
    ! NB: inca%type should be strictly > 0 (chain length), as usually we
    ! can not define empty chains in SIC. But the syntax
    !   SAY 'empty' /FORMAT A  (where "empty" is a fully blank character variable)
    ! creates a zero-length incarnation. Tolerate this possibility, and print as
    ! result a zero-length string. Note that there is no risk of confusion with
    ! headers (type.eq.0) as this is rejected by say_incarnate_arg when it
    ! encounters such a variable.
    advance = .false.  ! Advance only if one item ?
    call say_array_ch(inca%addr,inca%type,nelem,forma(1:lforma),outlun,fmtd_string,advance,error)
  else  ! Numerics
    ia = gag_pointer(inca%addr,memory)
    select case (inca%type)
    case (fmt_r4)
      call say_array_r4(memory(ia),nelem,forma(1:lforma),outlun,fmtd_string,error)
    case (fmt_r8)
      call say_array_r8(memory(ia),nelem,forma(1:lforma),outlun,fmtd_string,error)
    case (fmt_i4)
      call say_array_i4(memory(ia),nelem,forma(1:lforma),outlun,fmtd_string,error)
    case (fmt_i8)
      call say_array_i8(memory(ia),nelem,forma(1:lforma),outlun,fmtd_string,error)
    case (fmt_l)
      call say_array_l4(memory(ia),nelem,forma(1:lforma),outlun,fmtd_string,error)
    case default
      call sic_message(seve%e,rname,'Unsupported data type')
      error = .true.
    end select
  endif
  call sic_volatile(inca)
  !
  if (error) then
    write(mess,'(3A,I0)')  'Error applying format ',forma(1:lforma),' on argument #',iarg
    call sic_message(seve%e,rname,mess)
    return
  endif
  !
  if (outlun.eq.0) then
    ! Drop the last "?"
    lstring = len_trim(fmtd_string)
    if (fmtd_string(lstring:lstring).eq.'?') lstring = lstring-1
  endif
  !
end subroutine say_format_arg
!
subroutine say_getformat(line,iform,forma,lforma,error)
  !---------------------------------------------------------------------
  ! @ private
  ! Retrieve the format from the command line, and format it to make
  ! it applicable on arrays.
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line
  integer(kind=4),  intent(in)    :: iform
  character(len=*), intent(out)   :: forma
  integer(kind=4),  intent(out)   :: lforma
  logical,          intent(inout) :: error
  ! Local
  integer(kind=4), parameter :: optformat=1
  logical :: add_repeat
  integer(kind=4) :: ic
  !
  ! Get the desired format
  call sic_ke(line,optformat,iform,forma,lforma,.true.,error)
  if (error) return
  !
  ! Strip off parentheses if any
  if (forma(1:1).eq.'('  .and. forma(lforma:lforma).eq.')') then
    forma = forma(2:lforma-1)
    lforma = lforma-2
  endif
  !
  ! Check if a repetition is to be added
  if (forma(1:lforma).eq.'*') then
    add_repeat = .false.
  else
    ! Test if format already includes a repetition or not
    ic = ichar(forma(1:1))-ichar('0')
    if (ic.gt.0.and.ic.le.9) then  ! Starts with a numeric
      ! Ignore shifting factors > 9, just test if next character is a shifting code
      add_repeat = forma(2:2).eq.'P'
    else  ! Does not start with a numeric
      add_repeat = .true.
    endif
  endif
  !
  if (add_repeat) then
    ! Repeat it as so-called "unlimited format" to avoid error when
    ! applying a scalar format on an array:
    forma = '*('//forma(1:lforma)//')'
    lforma = lforma+3
  endif
  !
  ! Add parentheses
  forma = '('//forma(1:lforma)//')'
  lforma = lforma+2
  !
end subroutine say_getformat
!
subroutine say_incarnate_arg(line,iarg,forma,inca,error)
  use gbl_message
  use sic_interfaces, except_this=>say_incarnate_arg
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  ! Fetch an incarnation of the argument, according to the type
  ! requested by the format
  !---------------------------------------------------------------------
  character(len=*),       intent(in)    :: line
  integer(kind=4),        intent(in)    :: iarg
  character(len=*),       intent(in)    :: forma
  type(sic_descriptor_t), intent(out)   :: inca
  logical,                intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='SAY'
  logical :: dostring,dointe,dologi,doreal,donative
  type(sic_descriptor_t) :: adesc
  logical :: found
  character(len=argument_length) :: arg
  integer(kind=4) :: larg
  ! Arguments
  logical :: l4
  real(kind=8) :: r8
  integer(kind=8) :: i8
  character(len=argument_length) :: expr
  integer(kind=4) :: lexpr
  !
  dostring = scan(forma,'A').ne.0
  dointe   = scan(forma,'I').ne.0
  dologi   = scan(forma,'L').ne.0
  doreal   = scan(forma,'EFGS').ne.0
  ! Support for * format (but avoid ambiguity with e.g. (*(I3)) )
  donative = .not.dostring .and. .not.dointe  .and. .not.dologi  .and. .not.doreal
  !
  ! Get the argument (as string). Can not use sic_ch as it does not
  ! distinguish variable pi vs string "pi" (i.e. with double-quotes or not).
  larg = sic_len(0,iarg)
  arg = line(sic_start(0,iarg):sic_end(0,iarg))
  !
  ! Try a variable. Materialize possible non-contiguous subset
  found = .false.  ! Not verbose
  call sic_materialize(arg(1:larg),adesc,found)
  !
  if (found) then
    ! Incarnate an existing variable to proper type
    if (donative) then
      call copy_descr(adesc,inca,error)
      if (error)  goto 10
    elseif (dostring) then
      if (adesc%type.gt.0) then
        call copy_descr(adesc,inca,error)
        if (error)  goto 10
      else
        call sic_message(seve%e,rname,'Can not print a non-character variable with format A')
        error = .true.
        goto 10
      endif
    elseif (dointe) then
      call sic_incarnate_desc(fmt_i8,adesc,inca,error)
      if (error)  goto 10
    elseif (dologi) then
      if (adesc%type.eq.fmt_l) then
        call copy_descr(adesc,inca,error)
        if (error)  goto 10
      else
        ! This could be implemented in sic_incarnate_desc, following
        ! Fortran standard rules.
        call sic_message(seve%e,rname,'Can not print a non-logical variable with format L')
        error = .true.
        goto 10
      endif
    else
      call sic_incarnate_desc(fmt_r8,adesc,inca,error)
      if (error)  goto 10
    endif
    !
  else
    ! Incarnate the argument under proper type
    if (dostring.or.donative) then
      call sic_ch(line,0,iarg,expr,lexpr,.true.,error)
      if (error)  goto 10
      call sic_incarnate(expr(1:lexpr),inca,error)
      if (error)  goto 10
    elseif (dointe) then
      call sic_i8(line,0,iarg,i8,.true.,error)
      if (error)  goto 10
      call sic_incarnate(i8,inca,error)
      if (error)  goto 10
    elseif (dologi) then
      call sic_l4(line,0,iarg,l4,.true.,error)
      if (error)  goto 10
      call sic_incarnate(l4,inca,error)
      if (error)  goto 10
    else
      call sic_r8(line,0,iarg,r8,.true.,error)
      if (error)  goto 10
      call sic_incarnate(r8,inca,error)
      if (error)  goto 10
    endif
  endif
  !
10 continue
  if (sic_notsamedesc(adesc,inca))  call sic_volatile(adesc)
  !
end subroutine say_incarnate_arg
!
subroutine say_array_r4(array,na,form,lun,string,error)
  use sic_dependencies_interfaces
  use sic_interfaces
  use gildas_def
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in)    :: na         ! Length of array
  real(kind=4),              intent(in)    :: array(na)  ! Array of values
  character(len=*),          intent(in)    :: form       ! Output format
  integer(kind=4),           intent(in)    :: lun        ! Output unit
  character(len=*),          intent(out)   :: string     ! Output string (used if lun=0)
  logical,                   intent(inout) :: error      ! Error code
  ! Local
  integer(kind=4) :: ier
  !
  if (form.ne.'(*)') then
    if (lun.eq.0) then
      write(string,form,iostat=ier) array
    else
      write(lun,form,iostat=ier,advance='NO') array
    endif
  else
    if (lun.eq.0) then
      write(string,*,iostat=ier) array
    else
      write(lun,*,iostat=ier) array
    endif
  endif
  !
  if (ier.ne.0) then
    write (*,'(A)') form
    call putios('E-SAY,  ',ier)
    error = .true.
  endif
end subroutine say_array_r4
!
subroutine say_array_r8(array,na,form,lun,string,error)
  use sic_dependencies_interfaces
  use sic_interfaces
  use gildas_def
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in)    :: na         ! Length of array
  real(kind=8),              intent(in)    :: array(na)  ! Array of values
  character(len=*),          intent(in)    :: form       ! Output format
  integer(kind=4),           intent(in)    :: lun        ! Output unit
  character(len=*),          intent(out)   :: string     ! Output string (used if lun=0)
  logical,                   intent(inout) :: error      ! Error code
  ! Local
  integer(kind=4) :: ier
  !
  if (form.ne.'(*)') then
    if (lun.eq.0) then
      write(string,form,iostat=ier) array
    else
      write(lun,form,iostat=ier,advance='NO') array
    endif
  else
    if (lun.eq.0) then
      write(string,*,iostat=ier) array
    else
      write(lun,*,iostat=ier) array
    endif
  endif
  !
  if (ier.ne.0) then
    write (*,'(A)') form
    call putios('E-SAY,  ',ier)
    error = .true.
  endif
end subroutine say_array_r8
!
subroutine say_array_i4(array,na,form,lun,string,error)
  use sic_dependencies_interfaces
  use sic_interfaces
  use gildas_def
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in)    :: na         ! Length of array
  integer(kind=4),           intent(in)    :: array(na)  ! Array of values
  character(len=*),          intent(in)    :: form       ! Output format
  integer(kind=4),           intent(in)    :: lun        ! Output unit
  character(len=*),          intent(out)   :: string     ! Output string (used if lun=0)
  logical,                   intent(inout) :: error      ! Error code
  ! Local
  integer(kind=4) :: ier
  !
  ier = 0
  if (form.ne.'(*)') then
    if (lun.eq.0) then
      write(string,form,iostat=ier) array
    else
      write(lun,form,iostat=ier,advance='NO') array
    endif
  else
    if (lun.eq.0) then
      write(string,*,iostat=ier) array
    else
      write(lun,*,iostat=ier) array
    endif
  endif
  !
  if (ier.ne.0) then
    write (*,'(A)') form
    call putios('E-SAY,  ',ier)
    error = .true.
  endif
end subroutine say_array_i4
!
subroutine say_array_i8(array,na,form,lun,string,error)
  use sic_dependencies_interfaces
  use sic_interfaces
  use gildas_def
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in)    :: na         ! Length of array
  integer(kind=8),           intent(in)    :: array(na)  ! Array of values
  character(len=*),          intent(in)    :: form       ! Output format
  integer(kind=4),           intent(in)    :: lun        ! Output unit
  character(len=*),          intent(out)   :: string     ! Output string (used if lun=0)
  logical,                   intent(inout) :: error      ! Error code
  ! Local
  integer(kind=4) :: ier
  !
  if (form.ne.'(*)') then
    if (lun.eq.0) then
      write(string,form,iostat=ier) array
    else
      write(lun,form,iostat=ier,advance='NO') array
    endif
  else
    if (lun.eq.0) then
      write(string,*,iostat=ier) array
    else
      write(lun,*,iostat=ier) array
    endif
  endif
  !
  if (ier.ne.0) then
    write (*,'(A)') form
    call putios('E-SAY,  ',ier)
    error = .true.
  endif
end subroutine say_array_i8
!
subroutine say_array_l4(array,na,form,lun,string,error)
  use sic_dependencies_interfaces
  use sic_interfaces
  use gildas_def
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in)    :: na         ! Length of array
  logical,                   intent(in)    :: array(na)  ! Array of values
  character(len=*),          intent(in)    :: form       ! Output format
  integer(kind=4),           intent(in)    :: lun        ! Output unit
  character(len=*),          intent(out)   :: string     ! Output string (used if lun=0)
  logical,                   intent(inout) :: error      ! Error code
  ! Local
  integer(kind=4) :: ier
  !
  if (form.ne.'(*)') then
    if (lun.eq.0) then
      write(string,form,iostat=ier) array
    else
      write(lun,form,iostat=ier,advance='NO') array
    endif
  else
    if (lun.eq.0) then
      write(string,*,iostat=ier) array
    else
      write(lun,*,iostat=ier) array
    endif
  endif
  !
  if (ier.ne.0) then
    write (*,'(A)') form
    call putios('E-SAY,  ',ier)
    error = .true.
  endif
end subroutine say_array_l4
!
subroutine say_array_ch(addr,nc,na,form,lun,string,advance,error)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>say_array_ch
  use gildas_def
  use iso_fortran_env
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  integer(kind=address_length), intent(in)    :: addr     ! Address of first element
  integer(kind=4),              intent(in)    :: nc       ! Full length of 1 element
  integer(kind=size_length),    intent(in)    :: na       ! Number of elements in array
  character(len=*),             intent(in)    :: form     ! Format to be used
  integer,                      intent(in)    :: lun      ! Send output to this logical unit
  character(len=*),             intent(inout) :: string   ! Output string (used if lun=0)
  logical,                      intent(in)    :: advance  ! Advancing or not ?
  logical,                      intent(inout) :: error    ! Error flag
  ! Local
  integer :: ier, i, ma
  integer(kind=size_length) :: ia
  integer(kind=address_length) :: myaddr
  character(len=:), allocatable :: array(:)
  !
  if (lun.eq.0) then
    ma = na+1
  else
    ma = na
  endif
  allocate(character(nc)::array(ma),stat=ier)
  if (failed_allocate('SAY','character array',ier,error))  return
  !
  ! Fill temporary array with proper character length and number of elements
  myaddr = addr
  do ia=1,na
    call destoc(nc,myaddr,array(ia))
    myaddr = myaddr+nc
  enddo
  if (lun.eq.0) array(ma) = '?'
  !
  if (form.ne.'(*)') then
    if (lun.eq.0) then
      write(string,form,iostat=ier) array
    else if (advance) then
      do i=1,ma
        write(lun,form,iostat=ier) array(i)
      enddo
    else
      write(lun,form,iostat=ier,advance='NO') array
    endif
  else
    ! Free format, force advance
    if (lun.eq.0) then
      write(string,*,iostat=ier) array
    else
      write(lun,*,iostat=ier) array
    endif
  endif
  !
  if (ier.ne.0) then
    write (*,'(A)') form
    call putios('E-SAY,  ',ier)
    error = .true.
  endif
end subroutine say_array_ch
