Sources Esope | Cast3M

ntatab
C NTATAB    SOURCE    CB215821  24/07/17    21:15:14     11961          
C  AFFECTE UN ELEMENT D'UNE TABLE. APPELE PAR LIRNOM
C
      SUBROUTINE NTATAB(INOM,IBTYP,IRET,ISUCC)
C   ITAB POINTEUR SUR LA TABLE
C   INDIC1 TYPE DE L'INDICE
C   INDIC2 RANG DANS PILE DE L'INDICE
C   IBTYP  TYPE DE L'ELEMENT
C   IRET   VALEUR DE L'ELEMENT
      IMPLICIT INTEGER(I-N)
-INC CCNOYAU
 
-INC PPARAM
-INC CCOPTIO
-INC SMTABLE
-INC SMBLOC
-INC CCASSIS
      REAL*8 XIFTMP
      CHARACTER*(*)IBTYP
      CHARACTER*(8)ITBNO
      character*8 chtmp,lbtyp
*sg      CHARACTER*72 CHARIN
      CHARACTER*512 CHARIN
      EXTERNAL LONG
      LBTYP=IBTYP
      IMETH=ISUCC
      ISUCC=0
*      write(6,*) ' entree dans ntatab isucc',imeth
      ITBNOM=ITANO1(INOM)
      MTABLE=IOUEP2(ITBNOM)
      IF(IMETH.EQ.1) THEN
        IF (MOBJCO.NE.0) THEN
            MTABLE=MOBJCO
        ELSE
            CALL ERREUR(863)
            RETURN
        ENDIF
      ELSE
        INDIC1=ITANO1(INOM+1)
        ITBNO=INOOB2(INDIC1)
        IF(ITBNO.NE.'SEPARATE')  RETURN
      ENDIF
      ISUCC=1
      INOM=INOM+2-IMETH
      INDIC2=ITANO1(INOM)
      ITBNO=INOOB2(INDIC2)
      INDIC2=IOUEP2(INDIC2)
      SEGACT MTABLE*MOD
  10  CONTINUE
*  RECHERCHE DE LA POSITION CORRESPONDANTE DE LA TABLE
      NTDIM= MLOTAB
      IF(NTDIM.EQ.0) GO TO 21
      if(nbesc.ne.0) segact ipiloc
      XIFTMP=0
      IF (ITBNO.EQ.'FLOTTANT') XIFTMP=XIFLOT(INDIC2)
      DO 20 I=1,NTDIM
      chtmp=mtabti(i)(1:8)
      IF (chtmp.NE.ITBNO) GOTO 20
      IF (ITBNO.EQ.'FLOTTANT') THEN
          IF (RMTABI(I).NE.XIFTMP) GOTO 20
      ELSEIF(ITBNO.EQ.'MOT     ')THEN
C    ON VA COMPARER LES MOTS SANS TENIR COMPTE DES BLANCS DE LA FIN
**        IOD=IPCHAR(INDIC2)
**        IOF=IPCHAR(INDIC2+1)
**        L2= LONG(ICHARA(IOD:IOF-1))+IOD-1
          IP=MTABII(I)
**        ID=IPCHAR(IP)
**        IFI=IPCHAR(IP+1)
**        L1=LONG(ICHARA(ID:IFI-1))+ID-1
**        IF(ICHARA(IOD:L2).NE.ICHARA(ID:L1))GO TO 20
          if (ip.ne.indic2) goto 20
      ELSE
          IF (MTABII(I).NE.INDIC2) GOTO 20
      ENDIF
*  REMPLACEMENT  DANS LE CAS OU IL NE S'AGIT PAS D'UNE TABLE
* SINON RENVOI EN 10 AVEC LA NOUVELLE TABLE
      chtmp=mtabtV(i)(1:8)
      IF(chtmp.EQ.'TABLE   ') THEN
         MTAB1 = MTABIV(I)
         IF((INOM+1).GT.NBNOM) GO TO 11
         INDIC1=ITANO1(INOM + 1)
         ITBNO=INOOB2(INDIC1)
         IF(ITBNO.EQ.'SEPARATE')  THEN
* IL NE S'AGISSAIT PAS REELEMENT D'UN REMPLACEMENT
            INOM=INOM+2
            IF(INOM.GT.NBNOM) THEN
                CALL ERREUR(314)
                if ( nbesc.ne.0) SEGDES,IPILOC
                RETURN
            ENDIF
            INDIC2=ITANO1(INOM)
            ITBNO=INOOB2(INDIC2)
            INDIC2=IOUEP2(INDIC2)
            SEGDES MTABLE
            MTABLE=MTAB1
            SEGACT MTABLE*MOD
            GO TO 10
         ENDIF
      ENDIF
  11  CONTINUE
      MTABTV(I)(1:8)= LBTYP
      IF (LBTYP.NE.'FLOTTANT') THEN
         MTABIV(I)= IRET
      ELSE
         RMTABV(I)=XIFLOT(IRET)
      ENDIF
      SEGDES MTABLE
      if(nbesc.ne.0) SEGDES,IPILOC
      RETURN
  20  CONTINUE
      if(nbesc.ne.0) SEGDES,IPILOC
  21  CONTINUE
      MLOTAB=NTDIM+1
      M=MTABII(/1)
      IF (MLOTAB.GT.M) THEN
        M=M+50
        SEGADJ MTABLE
      ENDIF
      M=MLOTAB
*  ON AJOUTE A LA TABLE
      MTABTI(M)(1:8)=ITBNO
      IF('        '.EQ.ITBNO) THEN
         CALL ERREUR (600)
         RETURN
      ENDIF
      if(nbesc.ne.0) segact ipiloc
      IF (ITBNO .EQ.'FLOTTANT') THEN
        RMTABI(M)=XIFLOT(INDIC2)
      ELSEIF(ITBNO .EQ.'MOT     ') THEN
C    si l'indice est un mot on ne garde pas les blancs a la fin du mot
        IOD=IPCHAR(INDIC2)
        IOF=IPCHAR(INDIC2+1)
        L2= LONG(ICHARA(IOD:IOF-1))
*sg attention si L2> len(charin)
        L2=MIN(L2,LEN(CHARIN))
        CHARIN(1:L2)=ICHARA(IOD:L2+IOD-1)
        CALL POSCHA(CHARIN(1:L2),IRET2)
        if(nbesc.ne.0) segact ipiloc
        MTABII(M)=IRET2
      ELSE
        MTABII(M)=INDIC2
      ENDIF
      MTABTV(M)(1:8)=LBTYP
      IF (LBTYP.NE.'FLOTTANT') THEN
         MTABIV(M)=IRET
      ELSE
         RMTABV(M)=XIFLOT(IRET)
      ENDIF
      if(nbesc.ne.0) SEGDES,IPILOC
      SEGDES MTABLE
      RETURN
      END