Sources Esope | Cast3M

rten
C RTEN      SOURCE    PV        20/03/31    14:34:04     10567          
      SUBROUTINE RTEN
C=======================================================================
C
C               >>> Changement de repere d'un tenseur &lt;&lt;&lt;
C               >>> de contraintes ou de deformations &lt;&lt;&lt;
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 PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC SMCOORD
*
      CHARACTER*4 MOCLE1(4),MOCLE2(2),MOCLE3(2),MOTALL(8),CMOT
      DATA MOCLE1 /'POLA','CYLI','SPHE','TORI'/
      DATA MOCLE2 /'CART','CIRC'/
      DATA MOCLE3 /'RTAR','RART'/
 
      DATA MOTALL /'POLA','CYLI','SPHE','TORI',
     &             'CART','CIRC',
     &             'RTAR','RART'/
*
      segact mcoord
      ICAS  =0
      IPCHE =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
      CALL ACTOBJ('MMODEL  ',IPMODL,1)
C
C     Lecture d'un mchaml
C
      CALL LIROBJ('MCHAML',IPIN,1,IRT)
      IF (IERR.NE.0) RETURN
      CALL ACTOBJ('MCHAML  ',IPIN,1)
      CALL REDUAF(IPIN,IPMODL,IPCHE,0,IR,KER)
      IF(IR   .NE. 1) CALL ERREUR(KER)
      IF(IERR .NE. 0) RETURN
C
C     Lecture facultatice d'un second mchaml
C
      CALL LIROBJ('MCHAML',IPIN,0,IRT1)
      IF (IERR.NE.0) RETURN
      IPCHE1=0
      IF (IRT1 .EQ. 1) THEN
        CALL ACTOBJ('MCHAML  ',IPIN,1)
        CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
        IF(IR   .NE. 1) CALL ERREUR(KER)
        IF(IERR .NE. 0) RETURN
 
         MCHELM=IPCHE
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
*
*        s'agit-il d'un champ de gradient ?
*
         MCHELM=IPCHE1
         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
           GO TO 50
         ENDIF
      ENDIF
C
C     Lecture facultative d'un mot-cle
C
      CALL LIRCHA(CMOT,0,IRETOU)
      IF (IERR.NE.0) RETURN
      IF (IRETOU .NE. 0) THEN
        CALL PLACE(MOTALL,4,IMOT0,CMOT)
        IF (IERR.NE.0) RETURN
        IF(IMOT0 .EQ. 0)THEN
          CALL ERREUR(21)
          RETURN
        ENDIF
        CALL REFUS
        IF (IERR.NE.0) RETURN
      ENDIF
 
      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) THEN
        ICAS = 3
      ELSE
        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) THEN
        CALL ACTOBJ('MCHAML  ',IPCHAM,1)
        CALL ECROBJ('MCHAML  ',IPCHAM)
      ENDIF
 100  CONTINUE
      END