subroutine sic_add_expr (line,nl,output,no,error)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_add_expr
  use sic_expressions
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !  Replace a function by its translation in command line
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  integer :: nl                     !
  character(len=*) :: output        !
  integer :: no                     !
  logical :: error                  !
  ! Local
  character(len=*), parameter :: rname='FUNCTION'
  integer :: iput,iout,inxt,ipre,in,ip
  integer :: ifun,iarg,ioper,ipoi,ilas,ifir
  integer :: ista(mfunarg),iend(mfunarg)
  !
  iput = 1
  iout = 1
  inxt = 1                     ! Next character in.
  do while (iput.le.nl)
    !
    ! A parenthesis : may be a function appears before
    if (line(iput:iput).eq.'(') then
      do ifun=1,nfun
        ipre = iput-lonc(ifun)
        if (ipre.lt.1) cycle   ! IFUN
        !
        ! With New SIC, Functions are in UPPER Case, so make the comparison
        ! meaningfull
        if (.not.sic_eqchain(line(ipre:iput-1),fonc(ifun)(1:lonc(ifun))))  &
          cycle   ! IFUN
        if (ipre.gt.1 .and. .not.expr_anoper(line(ipre-1:ipre-1)))  &
          cycle    ! IFUN
        ! This function
        ! Put pending characters
        if (ipre.gt.inxt) then
          output(iout:) = line(inxt:ipre-1)
          iout = iout+ipre-inxt
        endif
        output(iout:) = '('
        iout = iout+1
        in = iput+1
        iarg = 1
        do while (iarg.le.nfunarg(ifun))
          ista(iarg) = in
          ioper = expr_oper2 (line,ip,in,nl)
          if (ioper.eq.1) then
            call sic_message(seve%e,rname,'Wrong syntax')
            error = .true.
            return
          endif
          iend(iarg) = ip
          iarg = iarg+1
        enddo
        !
        ! Last operator must be a closing parenthesis
        if (ioper.ne.-1) then
          call sic_message(seve%e,rname,'Wrong number of arguments')
          error = .true.
          return
        endif
        !
        ! All arguments have been identified. Replace
        do ipoi = 1,lptr(ifun)
          !
          ! Preceding section
          ilas = ila(ipoi,ifun)
          ifir = ifi(ipoi,ifun)
          if (ilas.ge.ifir) then
            output(iout:) = defi(ifun)(ifir:ilas)
            iout = iout+ilas-ifir+1
          endif
          !
          ! Argument if any
          iarg = iva(ipoi,ifun)
          if (iarg.ne.0) then
            output(iout:iout) = '('
            iout = iout+1
            output(iout:) = line(ista(iarg):iend(iarg))
            iout = iout+iend(iarg)-ista(iarg)+1
            output(iout:iout) = ')'
            iout = iout+1
          endif
        enddo
        iput = ip
        inxt = ip+1
        !
      enddo                    ! IFUN
    endif
    iput = iput+1
  enddo
  !
  if (inxt.le.nl) output(iout:) = line(inxt:nl)
  no = len_trim(output)
  ! Add for new SIC
  call sic_upcase(output,no)
end subroutine sic_add_expr
!
function sic_get_expr(func,nf)
  use sic_expressions
  !---------------------------------------------------------------------
  ! @ private
  !  Translate a function name to its identifier. Return 0 if no such
  ! function (not an error, up to the caller to decide)
  !---------------------------------------------------------------------
  integer(kind=4) :: sic_get_expr  ! Function value on return
  character(len=*), intent(in) :: func  !
  integer(kind=4),  intent(in) :: nf    !
  ! Local
  integer(kind=4) :: i
  !
  do i=1,nfun
    if (func(1:nf).eq.fonc(i)(1:lonc(i))) then  ! Case-sensitive
      ! Found
      sic_get_expr = i
      return
    endif
  enddo
  !
  ! Not found
  sic_get_expr = 0
  !
end function sic_get_expr
!
subroutine sic_list_expr (func,nf,error)
  use sic_interfaces, except_this=>sic_list_expr
  use sic_expressions
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !  List 1 or all user-defined functions
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: func   !
  integer(kind=4),  intent(in)    :: nf     !
  logical,          intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='FUNCTION'
  integer(kind=4) :: i
  !
  if (nf.eq.0) then
    ! List all functions
    if (nfun.eq.0) return
    call sic_message(seve%i,'FUNCTION','User defined functions are:')
    do i=1,nfun
      write (*,'(2A)') fonc(i),defi(i)
    enddo
  else
    ! List one function
    i = sic_get_expr(func,nf)
    if (i.eq.0) then
      call sic_message(seve%e,rname,'No such function '//func(1:nf))
      error = .true.
      return
    endif
    call sic_message(seve%i,'FUNCTION',func(1:nf)//' is a user-defined function:')
    write (*,'(2A)') fonc(i),defi(i)
  endif
  !
end subroutine sic_list_expr
!
subroutine sic_del_expr(func,nf,error)
  use sic_interfaces, except_this=>sic_del_expr
  use sic_expressions
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! Delete a user function
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: func   ! Function name
  integer(kind=4),  intent(in)    :: nf     ! Length of func
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='FUNCTION'
  integer(kind=4) :: i,j,jj,k
  !
  i = sic_get_expr(func,nf)
  if (i.eq.0) then
    call sic_message(seve%e,rname,'No such function '//func(1:nf))
    error = .true.
    return
  endif
  !
  do j=i+1,nfun
    jj = j-1
    nfunarg(jj) = nfunarg(j)
    lonc(jj) = lonc(j)
    lptr(jj) = lptr(j)
    do k=1,lptr(j)
      ifi(k,jj) = ifi(k,j)
      ila(k,jj) = ila(k,j)
      iva(k,jj) = iva(k,j)
    enddo
    fonc(jj) = fonc(j)
    defi(jj) = defi(j)
  enddo
  nfun = nfun-1
  !
end subroutine sic_del_expr
!
subroutine sic_def_expr (func,nf,line,nl,error)
  use sic_interfaces, except_this=>sic_def_expr
  use sic_expressions
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !  Define a user function (DEFINE FUNCTION)
  !---------------------------------------------------------------------
  character(len=*) :: func          !
  integer :: nf                     !
  character(len=*) :: line          !
  integer :: nl                     !
  logical :: error                  !
  ! Local
  character(len=12) :: farg(mfunarg)
  integer :: iarg,i,if,ip,in,jp,ioper,ipt,ifun
  !
  if (nfun.eq.mfun) then
    call sic_message(seve%e,'FUNCTION','Too many functions')
    error = .true.
    return
  elseif (nf.gt.len(fonc(1))) then
    call sic_message(seve%e,'FUNCTION','Function name is too long')
    error = .true.
    return
  elseif (nl.gt.len(defi(1))) then
    call sic_message(seve%e,'FUNCTION','Definition is too long')
    error = .true.
    return
  endif
  !
  ! Analyse input function FUNC(Var1,Var2,VarN)
  ifun = nfun+1
  iarg = 0
  if = 0
  do i=1,nf
    if (func(i:i).eq.'(') then
      if (if.ne.0) goto 99
      fonc(ifun) = func
      lonc(ifun) = i-1
      iarg = 1
      if = i+1
    elseif (func(i:i).eq.',') then
      if (iarg.eq.mfunarg) then
        call sic_message(seve%e,'DEFINE','Too many arguments')
        error =.true.
        return
      endif
      if (if.eq.0) goto 99
      farg(iarg) = func(if:i-1)
      iarg = iarg+1
      if = i+1
    elseif (func(i:i).eq.')') then
      if (if.eq.0) goto 99
      if (i.ne.nf) goto 99
      farg(iarg) = func(if:i-1)
    endif
  enddo
  !
  ! Check if it exists
  i = sic_get_expr(fonc(ifun),lonc(ifun))  ! NB: ifun = nfun+1
  if (i.ne.0) then
    call sic_message(seve%e,'FUNCTION',  &
      'Function '//fonc(ifun)(1:lonc(ifun))//' already defined')
    error = .true.
    return
  endif
  nfunarg(ifun) = iarg
  !
  ! Analyse definition
  ip = 1
  in = 1
  jp = 1
  ipt = 1
  ifi(ipt,ifun) = 1
  iva(ipt,ifun) = 0
  do while (in.le.nl)
    !
    ! Find next operator : IP pointer towards end of previous
    ! operand, IN towards beginning of next operand.
    ! Operator is LINE(IP+1:IN-1).
    !
    ioper = expr_oper1(line,ip,in,nl)
    if (ioper.eq.0 .and. ip.ge.jp) then
      do i=1,iarg
        if (farg(i).eq.line(jp:ip)) then
          if (ipt.eq.mpoi) then
            call sic_message(seve%e,'FUNCTION','Definition is too complex')
            error = .true.
            return
          endif
          ila(ipt,ifun) = jp-1
          iva(ipt,ifun) = i
          ipt = ipt+1
          ifi(ipt,ifun) = ip+1
          iva(ipt,ifun) = 0
        endif
      enddo
    elseif (ioper.eq.-1) then
      error = .true.
      return
    endif
    jp = in
  enddo
  ila(ipt,ifun) = nl
  lptr(ifun) = ipt
  defi(ifun) = line(1:nl)
  nfun = ifun
  error = .false.
  return
  !
99 call sic_message(seve%e,'DEFINE','Syntax error')
  error = .true.
end subroutine sic_def_expr
!
function expr_oper1 (line,ip,in,nl)
  use sic_interfaces, except_this=>expr_oper1
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !       Returns index of first character in line which could be part of
  !       an operator field.
  ! Arguments :
  !       LINE    B(N)    Character string to be formatted        Input
  !       IP      I       Index of character before operator	Output
  !	IN	I	Index of character after operator	Input/Output
  !       NL      I       Length of C                             Input
  !---------------------------------------------------------------------
  integer :: expr_oper1             !
  character(len=*) :: line          !
  integer :: ip                     !
  integer :: in                     !
  integer :: nl                     !
  ! Local
  character(len=*), parameter :: rname='MATH'
  integer :: i
  logical :: array,separ,chain
  !
  expr_oper1 = 1
  array = .false.
  separ = .false.
  chain = .false.
  do i = in,nl
    if (chain) then
      if (line(i:i).eq.'"') then
        chain = .false.
        separ = .true.
      endif
    elseif (array) then
      if (line(i:i).eq.']') then
        array = .false.
        separ = .true.
      endif
    elseif (line(i:i).eq.'[') then
      array = .true.
    elseif (line(i:i).eq.']') then
      call sic_message(seve%e,rname,'Unmatch Closing bracket')
      expr_oper1 = -1
      return
    elseif (line(i:i).eq.'"') then
      chain = .true.
      !
      ! * could also be ** : check next character
    elseif (line(i:i).eq.'*') then
      ip = i-1
      if (line(i+1:i+1).eq.'*') then
        in = i+2
      else
        in = i+1
      endif
      expr_oper1 = 0
      return
      !
      ! Should be changed on a non-ASCII machine.
      ! '(', ')', '*', '+', ',', '-', '.', or '/' are contiguous in ASCII
    elseif ( (line(i:i).ge.'('.and.line(i:i).le.'/') .or.  &
             (line(i:i).eq.'|') .or. (line(i:i).eq.'^') ) then
      ip = i-1
      in = i+1
      expr_oper1 = 0
      return
    elseif (separ) then
      call sic_message(seve%e,rname,'Missing operator after string or '//  &
      'closing bracket')
      expr_oper1 = -1
      return
    endif
  enddo
  if (chain.or.array) return
  expr_oper1 = 0
  ip = nl
  in = nl+1
end function expr_oper1
!
function expr_oper2 (line,ip,in,nl)
  !---------------------------------------------------------------------
  ! @ private
  !       Returns index of first character in line which is a
  !	matching comma or closing parentheses
  ! Arguments :
  !       LINE    B(N)    Character string to be formatted        Input
  !       IP      I       Index of character before operator	Output
  !	IN	I	Index of character after operator	Input/Output
  !       NL      I       Length of C                             Input
  !---------------------------------------------------------------------
  integer :: expr_oper2             !
  character(len=*) :: line          !
  integer :: ip                     !
  integer :: in                     !
  integer :: nl                     !
  ! Local
  integer :: i,level
  logical :: array,chain
  !
  expr_oper2 = 1
  array = .false.
  chain = .false.
  level = 0
  do i = in,nl
    if (chain) then
      if (line(i:i).eq.'"') chain = .false.
    elseif (array) then
      if (line(i:i).eq.']') array = .false.
    elseif (line(i:i).eq.'[') then
      array = .true.
    elseif (line(i:i).eq.'"') then
      chain = .true.
    elseif (line(i:i).eq.'(') then
      level = level+1
    elseif (line(i:i).eq.')') then
      if (level.eq.0) then
        ip = i-1
        in = i+1
        expr_oper2 = -1
        return
      endif
      level = level-1
    elseif (line(i:i).eq.',') then
      if (level.eq.0) then
        ip = i-1
        in = i+1
        expr_oper2 = 0
        return
      endif
    endif
  enddo
  ip = nl+1
end function expr_oper2
!
function expr_anoper (line)
  !---------------------------------------------------------------------
  ! @ private
  !       Returns index of first character in line which could be part of
  !       an operator field.
  ! Arguments :
  !       LINE    C*1     Character string to be formatted        Input
  !---------------------------------------------------------------------
  logical :: expr_anoper            !
  character(len=1) :: line          !
  ! Should be changed on a non-ASCII machine.
  ! '(', ')', '*', '+', ',', '-', '.', or '/' are contiguous in ASCII
  if ( (line.ge.'('.and.line.le.'/') .or.  &
       (line.eq.'|') .or. (line.eq.'^') ) then
    expr_anoper = .true.
  else
    expr_anoper = .false.
  endif
end function expr_anoper
