!-----------------------------------------------------------------------
! Support file for intrinsic functions in Sic
!-----------------------------------------------------------------------
!
subroutine get_funcode(chain,i_code,nfunarg,error)
  use sic_interfaces, except_this=>get_funcode
  use sic_dictionaries
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !   Sends back a code for the function contained in CHAIN
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: chain       ! The line to be analysed
  integer(kind=4),  intent(out)   :: i_code      ! Code for function
  integer(kind=4),  intent(out)   :: nfunarg(2)  ! Min-max number of arguments
  logical,          intent(inout) :: error       ! Logical error flag
  ! Global
  integer(kind=4) :: gpy_findfunc
  ! Local
  character(len=*), parameter :: rname='MTH'
  !
  ! First should check for user defined functions
  select case (chain)
  !
  ! One operand functions
  case ('ABS')
    i_code = code_abs
    nfunarg = 1
  case ('ACOS')
    i_code = code_acos
    nfunarg = 1
  case ('ASIN')
    i_code = code_asin
    nfunarg = 1
  case ('ATAN')
    i_code = code_atan
    nfunarg = 1
  case ('ATANH')
    i_code = code_atanh
    nfunarg = 1
  case ('BESSEL_I0')
    i_code = code_bessel_i0
    nfunarg = 1
  case ('BESSEL_I1')
    i_code = code_bessel_i1
    nfunarg = 1
  case ('BESSEL_J0')
    i_code = code_bessel_j0
    nfunarg = 1
  case ('BESSEL_J1')
    i_code = code_bessel_j1
    nfunarg = 1
  case ('BESSEL_Y0')
    i_code = code_bessel_y0
    nfunarg = 1
  case ('BESSEL_Y1')
    i_code = code_bessel_y1
    nfunarg = 1
  case ('COS')
    i_code = code_cos
    nfunarg = 1
  case ('COSH')
    i_code = code_cosh
    nfunarg = 1
  case ('ERF')
    i_code = code_erf
    nfunarg = 1
  case ('ERFC')
    i_code = code_erfc
    nfunarg = 1
  case ('ERFINV')
    i_code = code_erfinv
    nfunarg = 1
  case ('ERFCINV')
    i_code = code_erfcinv
    nfunarg = 1
  case ('EXP')
    i_code = code_exp
    nfunarg = 1
  case ('INT')
    i_code = code_int
    nfunarg = 1
  case ('LOG')
    i_code = code_log
    nfunarg = 1
  case ('LOG10')
    i_code = code_log10
    nfunarg = 1
  case ('NINT')
    i_code = code_nint
    nfunarg = 1
  case ('SIN')
    i_code = code_sin
    nfunarg = 1
  case ('SINH')
    i_code = code_sinh
    nfunarg = 1
  case ('SQRT')
    i_code = code_sqrt
    nfunarg = 1
  case ('TAN')
    i_code = code_tan
    nfunarg = 1
  case ('TANH')
    i_code = code_tanh
    nfunarg = 1
  case ('FLOOR')
    i_code = code_floor
    nfunarg = 1
  case ('CEILING')
    i_code = code_ceiling
    nfunarg = 1
  case ('EXIST')
    i_code = code_exist
    nfunarg = 1
  case ('FILE')
    i_code = code_file
    nfunarg = 1
  case ('FUNCTION')
    i_code = code_function
    nfunarg = 1
  case ('SYMBOL')
    i_code = code_symbol
    nfunarg = 1
  !
  ! Function with 2 arguments or more
  case ('MAX')
    i_code = code_max
    nfunarg = 2
  case ('MIN')
    i_code = code_min
    nfunarg = 2
  case ('ATAN2')
    i_code = code_atan2
    nfunarg = 2
  case ('BESSEL_IN')
    i_code = code_bessel_in
    nfunarg = 2
  case ('BESSEL_JN')
    i_code = code_bessel_jn
    nfunarg = 2
  case ('BESSEL_YN')
    i_code = code_bessel_yn
    nfunarg = 2
  case ('DIM')
    i_code = code_dim
    nfunarg = 2
  case ('MOD')
    i_code = code_mod
    nfunarg = 2
  case ('SIGN')
    i_code = code_sign
    nfunarg = 2
    !
  case ('TYPEOF')
    i_code = code_typeof
    nfunarg = 1
  case ('RANK')
    i_code = code_rank
    nfunarg = 1
  case ('SIZE')
    i_code = code_size
    nfunarg(1) = 1  ! At least 1 arg
    nfunarg(2) = 2  ! At most 2 args
  case ('LEN')
    i_code = code_len
    nfunarg = 1
  case ('LEN_TRIM')
    i_code = code_len_trim
    nfunarg = 1
  case ('ALL')
    i_code = code_all
    nfunarg = 1
  case ('ANY')
    i_code = code_any
    nfunarg = 1
  case ('ISNAN')
    i_code = code_isnan
    nfunarg = 1
  case ('ISNUM')
    i_code = code_isnum
    nfunarg = 1
  !
  ! Try a program-defined function
  case default
    call sic_get_func(chain,i_code,nfunarg,error)
    if (error) then
#if defined(GAG_USE_PYTHON)
      if (gpy_findfunc(chain,len_trim(chain)).eq.0) then
        i_code = code_pyfunc
        nfunarg = 0
        error = .false.
      else
        call sic_message(seve%e,rname,'Unknown function '//chain)
      endif
#else
      call sic_message(seve%e,rname,'Unknown function '//chain)
#endif
    endif
  end select
end subroutine get_funcode
!
recursive subroutine read_operand_byfunc(funcode,chain,nch,descr,error)
  use gbl_message
  use sic_interfaces, except_this=>read_operand_byfunc
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Specific operand parsing for functions which do not accept
  ! numerical operands as arguments.
  !  Recursive for e.g. evaluating ANY(A.EQ.1). The function ANY invokes
  ! its own build_tree+read_operand_byfunc to compute the array 'A.EQ.1'
  !---------------------------------------------------------------------
  integer(kind=4),        intent(inout) :: funcode  ! Function code, emptied in return
  character(len=*),       intent(in)    :: chain    ! The operand
  integer(kind=4),        intent(in)    :: nch      ! Length of chain
  type(sic_descriptor_t)                :: descr    ! Resulting descriptor of operand
  logical,                intent(inout) :: error    ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='MTH'
  !
  select case (funcode)
  case (code_exist)
    call read_operand_exist(chain,nch,descr,error)
    funcode = code_nop
    !
  case (code_file)
    call read_operand_file (chain,nch,descr,error)
    funcode = code_nop
    !
  case (code_typeof,code_rank)
    call read_operand_descr(chain,nch,funcode,descr,error)
    funcode = code_nop
    !
  case (code_function)
    call read_operand_func(chain,nch,descr,error)
    funcode = code_nop
    !
  case (code_symbol)
    call read_operand_symb(chain,nch,descr,error)
    funcode = code_nop
    !
  case (code_len)
    call read_operand_len(chain,nch,.false.,descr,error)
    funcode = code_nop
    !
  case (code_len_trim)
    call read_operand_len(chain,nch,.true.,descr,error)
    funcode = code_nop
    !
  case (code_all)
    call read_operand_allorany(chain,nch,.true.,descr,error)
    funcode = code_nop
    !
  case (code_any)
    call read_operand_allorany(chain,nch,.false.,descr,error)
    funcode = code_nop
    !
  case (code_isnan)
    call read_operand_isnan(chain,nch,descr,error)
    funcode = code_nop
    !
  case (code_isnum)
    call read_operand_isnum(chain,nch,descr,error)
    funcode = code_nop
    !
  case default
    call read_operand(chain,nch,descr,error)
    ! Keep code for other "normal" functions
    !
  end select
  !
  if (error) then
    call sic_message(seve%e,rname,'Error reading operand '//chain(1:nch))
    return
  endif
  !
end subroutine read_operand_byfunc
!
subroutine read_operand_exist(chain,nch,descr,error)
  use gildas_def
  use sic_interactions
  use sic_interfaces, except_this=>read_operand_exist
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Find if a variable exist...
  !---------------------------------------------------------------------
  character(len=*),       intent(in)  :: chain  ! Chain containing operand
  integer(kind=4),        intent(in)  :: nch    ! Length of chain
  type(sic_descriptor_t), intent(out) :: descr  ! Operand descriptor
  logical,                intent(out) :: error  ! Logical error flag
  ! Local
  logical :: found
  integer(kind=4) :: ip
  !
  error = .false.
  !
  ! Removes closing parenthesis. Not very efficient: their index is known from
  ! GET_LEVEL
  ip = nch
  do while (ip.ge.1 .and. (chain(ip:ip).eq.')'.or.chain(ip:ip).eq.' '))
    ip = ip-1
  enddo
  !
  ! It must be a variable.
  found = .true.
  call sic_descriptor (chain(1:ip),descr,found)    ! Checked
  if (.not.found) then
    call sic_descriptor ('NO',descr,found) ! Checked
  else
    call sic_descriptor ('YES',descr,found)    ! Checked
  endif
  descr%readonly = .false.
  descr%status = readonly_operand
end subroutine read_operand_exist
!
subroutine read_operand_descr(chain,nch,funcode,descr,error)
  use gbl_message
  use sic_interfaces, except_this=>read_operand_descr
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Get one of the variable descriptor properties
  !---------------------------------------------------------------------
  character(len=*),       intent(in)    :: chain    ! Chain containing operand
  integer(kind=4),        intent(in)    :: nch      ! Length of chain
  integer(kind=4),        intent(in)    :: funcode  ! Function code
  type(sic_descriptor_t), intent(out)   :: descr    ! Operand descriptor
  logical,                intent(inout) :: error    ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='MTH'
  logical :: found
  integer(kind=4) :: ip,val
  !
  error = .false.
  !
  ! Removes closing parenthesis. Not very efficient: their index is known from
  ! GET_LEVEL
  ip = nch
  do while (ip.ge.1 .and. (chain(ip:ip).eq.')'.or.chain(ip:ip).eq.' '))
    ip = ip-1
  enddo
  !
  ! It must be a variable.
  found = .true.
  call sic_descriptor (chain(1:ip),descr,found)    ! Checked
  if (.not.found) then
    call sic_message(seve%e,rname,'No such variable '//chain(1:ip))
    error = .true.
    return
  endif
  !
  ! Put the desired value in a temporary variable
  if (funcode.eq.code_typeof) then
    val = descr%type
  elseif (funcode.eq.code_rank) then
    val = descr%ndim
  endif
  !
  ! Put the value in a temporary variable
  call sic_incarnate(val,descr,error)
  if (error)  return
  !
end subroutine read_operand_descr
!
subroutine read_operand_len(chain,nch,trimmed,descr,error)
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>read_operand_len
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Return the length (trimmed or not) of a Sic variable
  !---------------------------------------------------------------------
  character(len=*),       intent(in)    :: chain    ! Chain containing operand
  integer(kind=4),        intent(in)    :: nch      ! Length of chain
  logical,                intent(in)    :: trimmed  ! Trimmed value?
  type(sic_descriptor_t), intent(out)   :: descr    ! Operand descriptor
  logical,                intent(inout) :: error    ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=8) :: rname
  logical :: found
  integer(kind=4) :: ip,length
  character(len=1) :: onechar
  integer(kind=address_length) :: ipnt
  !
  if (trimmed) then
    rname = 'LEN_TRIM'
  else
    rname = 'LEN'
  endif
  !
  ! Removes closing parenthesis. Not very efficient: their index is known from
  ! GET_LEVEL
  ip = nch
  do while (ip.ge.1 .and. (chain(ip:ip).eq.')'.or.chain(ip:ip).eq.' '))
    ip = ip-1
  enddo
  !
  ! It must be a variable. NB: it seems difficult to allow plain text
  ! strings e.g. SAY 'LEN("ABC")', because of complicated combinations
  ! like in IF LEN_TRIM("PI = "'PI').GT.0 THEN
  found = .true.  ! Verbose
  call sic_descriptor(chain(1:ip),descr,found)
  if (.not.found) then
    call sic_message(seve%e,rname,'No such variable '//chain(1:ip))
    error = .true.
    return
  elseif (descr%ndim.ne.0) then
    call sic_message(seve%e,rname,'Variable '//chain(1:ip)//' must be scalar')
    error = .true.
    return
  elseif (descr%type.le.0) then
    call sic_message(seve%e,rname,  &
      'Variable '//chain(1:ip)//' must be a character string')
    error = .true.
    return
  else
    if (trimmed) then
      ! Avoid copy in a (limited) temporary string
      do while (descr%type.ge.1)
        ipnt = bytpnt(descr%addr,membyt)+descr%type-1
        call bytoch(membyt(ipnt),onechar,1)
        if (onechar.ne.' ')  exit
        descr%type = descr%type-1  ! Try previous character
      enddo
    endif
    length = descr%type
  endif
  !
  ! Put the value in a temporary variable
  call sic_incarnate(length,descr,error)
  if (error)  return
  !
end subroutine read_operand_len
!
subroutine read_operand_symb(chain,nch,descr,error)
  use gildas_def
  use sic_dependencies_interfaces
  use sic_structures
  use sic_interactions
  use sic_interfaces, except_this=>read_operand_symb
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Find if a SYMBOL exist...
  !---------------------------------------------------------------------
  character(len=*),       intent(in)    :: chain  ! Chain containing operand
  integer(kind=4),        intent(in)    :: nch    ! Length of chain
  type(sic_descriptor_t), intent(out)   :: descr  ! Operand descriptor
  logical,                intent(inout) :: error  ! Logical error flag
  ! Local
  logical :: found
  integer(kind=4) :: ip
  character(len=32) :: tran
  !
  ! Removes closing parenthesis. Not very efficient: their index is known from
  ! GET_LEVEL
  ip = nch
  do while (ip.ge.1 .and. (chain(ip:ip).eq.')'.or.chain(ip:ip).eq.' '))
    ip = ip-1
  enddo
  !
  ! Check if it exists and is not Void
  call sic_getsymbol(chain(1:ip),tran,error)
  if (error.or.(len_trim(tran).eq.0)) then
    call sic_descriptor ('NO',descr,found)
    error = .false.
  else
    call sic_descriptor ('YES',descr,found)
  endif
  descr%readonly = .false.
  descr%status = readonly_operand       ! READ status in module 'sic_dictionaries'
end subroutine read_operand_symb
!
subroutine read_operand_func(chain,nch,descr,error)
  use gildas_def
  use sic_dependencies_interfaces
  use sic_structures
  use sic_interactions
  use sic_interfaces, except_this=>read_operand_func
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Find if a function exist...
  !---------------------------------------------------------------------
  character(len=*),       intent(in)    :: chain  ! Chain containing operand
  integer(kind=4),        intent(in)    :: nch    ! Length of chain
  type(sic_descriptor_t), intent(out)   :: descr  ! Operand descriptor
  logical,                intent(inout) :: error  ! Logical error flag
  ! Local
  logical :: found
  integer(kind=4) :: ip,i
  !
  ! Removes closing parenthesis. Not very efficient: their index is known from
  ! GET_LEVEL
  ip = nch
  do while (ip.ge.1 .and. (chain(ip:ip).eq.')'.or.chain(ip:ip).eq.' '))
    ip = ip-1
  enddo
  !
  ! Check if it exists
  i = sic_get_expr(chain(1:ip),ip)
  if (i.ne.0) then
    call sic_descriptor ('YES',descr,found)
  else
    call sic_descriptor ('NO',descr,found)
  endif
  descr%readonly = .false.
  descr%status = readonly_operand       ! READ status in module 'sic_dictionaries'
end subroutine read_operand_func
!
subroutine read_operand_file(chain,nch,descr,error)
  use gildas_def
  use sic_dependencies_interfaces
  use sic_structures
  use sic_interactions
  use sic_interfaces, except_this=>read_operand_file
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Find if a file exist...
  !  The input file name (CHAIN) can be any "implicitely formatted" SIC
  ! expression.
  !---------------------------------------------------------------------
  character(len=*),       intent(in)    :: chain  ! Chain containing operand
  integer(kind=4),        intent(in)    :: nch    ! Length of chain
  type(sic_descriptor_t), intent(out)   :: descr  ! Operand descriptor
  logical,                intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=filename_length) :: name,file,nami
  logical :: found
  integer(kind=4) :: ip,larg,iarg
  !
  ! Removes closing parenthesis. Not very efficient: their index is known from
  ! GET_LEVEL
  ip = nch
  do while (ip.ge.1 .and. (chain(ip:ip).eq.')'.or.chain(ip:ip).eq.' '))
    ip = ip-1
  enddo
  !
  ! Debugged by S.Guilloteau 15-May-2000
  !
  ! It must be a file name, possibly coded, e.g. a variable name 'MYVAR'.
  ! Two calls to SIC_EXPAND required.
  call sic_expand(nami,chain,1,ip,iarg,error)
  call sic_expand(name,nami,1,iarg,larg,error)
  !
  ! Check just in case
  if (name(1:larg).eq.chain(1:ip)) then
    call sic_get_char(name,nami,iarg,error)
    if (iarg.ne.0) then
      name = nami
      larg = iarg
    endif
    error = .false.
  endif
  if (error) return
  !
  ! Use the generic search, which returns the file name even if a path
  ! is specified in the logical name field.
  if (sic_findfile(name,file,' ',' ')) then
    call sic_descriptor ('YES',descr,found)
  else
    call sic_descriptor ('NO',descr,found)
  endif
  descr%readonly = .false.
  descr%status = readonly_operand       ! READ status in module 'sic_dictionaries'
end subroutine read_operand_file
!
subroutine read_operand_allorany(chain,nch,doall,odesc,error)
  use gildas_def
  use gbl_format
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>read_operand_allorany
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Return true if all or any elements of a logical array are true
  !---------------------------------------------------------------------
  character(len=*),       intent(in)  :: chain  ! Chain containing operand
  integer(kind=4),        intent(in)  :: nch    ! Length of chain
  logical,                intent(in)  :: doall  ! Do ALL or ANY?
  type(sic_descriptor_t), intent(out) :: odesc  ! Output descriptor
  logical,                intent(out) :: error  ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  logical, external :: all_or_any
  ! Local
  character(len=3) :: rname
  logical :: found
  integer(kind=4) :: nc
  integer(kind=address_length) :: ip
  type(sic_descriptor_t) :: idesc
  !
  if (doall) then
    rname = 'ALL'
  else
    rname = 'ANY'
  endif
  !
  error = .false.
  !
  ! Removes closing parenthesis. Not very efficient: their index is known from
  ! GET_LEVEL
  nc = nch
  do while (nc.ge.1 .and. (chain(nc:nc).eq.')'.or.chain(nc:nc).eq.' '))
    nc = nc-1
  enddo
  !
  ! It can be a variable. Non-contiguous sub-arrays allowed.
  found = .true.  ! Verbose
  call sic_materialize(chain(1:nc),idesc,found)
  if (.not.found) then
    ! Not a variable. Try to evaluate a vectorized logical expression
    call sic_math_desc(chain,nc,fmt_l,desc=idesc,error=error)
    if (error) then
      call sic_message(seve%e,rname,'Invalid logical expression '//chain(1:nc))
      return
    endif
  endif
  if (idesc%type.ne.fmt_l) then
    call sic_message(seve%e,rname,  &
      'Variable '//chain(1:nc)//' must a logical variable or expression')
    error = .true.
    call sic_volatile(idesc)
    return
  endif
  !
  ip = gag_pointer(idesc%addr,memory)
  found = .false.
  if (all_or_any(memory(ip),desc_nelem(idesc),doall)) then
    call sic_descriptor('YES',odesc,found)
  else
    call sic_descriptor('NO',odesc,found)
  endif
  odesc%readonly = .false.
  odesc%status = readonly_operand       ! READ status in module 'sic_dictionaries'
  call sic_volatile(idesc)
  !
end subroutine read_operand_allorany
!
function all_or_any(l,n,doall)
  use gildas_def
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Evaluate ALL(L) or ANY(L)
  !---------------------------------------------------------------------
  logical :: all_or_any  ! Function value on return
  integer(kind=size_length), intent(in) :: n
  logical,                   intent(in) :: l(n)
  logical,                   intent(in) :: doall
  if (doall) then
    all_or_any = all(l)
  else
    all_or_any = any(l)
  endif
end function all_or_any
!
subroutine read_operand_isnan(chain,nch,odesc,error)
  use gildas_def
  use gbl_format
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>read_operand_isnan
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Return a logical array which is true for each value evaluating as
  ! NaN
  !---------------------------------------------------------------------
  character(len=*),       intent(in)  :: chain  ! Chain containing operand
  integer(kind=4),        intent(in)  :: nch    ! Length of chain
  type(sic_descriptor_t), intent(out) :: odesc  ! Output descriptor
  logical,                intent(out) :: error  ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='ISNAN'
  logical :: found
  integer(kind=4) :: nc,ier
  integer(kind=address_length) :: ip,op
  type(sic_descriptor_t) :: idesc
  !
  error = .false.
  !
  ! Removes closing parenthesis. Not very efficient: their index is known from
  ! GET_LEVEL
  nc = nch
  do while (nc.ge.1 .and. (chain(nc:nc).eq.')'.or.chain(nc:nc).eq.' '))
    nc = nc-1
  enddo
  !
  ! It can be a variable. Non-contiguous sub-arrays allowed.
  found = .true.  ! Verbose
  call sic_materialize(chain(1:nc),idesc,found)
  if (.not.found) then
    ! Not a variable. Try to evaluate a vectorized logical expression
    call sic_math_desc(chain,nc,fmt_r8,desc=idesc,error=error)
    if (error) then
      call sic_message(seve%e,rname,'Invalid expression '//chain(1:nc))
      return
    endif
  endif
  if (idesc%type.ne.fmt_r4 .and.  &
      idesc%type.ne.fmt_r8) then
    ! We could tolerate integers. Unclear for complex.
    call sic_message(seve%e,rname,  &
      'Variable '//chain(1:nc)//' must a floating point variable or expression')
    error = .true.
    call sic_volatile(idesc)
    return
  endif
  !
  ! Create a clone of same size but logical
  odesc%type = fmt_l
  odesc%ndim = idesc%ndim
  odesc%dims(:) = idesc%dims(:)
  odesc%size = desc_nelem(odesc)
  ier = sic_getvm(odesc%size,odesc%addr)
  if (ier.ne.1)  goto 10
  odesc%head => null()
  odesc%status = scratch_operand
  odesc%readonly = .false.
  ! Fill it
  ip = gag_pointer(idesc%addr,memory)
  op = gag_pointer(odesc%addr,memory)
  if (idesc%type.eq.fmt_r4) then
    call isnan_r4(memory(ip),memory(op),desc_nelem(idesc))
  else
    call isnan_r8(memory(ip),memory(op),desc_nelem(idesc))
  endif
  !
10 continue
  call sic_volatile(idesc)
  !
end subroutine read_operand_isnan
!
subroutine isnan_r4(in,out,n)
  use ieee_arithmetic
  use gildas_def
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in)  :: n
  real(kind=4),              intent(in)  :: in(n)
  logical,                   intent(out) :: out(n)
  ! Local
  integer(kind=size_length) :: i
  do i=1,n
    out(i) = ieee_is_nan(in(i))
  enddo
end subroutine isnan_r4
!
subroutine isnan_r8(in,out,n)
  use ieee_arithmetic
  use gildas_def
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in)  :: n
  real(kind=8),              intent(in)  :: in(n)
  logical,                   intent(out) :: out(n)
  ! Local
  integer(kind=size_length) :: i
  do i=1,n
    out(i) = ieee_is_nan(in(i))
  enddo
end subroutine isnan_r8
!
subroutine read_operand_isnum(chain,nch,descr,error)
  use gildas_def
  use sic_interactions
  use sic_interfaces, except_this=>read_operand_isnum
  use sic_dictionaries
  use sic_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !  Find if a string is a number or scalar number variable...
  !---------------------------------------------------------------------
  character(len=*),       intent(in)  :: chain  ! Chain containing operand
  integer(kind=4),        intent(in)  :: nch    ! Length of chain
  type(sic_descriptor_t), intent(out) :: descr  ! Operand descriptor
  logical,                intent(out) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='ISNUM'
  logical :: found
  integer(kind=4) :: nc, ier
  type(sic_descriptor_t) :: idesc
  real(8) :: dble
  !
  error = .false.
  !
  ! Removes closing parenthesis. Not very efficient: their index is known from
  ! GET_LEVEL
  nc = nch
  do while (nc.ge.1 .and. (chain(nc:nc).eq.')'.or.chain(nc:nc).eq.' '))
    nc = nc-1
  enddo
  !
  ! Default result
  descr%readonly = .false.
  descr%status = readonly_operand
  error = .false.
  call sic_descriptor ('NO',descr,found)
  !
  ! It can be a variable. Non-contiguous sub-arrays allowed.
  found = .true.  ! Verbose
  call sic_materialize(chain(1:nc),idesc,found)
  if (.not.found) then
    !
    if (chain(1:1).eq."'".and.chain(nc:nc).eq."'") then
      ! Try to evaluate the expression
      call sic_math_desc(chain,nc,fmt_r8,desc=idesc,error=error)
      call sic_volatile(idesc)
      if (error) then
        call sic_message(seve%e,rname,'Invalid expression '//chain(1:nc))
        return
      endif
    else
      ! Plain reading 
      read(chain(1:nc),*,iostat=ier) dble
      idesc%type = fmt_l
      if (ier.eq.0) idesc%type = fmt_r8 ! A number
    endif
  endif
  !
  ! Check it is scalar
  !!Print *,'Allowed types ',fmt_r4,fmt_r8,fmt_i4,fmt_i8
  if (idesc%type.eq.fmt_r4 .or.  &
      idesc%type.eq.fmt_r8 .or.  &
      idesc%type.eq.fmt_i4 .or.  &
      idesc%type.eq.fmt_i8) then
    if (idesc%ndim.eq.0) then
      call sic_descriptor ('YES',descr,found) ! Checked
    else if (product(idesc%dims(1:idesc%ndim)).eq.1) then
      call sic_descriptor ('YES',descr,found) ! Checked
    endif
  endif
  call sic_volatile(idesc)
  descr%readonly = .false.
  descr%status = readonly_operand
  error = .false.
end subroutine read_operand_isnum
!
