C TRADTE    SOURCE    CHAT      11/07/28    21:15:08     7067           
C   TRADUITLE CONTENU D'UN OBJET DE TYPE TEXTE (MTE) ET RENVOI LE       
C   POINTEUR SUR LE SEGMENT TRADUCTION                                  
      SUBROUTINE TRADTE(MTE,MTRA)                                       
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC CCREDLE                                                            
-INC CCOPTIO                                                            
-INC SMTEXTE                                                            
-INC CCNOYAU 
-INC SMBLOC
-INC CCASSIS                                                             
      CHARACTER*500 CMTEXT
      character*72 motbuf                                               
      MTEXTE=MTE                                                        
      SEGACT MTEXTE*MOD
      if(iimpi.eq.1754) 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.1756)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(1:500)=MTEXT(1:NCART)
          NRAN= 0                                                       
         IPREC=1                                                        
          IFINAN=NCART                                                  
          ICOUR=NCART                                                   
          SEGINI MTRADU                                                 
          MTRADC=MTRADU                                                 
          MTRA=MTRADU  
   21    CONTINUE                                                       
         CALL REDLEC(sredle)                                            
C IRE = 0 FIN DE PHRASE                                                 
C 
         ifinpi=lmnnom                                                                      
         IF (IRE.EQ.0) GO TO 300                                        
      IF(IRE.NE.3.AND.IRE.NE.4.AND.IRE.NE.6) GO TO 30
      motbuf(1:ncar)=mot(1:ncar)
      ncas=ncar
*      write (6,*) ' dans tradte avant poscha ',ncar,motbuf(1:ncas)
      CALL POSCHA(MOTbuf(1:NCAs),INCHA)
      IF(IIMPI.EQ.1756) then
       write(6,*) ' apres poscha '  , incha 
      endif

C 
C   la chaine est en incha ieme position dans la pile des chaines
C   
                                                                        
       IF(IRE.EQ.3.AND.NCAR.LT.9) THEN                              
         DO 1 J =ifinpi,1,-1                                     
         IF(INCHA.NE.INOOB1(J)) GOTO 1
*           write(6,*) '   inoob2(j) ', inoob2(j)                     
                IPLAMO = J 
                                                         
                GO TO 301                                               
  1      CONTINUE 
      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.1756) 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 8 CARACTERES NE PEUT PAS ETRE       
*  UN NOM                                                               
       IF (NCAR.GT.8) INOOB1(LMNNOM)=1                                  
*                                                                       
         INOOB2(LMNNOM)='MOT'                                           
         IOUEP2(LMNNOM)= INCHA
      IF(IRE.EQ.6)  THEN
         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                                                 
         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 
         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 
         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                                                          
  301    CONTINUE                                                       
         MTRAD(**)=IPLAMO                                 
         GO TO 21                                                       
 300     CONTINUE                                                      
         MM=MTRAD(/1)                                                   
         IF(IIMPI.EQ.1756)WRITE(IOIMP,4821) MTEXTE,MTRADU,MM            
 4821    FORMAT (' CREATION DU TEXTE  : MTEXTE MTRADU MTRAD(/1)',3I5) 
         if(iimpi.eq.1754) then
          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                                                  
         SEGDES MTEXTE                                                  
         RETURN                                                         
         END