Sources Esope | Cast3M

ecctab
C ECCTAB    SOURCE    CB215821  19/12/02    21:15:01     10400          
      SUBROUTINE ECCTAB(MTABLE,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
     $                         TAPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
C
C  **** MET UN OBJET DANS UNE TABLE
C  **** TAPIND TYPE DE L'INDICE  CHARACTER*(*)
C  ****        PUIS LA VALEUR DE L'INDICE  IVALIN SI ENTIER
C  ****                                    XVALIN SI FLOTTANT
C  ****                                    CHARIN SI MOT
C  ****                                    LOGIN SI LOGIQUE
C  ****                                    IOBIN POUR TOUT AUTRE TYPE
C  **** TAPOBJ TYPE DE L'OBJET CHARACTER*(*)
C  ****        PUIS LA VALEUR DE L'INDICE  IVALRE SI ENTIER
C  ****                                    XVALRE SI FLOTTANT
C  ****                                    CHARRE SI MOT
C  ****                                    LOGRE SI LOGIQUE
C  ****                                    IOBRE POUR TOUT AUTRE TYPE
C  ****
C
C
      IMPLICIT INTEGER(I-N)
-INC CCNOYAU
-INC SMTABLE
 
-INC PPARAM
-INC CCOPTIO
-INC CCASSIS
      external long
      REAL*8 XVALIN,XVALRE
      LOGICAL LOGRE,LOGIN
      CHARACTER*(*) TAPIND,TAPOBJ,CHARIN,CHARRE
      CHARACTER*(8) CHARA,TYPIND,TYPOBJ
      if(nbesc.ne.0) segact ipiloc
      TYPIND=TAPIND
      TYPOBJ=TAPOBJ
      SEGACT MTABLE*MOD
      IN = MLOTAB
C
C ***** RECHERCHE DE L'INDICE S'IL EXISTE
C
      IA=4
      IF(TYPIND.EQ.'ENTIER  ') IA=1
      IF(TYPIND.EQ.'FLOTTANT') IA=2
      IF(TYPIND.EQ.'MOT     ') IA=3
      IF(TYPIND.EQ.'METHODE ') IA=3
      IF(TYPIND.EQ.'LOGIQUE ') IA=5
C  ****** dans le cas des mots on ignore les blancs situes a la fin
      IF(IA.EQ.3) IL=LONG(CHARIN)
      IF(IN.EQ.0) GOTO 10
      DO 1 I=1,IN
        MT=I
        IF(MTABTI(I).NE.TYPIND ) GOTO 1
        GOTO (11,12,13,14,15),IA
 
   11   CONTINUE
        IF(MTABII(I).NE.IVALIN) GOTO 1
        GOTO 20
 
   12   CONTINUE
        IF(RMTABI(I).NE.XVALIN ) GOTO 1
        GOTO 20
 
   15   CONTINUE
        IF(IPLOGI(MTABII(I)).NEQV.LOGIN ) GOTO 1
        GOTO 20
 
   14   CONTINUE
        IF(MTABII(I).NE.IOBIN)  GOTO 1
        GOTO 20
 
   13   CONTINUE
        IP =MTABII(I)
        ID =IPCHAR(IP)
        IFI=IPCHAR(IP+1)
        IL1=LONG(ICHARA(ID:IFI-1))
        IF(IL1.NE.IL) GOTO 1
        IF(CHARIN(1:IL).NE.ICHARA(ID:ID+IL-1))  GOTO 1
        GOTO 20
   1  CONTINUE
 
  10  CONTINUE
C
C *****   L'INDICE N'EXISTE PAS ON L'AJOUTE
C
      MLOTAB=MLOTAB+1
      M=MTABII(/1)
      IF (MLOTAB .GT. M) THEN
        M=MLOTAB + MAX(INT(REAL(MLOTAB)*0.2D0),50)
        SEGADJ,MTABLE
      ENDIF
      M=MLOTAB
      MT=M
      MTABTI(M)=TYPIND
      IF(IA.EQ.1) THEN
           IRET=IVALIN
      ELSEIF(IA.EQ.2) THEN
           RMTABI(MT)=XVALIN
           GOTO 20
      ELSEIF(IA.EQ.3) THEN
           CALL POSCHA( CHARIN(1:IL),IRET)
           GOTO 200
      ELSEIF(IA.EQ.5) THEN
           call poslog(login,iret)
           GOTO 200
      ELSEIF(IA.EQ.4) THEN
           IRET=IOBIN
      ENDIF
  200 MTABII(MT)=IRET
*      if(nbesc.ne.0) segact ipiloc
   20 CONTINUE
 
C
C ***** FINI POUR L'INDICE FAIRE LA VALEUR
C
      IA=4
      IF(TYPOBJ.EQ.'ENTIER  ') IA=1
      IF(TYPOBJ.EQ.'FLOTTANT') IA=2
      IF(TYPOBJ.EQ.'MOT     ') IA=3
      IF(TYPOBJ.EQ.'LOGIQUE ') IA=5
      IF(IA.EQ.3) IL=LEN(CHARRE)
      MTABTV(MT)= TYPOBJ
      IF(IA.EQ.1) THEN
           IRET=IVALRE
      ELSEIF(IA.EQ.2) THEN
           IRET=0
           RMTABV(MT)=XVALRE
           GOTO 300
      ELSEIF(IA.EQ.3) THEN
           CALL POSCHA(CHARRE,IRET)
           GOTO 300
      ELSEIF(IA.EQ.5) THEN
           call poslog(logre,iret)
           GOTO 300
      ELSEIF(IA.EQ.4) THEN
           IRET=IOBRE
      ENDIF
  300 MTABIV(MT)=IRET
      SEGDES,MTABLE
      If(nbesc.ne.0) SEGDES,IPILOC
 
      END