C RTEN      SOURCE    PV        09/03/12    21:34:01     6325           
      SUBROUTINE RTEN                                                           
C=======================================================================        
C                                                                               
C               >>> Changement de repere d'un tenseur <<<    
C               >>> de contraintes ou de deformations <<<                     
C                                                                               
C CHAM2 = RTEN CHAM1 MODL1 ...
C
C            ... | W1 (W2)  ;          
C                |  CHAM3   ;               
C                | (CHAM3) | 'POLA'  CENTR1 ;
C                          | 'SPHE'  CENTR1   AXEI1 ;
C                          | 'CYLI'  CENTR1   AXEI1 ;
C                          | 'TORI' | ('CART')  CENTR1 AXEI1 ;
C                                   |  'CIRC'   CENTR1 AXEI1 CENTR2 ; 
C  
C     CHAM1  = MCHAML de sous type CONTRAINTES ou DEFORMATIONS
C     MODL1  = objet  de type MMODEL                    
C     W1,W2  = objets de type POINT                
C     CHAM3  = objet  de type MCHAML de sous type CARACTERISTIQUES         
C     CHAM2  = MCHAML de sous type CONTRAINTES ou DEFORMATIONS 
C     CENTR1 = objet  de type POINT 
C     AXEI1  = objet  de type POINT
C     CENTR2 = objet  de type POINT               
C                                                                               
C=======================================================================        
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO                                                                    
-INC SMCHAML        
*
      CHARACTER*4 MOCLE1(4),MOCLE2(2),MOCLE3(2)
      DATA MOCLE1 /'POLA','CYLI','SPHE','TORI'/
      DATA MOCLE2 /'CART','CIRC'/                
      DATA MOCLE3 /'RTAR','RART'/
*    
      ICAS  =0               
      IPCHE =0                                    
      IPCHE1=0 
      IMOT  =0                                                                 
      IPTV1 =0                                                                  
      IPTV2 =0  
      IPTV3 =0                     
      IPMODL=0                                 
      IPCHAM=0                      
      IRET  =0  
      JMOT  =0  
      IGRAD =0
      KMOT  =0
      IRTP9 =0      
C                                                                               
C     Lecture d'un champ par point                                                  
C
      CALL LIROBJ('CHPOINT', MCHPOI, 0, IRET)
      IF (IERR.NE.0) RETURN
      IF (IRET .NE. 0) THEN
         CALL RDEPLA(MCHPOI)
         GOTO 100
      ENDIF
C                                                                               
C     Lecture d'un modele                                                  
C                                                                               
      CALL LIROBJ('MMODEL',IPMODL,1,IRTM)
      IF (IERR.NE.0) RETURN                                                      
C                                                                               
C     Lecture d'un mchaml
C                                                                               
      CALL LIROBJ('MCHAML',IPCHE,1,IRT)                                       
      IF (IERR.NE.0) RETURN 
C                                                                               
C     Lecture facultatice d'un second mchaml                    
C                                                                               
      CALL LIROBJ('MCHAML',IPCHE1,0,IRT1)                              
      IF (IERR.NE.0) RETURN                                                 
C                         
      IF (IRT1.NE.0) THEN                                                      
         MCHELM=IPCHE                                                        
         SEGACT MCHELM                                                       
C                                                                               
C        Le mchaml des reperes est mis en second s'il le faut   
C                                                                               
         IF (TITCHE.NE.'DEFORMATIONS INELASTIQUES'.AND.
     &       TITCHE.NE.'DEFORMATIONS'.AND.
     &       TITCHE.NE.'CONTRAINTES'.AND.
     &       TITCHE.NE.'VARIABLES INTERNES') THEN
            IPXXX=IPCHE                                                      
            IPCHE=IPCHE1                                                     
            IPCHE1=IPXXX                                                     
         ENDIF                                                               
         SEGDES MCHELM 
*
*        s'agit-il d'un champ de gradient ?
*
         MCHELM=IPCHE1
         SEGACT MCHELM                                                       
         IF (TITCHE.EQ.'GRADIENT') THEN
           IGRAD=1
C
C          Lecture facultative d'un mot-cle
C
           CALL LIRMOT (MOCLE3,2,KMOT,0)
           IF (IERR.NE.0) RETURN
           IF (KMOT.EQ.0) KMOT=1
           SEGDES MCHELM
           GO TO 50
         ENDIF
      ENDIF                  
C
C     Lecture facultative d'un mot-cle
C
      CALL LIRMOT (MOCLE1,4,IMOT,0)
      IF (IERR.NE.0) RETURN 
C
      IF (IMOT.EQ.0) THEN
C
C        Cas des reperes cartesien et orthotrope
C                                       
C        Lecture facultative d'un premier point
C                                                                               
         CALL LIROBJ('POINT',IPTV1,0,IRTP9)                                     
         IF (IERR.NE.0) RETURN                                                   
         IF (IRTP9.NE.0) THEN                                                     
C                                                                               
C           Lecture facultative d'un second point                                
C                                                                               
            CALL LIROBJ('POINT',IPTV2,0,IRTP2)                                   
            IF(IERR.NE.0) RETURN                                                 
         ENDIF                                                                 
      ELSE
C
C        Cas des autres reperes (avec mot-cle)
C
C        Lecture facultative d'un second mot-cle
C
               IF (IMOT.EQ.4) THEN
                  CALL LIRMOT(MOCLE2,2,JMOT,0)
                  IF (IERR.NE.0) RETURN
               ENDIF
C
C        Lecture obligatoire d'un premier point
C
         CALL LIROBJ('POINT',IPTV1,1,IRTP1)
         IF (IERR.NE.0) RETURN 
C
C        Lecture facultative d'un second point
C
         CALL LIROBJ ('POINT',IPTV2,0,IRTP2)
         IF (IERR.NE.0) RETURN 
         IF (IRTP2.EQ.0) THEN
C
C           Un seul point : 'POLA'
C
            IF (IMOT.NE.1) THEN
               CALL ERREUR(641)
               RETURN
            ENDIF
         ELSE IF (IMOT.EQ.4) THEN 
C
C           Autre mot-cle possible : 'TORI'
C
            IF (JMOT.EQ.2) THEN
C
C              Troisieme point obligatoire : 'TORI' 'CIRC'
C
               CALL LIROBJ('POINT',IPTV3,1,IRTP3)
               IF (IERR.NE.0) RETURN
            ELSE 
C
C              Pas de troisieme point : 'TORI' 'CART'
C       
               IMOT=5
            ENDIF
         ENDIF
      ENDIF   
C
  50  CONTINUE
C
      IF (IMOT.NE.0) ICAS = 3
      IF (IMOT.EQ.0) THEN
         ICAS = 2
         IF (IRTP9.EQ.0) ICAS = 1
      ENDIF             
      IF(IGRAD.EQ.1) ICAS=4
C
C     Appel au module de calcul
C
      CALL RTENS(IPCHE,IPMODL,IMOT,KMOT,
     &           IPTV1,IPTV2,IPTV3,IPCHE1,ICAS,IPCHAM)
C                                                                               
      IF (IERR.EQ.0) CALL ECROBJ('MCHAML',IPCHAM)
 100  CONTINUE
      RETURN                                                                    
      END