C
C This file is issued from the MODULEF library, but has been 
C subsequently modified
C
      SUBROUTINE FONACS(CITEM,NTYPE,MI,MR,ML,MC,MD,IALLOC,ICODE)
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C           S.P. FONACS          (FONCTIONS INTERPRETEES)
C           -----------
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C BUT :
C     AJOUTER UNE CONSTANTE DANS LES TABLES, APRES L AVOIR DECODEE
C
C PARAMETRES D ENTREE :
C     CITEM   : CHAINE DE CARACTERES REPRESENTANT LA CONSTANTE A AJOUTER
C     NTYPE   : TYPE DE LA CONSTANTE : 1 ENTIER, 2 REEL, ...
C     MI,MR,ML,MC,MD : TABLE DES CONSTANTES ENTIERES, REELLES, ...
C
C PARAMETRES DE SORTIE :
C     IALLOC  : INDICE DE LA CSTE DANS LA TABLE CORRESPONDANT A SON TYPE
C     ICODE   : CODE DE RETOUR (VOIR LE S.P. FONERR)
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C PROGRAMMEUR : PATRICK LAUG ; INRIA (3) 954 90 20 POSTE 508
C ......................................................................
      CHARACTER*(*) CITEM
      INTEGER MI(*),SI
      REAL    MR(*),SR
      LOGICAL ML(*),SL
      INTEGER MC(*),SC
      DOUBLE PRECISION MD(*),SD
      CHARACTER*16 INTERN
      COMMON /FONLC / LCI,LCR,LCL,LCC,LCD,LCOPN,LCOPT,LCSYM,LCEXP,LCIDN
      COMMON /FONLM / LMI,LMR,LML,LMC,LMD,LMOPN,LMOPT,LMSYM,LMEXP,LMIDN
C
C ON COMPLETE PAR DES BLANCS
      IF (NTYPE.LE.0 .OR. NTYPE.GT.2) GOTO 900
      ICODE = 0
      INTERN = CITEM
      GOTO (100,200),NTYPE
C
C ENTIER
  100 READ (INTERN,'(BN,I16)',ERR=900) SI
      DO 110 I = 1,LCI
         IF (MI(I).EQ.SI) THEN
            IALLOC = I
            RETURN
         END IF
  110 CONTINUE
      LCI = LCI + 1
      IF (LCI.GT.LMI-LMOPN) GOTO 900
      MI(LCI) = SI
      IALLOC = LCI
      RETURN
C
C REEL
  200 READ (INTERN,'(BN,E16.0)',ERR=900) SR
      DO 210 I = 1,LCR
         IF (MR(I).EQ.SR) THEN
            IALLOC = I
            RETURN
         END IF
  210 CONTINUE
      LCR = LCR + 1
      IF (LCR.GT.LMR-LMOPN) GOTO 900
      MR(LCR) = SR
      IALLOC = LCR
      RETURN
C
C ERREUR
  900 ICODE = 1
      END
