Sources Esope | Cast3M

epsi
C EPSI      SOURCE    BP208322  20/12/18    21:15:01     10821          
      SUBROUTINE EPSI
*_______________________________________________________________________
*
*            OPERATEUR DE CALCUL DES DEFORMATIONS
*
*  Syntaxe :
*  -------
*      ESP  = EPSI |('LINE')  MODL1 (CAR1) (HOO1) CHP1 ;
*                  | 'QUAD' 
*                  | 'I' 
*                  | 'II'
*                  |'TRUE'
*                  |'JAUM'
*                  |'UTIL'
*
*      OU
*
*      ESP = EPSI MODL1 GRAD2 ( CAR1 ) | ('GEOM') | ;
*                                      |  'DEPL'  |
*
*  Input :
*  -----
*       LINE, QUAD... :  mot cle indiquant que l'on veut les termes 
*                        quadratiques ou pas
*       MODL1 : modele de calcul, type MMODEL
*               type MMODEL  --> IPMODL
*       CAR1  : champ par element de materiau (CARACTERISTIQUE)
*               type MCHAML  --> IPCHE1
*       HOO1  : champ par element de Hooke
*               type MCHAML  --> IPCHE2
*       CHP1  : chpoint de deplacement
*               type CHPOINT --> ICHP1
*       GEOM/DEPL : mot cle indiquant que GRAD2 est un gradient de
*                   transformation/deplacement
*
*  Output :
*  ------
*       ESP   : champ par element de deformations 
*               type MCHAML  --> IPEPSI
*-----------------------------------------------------------------------
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC SMCOORD
 
      PARAMETER(NDERI=7)
      CHARACTER*4 MODERI(NDERI)
      CHARACTER*4 MONOER(1)
      CHARACTER*4 MOGRAD(2)
 
      DATA MODERI/'LINE','QUAD','I  ','II  ','TRUE','JAUM','UTIL'/
c       -> IDERI =  1      2     1      2      3      4      5
      DATA MONOER/'NOER'/
      DATA MOGRAD/'GEOM','DEPL'/
c       -> IMIL  =  0      1
 
C-----------------------------------------------------------------------
 
      segact mcoord
      kerr=0
      IPCHE1=0
      IPCHA1=0
      IPCHE2=0
      IPCHA2=0
C
C     LECTURE DES MOT-CLE 
C
      IDERI=0
      INOER=0
      IGRAD=0
      IMIL=0
 
c     option de calcul des deformations (par defaut lineaires)
      CALL LIRMOT(MODERI,NDERI,IDERI,0)
      IF(IDERI.EQ.0) IDERI=1
      IF(IDERI.GE.3) IDERI=IDERI-2
 
c     'NOER'
      CALL LIRMOT(MONOER,1,inoer,0)
 
c     type de gradient fourni (GEOM par defaut / DEPL)
      CALL LIRMOT(MOGRAD,2,IGRAD,0)
      IF (IGRAD.EQ.2) IMIL=1
      IF (IERR.NE.0) GOTO 666
 
C
C     LECTURE DU MODELE
C
      CALL LIROBJ('MMODEL  ',IPMODL,1,IRT1)
      CALL ACTOBJ('MMODEL  ',IPMODL,1)
      IF (IERR.NE.0) GOTO 666
 
C
C     ON LIT UN CHAMP/POINT  -------------------------------------------
C
      CALL LIROBJ('CHPOINT ',ICHP1,0,IRT1)
      IF (IRT1.EQ.1) THEN
 
        CALL ACTOBJ('CHPOINT ',ICHP1,1)
C
C     ON LIT UN 2eme CHAMP/POINT  qui est le deplacement pour avoir la
C     configuratyion courante
C
        ichp2=0
        CALL LIROBJ('CHPOINT ',ICHP2,0,IRT1)
        IF (IRT1 .NE. 0) CALL ACTOBJ('CHPOINT ',ICHP2,1)
C
C       ON LIT UN 1 ER CHAMP/ELEMENT (FACULTATIF  )
C
        CALL LIROBJ('MCHAML  ',IPCHA1,0,IRT1)
        IF (Ierr.NE.0) GOTO 666
        if (IRT1.ne.0) then
         CALL ACTOBJ('MCHAML  ',IPCHA1,1)
         call reduaf(ipcha1,ipmodl,ipcha,0,iret,kerr)
         if (iret.ne.1) call erreur(kerr)
         if (ierr.ne.0) return
         ipcha1=ipcha
        endif
C
C       ON LIT UN 2 IEME CHAMP/ELEMENT (FACULTATIF  )
C
        CALL LIROBJ('MCHAML  ',IPCHA2,0,IRT2)
        IF (IERR.NE.0) GOTO 666
        if (IRT2.ne.0) then
         CALL ACTOBJ('MCHAML  ',IPCHA2,1)
         call reduaf(ipcha2,ipmodl,ipcha,0,iret,kerr)
         if (iret.ne.1) call erreur(kerr)
         if (ierr.ne.0) return
         ipcha2=ipcha
        endif
C
        IF(IPCHA1.NE.0.OR.IPCHA2.NE.0)THEN
          CALL RNGCHA(IPCHA1,IPCHA2,'CARACTERISTIQUES',
     &                            'MATRICE DE HOOKE',IPCHE1,IPCHE2)
          IF(IERR.NE.0) GOTO 666
          IF (IPCHE2.EQ.0)THEN
             IMAT=1
           ELSE
            IMAT=2
          ENDIF
        ELSE
           IMAT=0
           IPCHE1=0
           IPCHE2=0
        ENDIF
C
C     CALCUL DES DEFORMATIONS USUELLES
C
        CALL EPSI1(IDERI,IPMODL,ICHP1,IPCHE1,IPCHE2,IMAT,
     &                   IPEPSI,IRET,ichp2,inoer,kerr)
C
C
C     PAS DE CHPOINT : GRADIENT GEOMETRIE OU DEPLACEMENT ? -------------
C
      ELSE
C
C       ON LIT UN CHAMP/ELEMENT DE GRADIENTS
C
        CALL LIROBJ('MCHAML  ',IPCHA1,1,IRT1)
        CALL ACTOBJ('MCHAML  ',IPCHA1,1)
        IF (IERR.NE.0) GOTO 666
C
C       ON LIT UN 2 IEME CHAMP/ELEMENT (CARACTERISTIQUES-FACULTATIF)
C
        CALL LIROBJ('MCHAML',IPCHA2,0,IRT2)
        IF (IERR.NE.0) GOTO 666
        IF(IRT2 .NE. 0) CALL ACTOBJ('MCHAML  ',IPCHA2,1)
C
        IF (IPCHA1.NE.0.OR.IPCHA2.NE.0) THEN
          CALL RNGCHA(IPCHA1,IPCHA2,'GRADIENT',
     &                            'CARACTERISTIQUES',IPCHE1,IPCHE2)
C* Actuellement IPCHE2 n'est pas utilise. Seul IPCHE1 est verifie.
C*       IF (IPCHE1.EQ.0.OR.IPCHE2.EQ.0) THEN
         IF (IPCHE1.EQ.0) THEN
           MOTERR(1:8)='MCHAML'
           MOTERR(9:16)='GRADIENT'
           MOTERR(17:24)='CARACTERI'
           CALL ERREUR(141)
         ENDIF
         IF (IERR.NE.0) GOTO 666
        ENDIF
C
C     CALCUL DES DEFORMATIONS LOGARITHMIQUES
C
        CALL EPSLN1(IPMODL,IPCHE1,IPCHE2,IPEPSI,IMIL)
        IF (IERR.NE.0) GOTO 666
        IRET=1
C
      ENDIF
C
C     ECRITURE DU MCHAML DE DEFORMATIONS RESULTAT
C
      IF (IRET.EQ.1.and.kerr.eq.0) THEN
        CALL ACTOBJ('MCHAML  ',IPEPSI,1)
        call ecrOBJ('MCHAML  ',IPEPSI)
      ENDIF
      if (kerr.ne.0) then
        call ecrent(kerr)
        call soucis(kerr)
      endif
 666  CONTINUE
 
      END