C TRADTE    SOURCE    CB215821  24/07/17    21:15:18     11961          
      SUBROUTINE TRADTE(MTE,MTRA)

C   TRADUIT LE CONTENU D'UN OBJET DE TYPE TEXTE (MTE) ET RENVOI LE
C   POINTEUR SUR LE SEGMENT TRADUCTION

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCREDLE
-INC CCOPTIO
-INC SMTEXTE
-INC CCNOYAU
-INC SMBLOC
-INC CCASSIS

*     CHARACTER*(LOCHAI) CMTEXT
C     LOCHAI dans CCNOYAU.INC
      CHARACTER*(LOCHAI) motbuf

      INSEPA = -1
      MTEXTE = MTE
      SEGACT,MTEXTE*MOD
      if(iimpi.eq.6548) then
        write(6,*) ' traduction du texte : '
        write(6,*) mtext
        write(6,*) ' lmnnom ' , lmnnom
      endif
      mtradc=0
      IF(MTRADC.NE.0)  THEN
         MTRA=MTRADC
         IF(IIMPI.EQ.6548)WRITE(IOIMP,4822) MTEXTE,MTRADC
 4822    FORMAT (' TRADTE MTRADC.NE.0 : MTEXTE MTRADC ',2I5)
         SEGDES MTEXTE
         RETURN
      ENDIF
*C-- ON SAUVE TEXT DE FACON A LE SURCHARGER TEMPORAIREMENT
*         CMTEXT(1:500)=TEXT(1:500)
*         NRAN1=NRAN
*         ICOUR1=ICOUR
*         IFINA1=IFINAN
*         IPREC1=IPREC
*C-- ON PLACE L'OBJET DE TYPE TEXTE DANS TEXT
      call inired(sredle)
      TEXT   = MTEXT(1:NCART)
      NRAN   = 0
      IPREC  = 1
      IFINAN = NCART
      ICOUR  = NCART

      SEGINI,  MTRADU
      MTRADC = MTRADU
      MTRA   = MTRADU

C     On fait une nouvelle lecture
   21 CONTINUE
      CALL REDLEC(sredle)
      ifinpi=lmnnom

C      IF(IIMPI.EQ.6548) then
C        write(6,*) ' dans tradte apres REDLEC, IRE=', IRE
C        IF(IRE .EQ. 0)THEN
C          write(6,*) 'Fin de phrase'
C        ELSEIF(IRE .EQ. 1)THEN
C          write(6,*) 'Entier lu NFIX =',NFIX
C        ELSEIF(IRE .EQ. 2)THEN
C          write(6,*) 'Flottant lu FLOT =',FLOT
C        ELSEIF(IRE .EQ. 3)THEN
C          write(6,*) 'Mot lu MOT =',MOT(1:NCAR)
C        ELSEIF(IRE .EQ. 4)THEN
C          write(6,*) 'Texte lu MOT =',MOT(1:NCAR)
C        ELSEIF(IRE .EQ. 5)THEN
C          write(6,*) 'Logique lu BOOL =',BOOL
C        ELSEIF(IRE .EQ. 6 .OR. IRE .EQ. 7)THEN
C          write(6,*) 'Separateur lu MOT =',MOT(1:NCAR)
C        ENDIF
C      endif

C     FIN DE PHRASE
      IF (IRE.EQ.0) GO TO 300
      IF (IRE.NE.3 .AND.IRE.NE.4 .AND.IRE.NE.6) GO TO 30

      ncas   = sredle.ncar
      motbuf = sredle.mot(1:ncas)
      CALL POSCHA(MOTbuf(1:ncas),INCHA)
      IF(IIMPI.EQ.6548) then
        write(6,*) ' dans tradte apres poscha ', incha
      endif

C
C   la chaine est en incha ieme position dans la pile des chaines
C
       IF(IRE.EQ.3 .AND. ncas.LE.LONOM) THEN
         DO 1 J =ifinpi,1,-1
           IF(INCHA.NE.INOOB1(J)) GOTO 1
           IF(IIMPI.EQ.6548) then
             write(6,*) '   inoob2(j) ', inoob2(j)
           endif
           IPLAMO = J
           GO TO 301
  1      CONTINUE

      ELSEIF (IRE.EQ.6) THEN
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C       CAS SEPARATEUR des TABLES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
        IF (INSEPA.GT.0) THEN
           IPLAMO=INSEPA
           GOTO 301
        ELSE
           GOTO 98
        ENDIF

      ELSE
        DO 72 J=ifinpi,1,-1
          IF(INOOB1(J).NE.1) GO TO 72
          IF(INOOB2(J).NE.'MOT') GO TO 72
          IF(IOUEP2(J).NE.INCHA) GO TO 72
          IPLAMO=J
          GO TO 301
  72    CONTINUE
      ENDIF

*  on s'assure de ne pas pointer vers une procedure
           DO 430 J=ifinpi,1,-1
            IF(INCHA.NE.INOOB1(J))GO TO 430
            IF(INOOB2(J).EQ.'PROCEDUR') THEN
                IPLAMO=J
               GO TO 301
            ENDIF
  430      CONTINUE
  98  CONTINUE
      if(iimpi.eq.6548) then
        write(6,*) ' tradte  on cree un nouveau nom '
      endif
      LMNNOM=LMNNOM+1
      IPLAMO=LMNNOM
      IF( LMNNOM.GT.IOUEP2(/1)) THEN
         N=LMNNOM+50
         SEGADJ ITABOB,ITABOC,ITABOD
      ENDIF
      INOOB1(LMNNOM)=INCHA
      IF(IRE.EQ.4) INOOB1(LMNNOM)=1

*     CORRECTION PV  UN MOT DE PLUS DE LONOM CARACTERES NE PEUT PAS ETRE
*     UN NOM
      IF (ncas .GT. LONOM) INOOB1(LMNNOM)=1

      INOOB2(LMNNOM)='MOT'
      IOUEP2(LMNNOM)= INCHA

      IF(IRE.EQ.6)  THEN
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C       CAS SEPARATEUR des TABLES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
         INOOB2(LMNNOM)='SEPARATE'
         INSEPA=IPLAMO
      ENDIF
      GO TO 301


   30 CONTINUE
C
C  CAS DES AUTRES CHOSE QUE MOT
C
      IF(IRE.EQ.1) THEN
CCCCCCCCCCCCCCCCCCCC
C       CAS ENTIER
CCCCCCCCCCCCCCCCCCCC
         DO 1501 K=ifinpi,1,-1
           IF(IOUEP2(K).NE.NFIX)       GO TO 1501
           IF(INOOB2(K).NE.'ENTIER  ') GO TO 1501
           IF(INOOB1(K).NE.1)          GO TO 1501
           IPLAMO=K
           GO TO 301
1501     CONTINUE
         LMNNOM=LMNNOM+1
         IF(LMNNOM.GT.INOOB1(/1)) THEN
            N = LMNNOM + 50
            SEGADJ ITABOB,ITABOC,ITABOD
         ENDIF
         N=LMNNOM
         INOOB1(N)=1
         INOOB2(N)='ENTIER  '
         IOUEP2(N)=NFIX
         IPLAMO=N
         GO TO 301

      ELSEIF(IRE.EQ.2) THEN
CCCCCCCCCCCCCCCCCCCC
C       CAS FLOTTANT
CCCCCCCCCCCCCCCCCCCC
         if(nbesc.ne.0) segact ipiloc
         IO=XIFLOT(/1)
         if(nbesc.ne.0) SEGDES,IPILOC
         xtoto= flot
          call posree(xtoto,j)
          if(j.le.io) then
            DO 1503 K=ifinpi,1,-1
              IF(IOUEP2(K).NE.J) GO TO 1503
              IF(INOOB2(K).NE.'FLOTTANT') GO TO 1503
              IF(INOOB1(K).NE.1) GO TO 1503
              IPLAMO=K
              GO TO 301
 1503       CONTINUE
         endif
         IIP=J
         LMNNOM=LMNNOM+1
         IF(LMNNOM.GT.INOOB1(/1)) THEN
            N = LMNNOM+ 50
            SEGADJ ITABOB,ITABOC,ITABOD
         ENDIF
         N=LMNNOM
         INOOB1(N)=1
         INOOB2(N)='FLOTTANT'
         IOUEP2(N)=IIP
         IPLAMO=N
         GO TO 301

      ELSEIF (IRE.EQ.5) THEN
CCCCCCCCCCCCCCCCCCCC
C       CAS LOGIQUE
CCCCCCCCCCCCCCCCCCCC
         if(nbesc.ne.0) segact ipiloc
         IO=IPLOGI(/1)
         if(nbesc.ne.0) SEGDES,IPILOC
         call poslog(bool,j)
         if(j.le.io) then
           DO 1505 K=ifinpi,1,-1
             IF(IOUEP2(K).NE.J) GO TO 1505
             IF(INOOB2(K).NE.'LOGIQUE ') GO TO 1505
             IF(INOOB1(K).NE.1) GO TO 1505
             IPLAMO=K
             GO TO 301
 1505      CONTINUE
         endif
         IIP=J
         LMNNOM=LMNNOM+1
         IF(LMNNOM.GT.INOOB1(/1)) THEN
            N=LMNNOM+50
            SEGADJ ITABOB,ITABOC,ITABOD
         ENDIF
         N=LMNNOM
         INOOB1(N)=1
         INOOB2(N)='LOGIQUE '
         IOUEP2(N)=IIP
         IPLAMO=N
       ENDIF
CCCCCCCCCCCCCCCCCCCC
C       FIN DES CAS
CCCCCCCCCCCCCCCCCCCC

  301    CONTINUE
         MTRAD(**)=IPLAMO

C        Retour pour lecture suivante
         GO TO 21

C        Fin de lecture
 300     CONTINUE
         MM=MTRAD(/1)
         if(iimpi.eq.6548) then
 4821      FORMAT (' CREATION DU TEXTE  : MTEXTE MTRADU MTRAD(/1)',3I5)
           WRITE(IOIMP,4821) MTEXTE,MTRADU,MM
           write(6,*) 'resultat dela precompilation : ' , mtrad(/1)
           write(6,*) ( mtrad(iou),iou=1,mtrad(/1))
         endif

C-- ON REMET TEXT EN PLACE
*        TEXT(1:500)=CMTEXT(1:500)
*        IFINAN=IFINA1
*        IPREC=IPREC1
*        ICOUR=ICOUR1
*        NRAN=NRAN1
         segsup sredle
         SEGDES,MTRADU,MTEXTE
         RETURN
         END