function codes (func)
  use gildas_def
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>codes
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  integer(kind=4) :: codes  ! Function value on return
  integer(kind=address_length) :: func(300)  !
  ! Global
  external :: lsic_l_or
  external :: lsic_l_and
  external :: lsic_l_not
  external :: lsic_l_exist
  external :: lsic_d_eq,lsic_s_eq,lsic_i_eq
  !
  ! 2 3 4 are logical operators
  func(code_or)  = locwrd(lsic_l_or)
  func(code_and) = locwrd(lsic_l_and)
  func(code_not) = locwrd(lsic_l_not)
  !
  ! Exist Variable and File function
  func(code_exist) = locwrd(lsic_l_exist)
  func(code_file)  = locwrd(lsic_l_exist)
  func(code_function)  = locwrd(lsic_l_exist)
  !
  ! Single precision operations
  ! Relational operators
  func(code_eq) = locwrd(lsic_s_eq)
  func(code_ne) = locwrd(lsic_s_ne)
  func(code_le) = locwrd(lsic_s_le)
  func(code_lt) = locwrd(lsic_s_lt)
  func(code_ge) = locwrd(lsic_s_ge)
  func(code_gt) = locwrd(lsic_s_gt)
  !
  ! Arithmetic operators
  func(code_bplus)  = locwrd(lsic_s_bplus)
  func(code_bminus) = locwrd(lsic_s_bminus)
  func(code_mul)    = locwrd(lsic_s_mul)
  func(code_div)    = locwrd(lsic_s_div)
  func(code_uplus)  = locwrd(lsic_s_uplus)
  func(code_uminus) = locwrd(lsic_s_uminus)
  func(code_power)  = locwrd(lsic_s_power)
  !
  ! Intrinsic functions
  func(code_abs)       = locwrd(lsic_s_abs)
  func(code_acos)      = locwrd(lsic_s_acos)
  func(code_asin)      = locwrd(lsic_s_asin)
  func(code_atan)      = locwrd(lsic_s_atan)
  func(code_atanh)     = locwrd(lsic_s_atanh)
  func(code_bessel_i0) = locwrd(lsic_s_bessel_i0)
  func(code_bessel_i1) = locwrd(lsic_s_bessel_i1)
  func(code_bessel_in) = locwrd(lsic_s_bessel_in)
  func(code_bessel_j0) = locwrd(lsic_s_bessel_j0)
  func(code_bessel_j1) = locwrd(lsic_s_bessel_j1)
  func(code_bessel_jn) = locwrd(lsic_s_bessel_jn)
  func(code_bessel_y0) = locwrd(lsic_s_bessel_y0)
  func(code_bessel_y1) = locwrd(lsic_s_bessel_y1)
  func(code_bessel_yn) = locwrd(lsic_s_bessel_yn)
  func(code_cos)       = locwrd(lsic_s_cos)
  func(code_cosh)      = locwrd(lsic_s_cosh)
  func(code_erf)       = locwrd(lsic_s_erf)
  func(code_erfc)      = locwrd(lsic_s_erfc)
  func(code_erfinv)    = locwrd(lsic_s_erfinv)
  func(code_erfcinv)   = locwrd(lsic_s_erfcinv)
  func(code_exp)       = locwrd(lsic_s_exp)
  func(code_int)       = locwrd(lsic_s_int)
  func(code_log)       = locwrd(lsic_s_log)
  func(code_log10)     = locwrd(lsic_s_log10)
  func(code_nint)      = locwrd(lsic_s_nint)
  func(code_sin)       = locwrd(lsic_s_sin)
  func(code_sinh)      = locwrd(lsic_s_sinh)
  func(code_sqrt)      = locwrd(lsic_s_sqrt)
  func(code_tan)       = locwrd(lsic_s_tan)
  func(code_tanh)      = locwrd(lsic_s_tanh)
  func(code_floor)     = locwrd(lsic_s_floor)
  func(code_ceiling)   = locwrd(lsic_s_ceiling)
  !
  func(code_min)      = locwrd(lsic_s_min)
  func(code_max)      = locwrd(lsic_s_max)
  func(code_atan2)    = locwrd(lsic_s_atan2)
  func(code_dim)      = locwrd(lsic_s_dim)
  func(code_sign)     = locwrd(lsic_s_sign)
  func(code_mod)      = locwrd(lsic_s_mod)
  func(code_typeof)   = locwrd(lsic_s_uplus)  ! Special case + identity operation
  func(code_rank)     = locwrd(lsic_s_uplus)  ! Same
  func(code_size)     = locwrd(lsic_s_uplus)  ! Same
  func(code_index)    = locwrd(lsic_s_uplus)  ! Same
  func(code_len)      = locwrd(lsic_s_uplus)  ! Same
  func(code_len_trim) = locwrd(lsic_s_uplus)  ! Same
  func(code_all)      = locwrd(lsic_s_uplus)  ! Same
  func(code_any)      = locwrd(lsic_s_uplus)  ! Same
  func(code_isnan)    = locwrd(lsic_s_uplus)  ! Same
  func(code_isnum)    = locwrd(lsic_s_uplus)  ! Same
  !
  func(code_pyfunc) = locwrd(lsic_s_pyfunc)
  !
  ! Double precision operations
  ! Relational operators
  func(100+code_eq) = locwrd(lsic_d_eq)
  func(100+code_ne) = locwrd(lsic_d_ne)
  func(100+code_le) = locwrd(lsic_d_le)
  func(100+code_lt) = locwrd(lsic_d_lt)
  func(100+code_ge) = locwrd(lsic_d_ge)
  func(100+code_gt) = locwrd(lsic_d_gt)
  !
  ! Arithmetic operators
  func(100+code_bplus)  = locwrd(lsic_d_bplus)
  func(100+code_bminus) = locwrd(lsic_d_bminus)
  func(100+code_mul)    = locwrd(lsic_d_mul)
  func(100+code_div)    = locwrd(lsic_d_div)
  func(100+code_uplus)  = locwrd(lsic_d_uplus)
  func(100+code_uminus) = locwrd(lsic_d_uminus)
  func(100+code_power)  = locwrd(lsic_d_power)
  !
  ! Intrinsic functions
  func(100+code_abs)       = locwrd(lsic_d_abs)
  func(100+code_acos)      = locwrd(lsic_d_acos)
  func(100+code_asin)      = locwrd(lsic_d_asin)
  func(100+code_atan)      = locwrd(lsic_d_atan)
  func(100+code_atanh)     = locwrd(lsic_d_atanh)
  func(100+code_bessel_i0) = locwrd(lsic_d_bessel_i0)
  func(100+code_bessel_i1) = locwrd(lsic_d_bessel_i1)
  func(100+code_bessel_in) = locwrd(lsic_d_bessel_in)
  func(100+code_bessel_j0) = locwrd(lsic_d_bessel_j0)
  func(100+code_bessel_j1) = locwrd(lsic_d_bessel_j1)
  func(100+code_bessel_jn) = locwrd(lsic_d_bessel_jn)
  func(100+code_bessel_y0) = locwrd(lsic_d_bessel_y0)
  func(100+code_bessel_y1) = locwrd(lsic_d_bessel_y1)
  func(100+code_bessel_yn) = locwrd(lsic_d_bessel_yn)
  func(100+code_cos)       = locwrd(lsic_d_cos)
  func(100+code_cosh)      = locwrd(lsic_d_cosh)
  func(100+code_erf)       = locwrd(lsic_d_erf)
  func(100+code_erfc)      = locwrd(lsic_d_erfc)
  func(100+code_erfinv)    = locwrd(lsic_d_erfinv)
  func(100+code_erfcinv)   = locwrd(lsic_d_erfcinv)
  func(100+code_exp)       = locwrd(lsic_d_exp)
  func(100+code_int)       = locwrd(lsic_d_int)
  func(100+code_log)       = locwrd(lsic_d_log)
  func(100+code_log10)     = locwrd(lsic_d_log10)
  func(100+code_nint)      = locwrd(lsic_d_nint)
  func(100+code_sin)       = locwrd(lsic_d_sin)
  func(100+code_sinh)      = locwrd(lsic_d_sinh)
  func(100+code_sqrt)      = locwrd(lsic_d_sqrt)
  func(100+code_tan)       = locwrd(lsic_d_tan)
  func(100+code_tanh)      = locwrd(lsic_d_tanh)
  func(100+code_floor)     = locwrd(lsic_d_floor)
  func(100+code_ceiling)   = locwrd(lsic_d_ceiling)
  !
  func(100+code_min)      = locwrd(lsic_d_min)
  func(100+code_max)      = locwrd(lsic_d_max)
  func(100+code_atan2)    = locwrd(lsic_d_atan2)
  func(100+code_dim)      = locwrd(lsic_d_dim)
  func(100+code_sign)     = locwrd(lsic_d_sign)
  func(100+code_mod)      = locwrd(lsic_d_mod)
  func(100+code_typeof)   = locwrd(lsic_d_uplus)  ! Special case + identity operation
  func(100+code_rank)     = locwrd(lsic_d_uplus)  !
  func(100+code_size)     = locwrd(lsic_d_uplus)  !
  func(100+code_index)    = locwrd(lsic_d_uplus)  !
  func(100+code_len)      = locwrd(lsic_d_uplus)  !
  func(100+code_len_trim) = locwrd(lsic_d_uplus)  !
  func(100+code_all)      = locwrd(lsic_d_uplus)  !
  func(100+code_any)      = locwrd(lsic_d_uplus)  !
  func(100+code_isnan)    = locwrd(lsic_d_uplus)  !
  func(100+code_isnum)    = locwrd(lsic_d_uplus)  !
  !
  func(100+code_pyfunc) = locwrd(lsic_d_pyfunc)
  !
  ! (Long) integer precision operations
  ! Relational operators
  func(200+code_eq) = locwrd(lsic_i_eq)
  func(200+code_ne) = locwrd(lsic_i_ne)
  func(200+code_le) = locwrd(lsic_i_le)
  func(200+code_lt) = locwrd(lsic_i_lt)
  func(200+code_ge) = locwrd(lsic_i_ge)
  func(200+code_gt) = locwrd(lsic_i_gt)
  !
  ! Arithmetic operators
  func(200+code_bplus)  = locwrd(lsic_i_bplus)
  func(200+code_bminus) = locwrd(lsic_i_bminus)
  func(200+code_mul)    = locwrd(lsic_i_mul)
  func(200+code_div)    = locwrd(lsic_i_div)
  func(200+code_uplus)  = locwrd(lsic_i_uplus)
  func(200+code_uminus) = locwrd(lsic_i_uminus)
  func(200+code_power)  = locwrd(lsic_i_power)
  !
  ! Intrinsic functions
  func(200+code_abs)       = locwrd(lsic_i_abs)
  func(200+code_acos)      = locwrd(lsic_i_acos)
  func(200+code_asin)      = locwrd(lsic_i_asin)
  func(200+code_atan)      = locwrd(lsic_i_atan)
  func(200+code_atanh)     = locwrd(lsic_i_atanh)
  func(200+code_bessel_i0) = locwrd(lsic_i_bessel_i0)
  func(200+code_bessel_i1) = locwrd(lsic_i_bessel_i1)
  func(200+code_bessel_in) = locwrd(lsic_i_bessel_in)
  func(200+code_bessel_j0) = locwrd(lsic_i_bessel_j0)
  func(200+code_bessel_j1) = locwrd(lsic_i_bessel_j1)
  func(200+code_bessel_jn) = locwrd(lsic_i_bessel_jn)
  func(200+code_bessel_y0) = locwrd(lsic_i_bessel_y0)
  func(200+code_bessel_y1) = locwrd(lsic_i_bessel_y1)
  func(200+code_bessel_yn) = locwrd(lsic_i_bessel_yn)
  func(200+code_cos)       = locwrd(lsic_i_cos)
  func(200+code_cosh)      = locwrd(lsic_i_cosh)
  func(200+code_erf)       = locwrd(lsic_i_erf)
  func(200+code_erfc)      = locwrd(lsic_i_erfc)
  func(200+code_erfinv)    = locwrd(lsic_i_erfinv)
  func(200+code_erfcinv)   = locwrd(lsic_i_erfcinv)
  func(200+code_exp)       = locwrd(lsic_i_exp)
  func(200+code_int)       = locwrd(lsic_i_int)
  func(200+code_log)       = locwrd(lsic_i_log)
  func(200+code_log10)     = locwrd(lsic_i_log10)
  func(200+code_nint)      = locwrd(lsic_i_nint)
  func(200+code_sin)       = locwrd(lsic_i_sin)
  func(200+code_sinh)      = locwrd(lsic_i_sinh)
  func(200+code_sqrt)      = locwrd(lsic_i_sqrt)
  func(200+code_tan)       = locwrd(lsic_i_tan)
  func(200+code_tanh)      = locwrd(lsic_i_tanh)
  func(200+code_floor)     = locwrd(lsic_i_floor)
  func(200+code_ceiling)   = locwrd(lsic_i_ceiling)
  !
  func(200+code_min)      = locwrd(lsic_i_min)
  func(200+code_max)      = locwrd(lsic_i_max)
  func(200+code_atan2)    = locwrd(lsic_i_atan2)
  func(200+code_dim)      = locwrd(lsic_i_dim)
  func(200+code_sign)     = locwrd(lsic_i_sign)
  func(200+code_mod)      = locwrd(lsic_i_mod)
  func(200+code_typeof)   = locwrd(lsic_i_uplus)  ! Special case + identity operation
  func(200+code_rank)     = locwrd(lsic_i_uplus)  ! Same
  func(200+code_size)     = locwrd(lsic_i_uplus)  ! Same
  func(200+code_index)    = locwrd(lsic_i_uplus)  ! Same
  func(200+code_len)      = locwrd(lsic_i_uplus)  ! Same
  func(200+code_len_trim) = locwrd(lsic_i_uplus)  ! Same
  func(200+code_all)      = locwrd(lsic_i_uplus)  ! Same
  func(200+code_any)      = locwrd(lsic_i_uplus)  ! Same
  func(200+code_isnan)    = locwrd(lsic_i_uplus)  ! Same
  func(200+code_isnum)    = locwrd(lsic_i_uplus)  ! Same
  !
  func(200+code_pyfunc) = locwrd(lsic_i_pyfunc)
  codes = code_scalar+1
end function codes
!
subroutine sic_def_func(name_in,s_func,d_func,nfunarg,error,hlpfile)
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_def_func
  use sic_dictionaries
  use sic_interactions
  !---------------------------------------------------------------------
  ! @ public
  !  Defines user functions
  !---------------------------------------------------------------------
  character(len=*), intent(in)           :: name_in  ! Function name
  real(kind=4),     external             :: s_func   ! Real*4 function
  real(kind=8),     external             :: d_func   ! Real*8 function
  integer(kind=4),  intent(in)           :: nfunarg  ! Number of arguments for function
  logical,          intent(out)          :: error    ! Logical error flag
  character(len=*), intent(in), optional :: hlpfile  ! Help file for "HELP FUNCTION Name"
  ! Local
  character(len=*), parameter :: rname='FUNCTION'
  integer(kind=4) :: in,ier
  character(len=message_length) :: mess
  character(len=16) :: name
  !
  name = name_in
  if (.not.loaded) then
    call sic_message(seve%e,rname,'SIC is not loaded')
    error = .true.
    return
  endif
  if (nfunarg.gt.4) then
    call sic_message(seve%e,rname,'Too many arguments to function '//name)
    error =.true.
    return
  elseif (nfunarg.lt.1) then
    write(mess,1002) nfunarg,' arguments to function ',name
    call sic_message(seve%e,rname,mess)
    error =.true.
    return
  endif
  !
  ! Check if name is already defined
  ier = gag_hasfin(maxfun,pffun,pnfun,namfun,name,in)
  if (ier.eq.1) then
    call sic_message(seve%e,rname,'Function '//name(1:15)//' already exists')
    error = .true.
    return
  endif
  !
  ier = gag_hasins(maxfun,pffun,pnfun,namfun,name,in)
  if (ier.eq.0) then
    call sic_message(seve%e,rname,'Invalid function name '//name)
    error = .true.
    return
  elseif (ier.eq.2) then
    call sic_message(seve%e,rname,'Too many functions')
    error = .true.
    return
  endif
  !
  descfun(in)%narg = nfunarg
  descfun(in)%code = code_user
  if (present(hlpfile)) then
    descfun(in)%help = hlpfile
  else
    descfun(in)%help = ""
  endif
  addr_function (code_user) = locwrd (s_func)
  addr_function (100+code_user) = locwrd (d_func)
  code_user = code_user+1
  error = .false.
  !
1002 format(i2,a,a)
end subroutine sic_def_func
!
subroutine sic_get_func(name_in,code,nfunarg,error)
  use sic_dependencies_interfaces
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ private
  ! Returns number of arguments and code
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: name_in     !
  integer(kind=4),  intent(out)   :: code        !
  integer(kind=4),  intent(out)   :: nfunarg(2)  ! Min-max number of arguments
  logical,          intent(inout) :: error       !
  ! Local
  integer(kind=4) :: ier,in
  character(len=16) :: name
  !
  name = name_in
  ier = gag_hasfin(maxfun,pffun,pnfun,namfun,name,in)
  if (ier.ne.1) then
    error = .true.
    return
  endif
  !
  nfunarg = descfun(in)%narg
  code = descfun(in)%code
  !
end subroutine sic_get_func
!
subroutine sic_inifunction
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_inifunction
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  call gag_hasini(maxfun,pffun,pnfun)
  code_user = codes(addr_function)
end subroutine sic_inifunction
!
subroutine sic_list_func
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_list_func
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  ! Local
  character(len=*), parameter :: rname='FUNCTION'
  integer(kind=4) :: in,list(maxfun),i
  character(len=message_length) :: mess
  !
  call gag_hassort(maxfun,pffun,pnfun,namfun,list,in)
  call sic_message(seve%i,rname,'Program functions are:')
  do i = 1,in
    write(mess,1001) namfun(list(i)),descfun(list(i))%narg
    call sic_message(seve%r,rname,mess)
  enddo
  !
1001 format(a,4x,i1,' arguments')
end subroutine sic_list_func
