Sources Esope | Cast3M

defsig
C DEFSIG    SOURCE    OF166741  25/02/21    21:15:52     12166          
      SUBROUTINE DEFSIG(MFR,NDEF,
     .           INPLAS,IND,WRK1,WRK5,WTRAV,
     .           IVASTF,IVARIF,IVADEP,COB,XMOB,
     .           IB,IGAU,CMATE,MATE,MELE,KERRE)
 
**************************************************
*  ENTREES
**************************************************
*
* MFR     : formulation de l'élément
* NSTRS   : nombre de composantes des contraintes
* NVARI   : nombre des variables internes
* NDEF    : nombre des déformations
* INPLAS  : numéro du matériau inélastique
* IND     :
* SIGF    : contraintes à la fin du pas (WRK1)
* SIG0    : contraintes au début du pas (WRK1)
* DSIGT   : incrément de contrainte au cours du pas (WTRAV)
* EPINF   : déformations inélastiques à la fin du pas (WRK5)
* EPIN0   : déformations inélastiques au début du pas (WRK5)
* EPST0   : déformations totales au début du pas (WRK5)
* VARF    : variables internes à la fin du pas (WRK1)
* IVASTF  : pointeur sur un segment mptval de contraintes
* IVARIF  : pointeur sur un segment mptval de variables internes
* IVADEP  : pointeur sur un segment mptval de deformations inelastiques
* COB     : porosité
* IB      : numéro de l'élément
* IGAU    : numéro du point de Gauss
* DEFP    : incrément de déformations inélastiques (WRK1)
* CMATE   : nom du matériau
* MATE    : numéro du matériau élastique
* MELE    : numéro élément fini
*
**************************************************
*  SORTIES
**************************************************
*
* KERRE  : indice d'erreur
* SEGMENT COMPRENANT :
*           - les contraintes finales
*           - les variables internes finales
*           - les incréments de déformations inélastiques
*
**************************************************
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
 
-INC SMCHAML
 
-INC TMPTVAL
 
      SEGMENT WRK1
        REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
        REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
        REAL*8 DEFP(NSTRS),XCAR(ICARA)
      ENDSEGMENT
*
      SEGMENT WRK5
        REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
      ENDSEGMENT
*
      SEGMENT WTRAV
        REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
        REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
        REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
        REAL*8 XLOC(3,3),XGLOB(3,3)
        REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
      ENDSEGMENT
 
      CHARACTER*8 CMATE
*
*           rearrangement pour milieu poreux
*
      NSTRS=SIGF(/1)
      NVARI=VARF(/1)
      KERRE=0
*
*ZZZZZ     CAS DES JOINTS NON LINEAIRES : A VOIR !
*
      IF (MFR.EQ.33) THEN
*             calcul des contraintes totales
*
        SIGF(NSTRS) = SIG0(NSTRS)+DEPST(NSTRS)/XMOB
        DO 1994 IC=1,3
          IF(IFOUR.EQ.-2.AND.IC.EQ.3) GO TO 1994
          SIGF(IC) = SIGF(IC)
     &                    -COB*(EPST0(NSTRS)+DEPST(NSTRS))
*
*               ce qui suit a ete pompe plus bas
*
            IF(IND.EQ.1.OR.INPLAS.EQ.31.OR.INPLAS.EQ.30
     &                     .OR.INPLAS.EQ.37.OR.INPLAS.EQ.66
     &                      .OR.INPLAS.EQ.141)THEN
                  SIGF(NSTRS) = SIGF(NSTRS)
     &              +COB*(DEPST(IC)- (EPINF(IC)-EPIN0(IC)))
                ELSE
                  SIGF(NSTRS) = SIGF(NSTRS)
     &                         +COB*(DEPST(IC)-  DEFP(IC))
                ENDIF
1994    CONTINUE
      ENDIF
 
      MPTVAL=IVASTF
      DO IC=1,NSTRS
         MELVAL=IVAL(IC)
         VELCHE(IGAU,IB)=SIGF(IC)
      ENDDO
c
c     et les variables internes finales
c
      MPTVAL=IVARIF
      IF(MFR.EQ.7.AND.CMATE.EQ.'SECTION')THEN
        DO IC=1,NVARI
          MELVAL=IVAL(IC)
          IELCHE(IGAU,IB)=NINT(VARF(IC))
        END DO
*
*             Modele MAXWELL - composante EPSE
*
      ELSE IF(INPLAS.EQ.74) THEN
*
        MELVAL=IVAL(1)
        VELCHE(IGAU,IB)=VARF(1)
*
*             les autres composantes
*
        DO IC=2,NVARI
          MELVAL=IVAL(IC)
          IELCHE(IGAU,IB)=NINT(VARF(IC))
        END DO
*
      ELSE
        DO IC=1,NVARI
          MELVAL=IVAL(IC)
          VELCHE(IGAU,IB)=VARF(IC)
        ENDDO
      ENDIF
c
c     et les increments de deformations plastiques
c
      MPTVAL=IVADEP
      IF (IND.EQ.1.OR.INPLAS.EQ.31.OR.INPLAS.EQ.30
     &         .OR.INPLAS.EQ.37.OR.INPLAS.EQ.66.OR.INPLAS.EQ.118
     &          .OR. INPLAS.EQ.141)THEN
        DO IC=1,NDEF
          MELVAL=IVAL(IC)
          VELCHE(IGAU,IB)=EPINF(IC)-EPIN0(IC)
        ENDDO
      ELSE
        DO IC=1,NDEF
          MELVAL=IVAL(IC)
          VELCHE(IGAU,IB)=DEFP(IC)
        ENDDO
      ENDIF
 
      RETURN
      END