C ELASTI    SOURCE    CB215821  20/07/31    14:32:23     10671          

      SUBROUTINE ELASTI

*_______________________________________________________________________
*
*                     OPERATEUR ELASTICITE
*
*      SIG = ELAS MODL EPS MATER ( VA1 )
*                OU                         EN ELASTICITE LINEAIRE
*      EPS = ELAS MODL SIG MATER ( VA1 )
*
*            MODL   MODELE DE CALCUL,TYPE MMODEL
*            EPS    CHAMP PAR ELEMENT DE DEFORMATIONS,TYPE MCHAML
*            SIG    CHAMP PAR ELEMENT DE CONTRAINTES,TYPE MCHAML
*            MATER  CHAMP PAR ELEMENT DE CARACTERISTIQUE,TYPE MCHAML
*            VA1    CHAMP PAR ELEMENT DE VARIABLES INTERNES,TYPE MCHAML
*_______________________________________________________________________
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*

-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
*
      IPCHE1=0
      IPCHE2=0
      IPCHE3=0
      IPSTRS=0
      IRETOU=0
      IRET  =0
*
*     LECTURE DU MODELE
*
      CALL LIROBJ('MMODEL  ',IPMODL,1,IRETOU)
      IF(IERR.NE.0) RETURN
      CALL ACTOBJ('MMODEL  ',IPMODL,1)
*
*     ON LIT LE 1-ER CHAMP/ELEMENT
*
      CALL LIROBJ('MCHAML  ',IPIN,1,IRETOU)
      IF(IERR.NE.0) RETURN
      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
*
*     LECTURE DU MCHAML DE MATERIAU
*
      CALL LIROBJ('MCHAML  ',IPIN,1,IRETOU)
      IF(IERR.NE.0) RETURN
      CALL ACTOBJ('MCHAML  ',IPIN,1)
      CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER)
      IF(IR   .NE. 1) CALL ERREUR(KER)
      IF(IERR .NE. 0) RETURN
C
C       LECTURE DU MCHAML DE VARIABLES INTERNES
C
      CALL LIROBJ('MCHAML  ',IPIN,0,IRETOU)
      IF (IERR.NE.0) RETURN
      IPCHE3 = 0
      IF (IRETOU .EQ. 1) THEN
        CALL ACTOBJ('MCHAML  ',IPIN,1)
        CALL REDUAF(IPIN,IPMODL,IPCHE3,0,IR,KER)
        IF(IR   .NE. 1) CALL ERREUR(KER)
        IF(IERR .NE. 0) RETURN
      ENDIF
*
*     CALCUL DES CONTRAINTES OU DES DEFORMATIONS
*
      SEGACT,MCOORD
      CALL ELAS1 (IPMODL,IPCHE1,IPCHE2,IPCHE3, IPSTRS,IRET)
      SEGDES,MCOORD
      IF (IERR .NE. 0) RETURN
*
      IF (IRET.EQ.1) THEN
        CALL ACTOBJ('MCHAML  ',IPSTRS,1)
        CALL ECROBJ('MCHAML  ',IPSTRS)
      ENDIF

      END