Sources Esope | Cast3M

rotat2
C ROTAT2    SOURCE    CHAT      05/01/13    03:05:03     5004
C MAZARS    SOURCE    AM        93/02/26    21:18:27     808
      SUBROUTINE ROTAT2 (WRK0,WRK1,WRKK2,WRK5,NSTRS,NVARI,
     1                                       NMATT,ISTEP,ICARA)
C
C
C     variables en entree
C
C
C     WRK0     pointeur sur un segment deformation au pas precedent
C
C     WRK1     pointeur sur un segment increment de deformation
C
C     WRKK2     pointeur sur un segment variables internes au pas precedent
C
C     WRK5      pointeur sur un segment de deformations inelastiques
C
C     XMATER     constantes du materiau
C
C     NSTRS      nombre de composantes dans les vecteurs des contraintes
C                                        et les vecteurs des deformations
C
C     NVARI      nombre de variables internes (doit etre egal a 2)
C
C     NMATT      nombre de constantes du materiau
C
C     ISTEP      flag utilise pour separer les etapes dans un calcul non local
C                ISTEP=0 -----> calcul local
C                ISTEP=1 -----> calcul non local etape 1 on calcule les seuils
C                ISTEP=2 -----> calcul non local etape 2 on continue le calcul
C                               a partir des seuils moyennes
C
C     variables en sortie
C
C     VARINF      variables internes finales
C
C     SIGMAF      contraintes finales
C
C     C. LA BORDERIE MARS 1992
C     declaration des variables
C
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC PPARAM
-INC CCOPTIO
      SEGMENT WRK0
        REAL*8 XMAT(NMATT)
      ENDSEGMENT
*
      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 WRKK2
         REAL*8 EPSILI(NSTRS)
      ENDSEGMENT
      SEGMENT WRK5
        REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
      ENDSEGMENT
      CHARACTER*8 CMATE
      INTEGER NSTRS,NVARI,NMATT,ISTEP
      REAL*8 EPSILO(6),EPSNT(3),SIGNT(3),T(3,3),EPSXY(3),SIGXY(3)
      REAL*8 MUP0,MU,MUP,EPCR
      REAL*8 EPSMAX,EPSNN,EPSMAX1
      REAL*8 SINUS,COSINUS
      INTEGER CAS
      PARAMETER (XZERO=0.D0 , UN=1.D0 , DEUX=2.D0, XPETIT=1.D-12)
 
C
C
C     recuperation des variables initiales dans les tableaux
C
C
      N=NSTRS
      CMATE = 'ISOTROPE'
      YOUN = XMAT(1)
      XNU  = XMAT(2)
      EPCR = XMAT(5)
      MUP0 = XMAT(6)
      EPSMAX = VAR0(1)
      EPSNN=VAR0(2)
C
C        calcul de la deformation totale
C
      DO 100 ISTRS=1,NSTRS
         EPSILO(ISTRS)=EPSILI(ISTRS)+DEPST(ISTRS)
100   CONTINUE
      EPSXY(1)=EPSILO(1)
      EPSXY(2)=EPSILO(2)
      EPSXY(3)=EPSILO(4)
      CALL DIACL (EPSXY,SINUS,COSINUS)
      t(1,1)=COSINUS**2
      t(2,1)=SINUS**2
      t(3,1)=-2.D0*COSINUS*SINUS
      t(1,2)=SINUS**2
      t(2,2)=COSINUS**2
      t(3,2)=2.D0*COSINUS*SINUS
      t(1,3)=COSINUS*SINUS
      t(2,3)=-COSINUS*SINUS
      t(3,3)=COSINUS**2 - SINUS**2
      DO I=1,3
        EPSNT(I)=0.D0
                DO J=1,3
                   EPSNT(I)=EPSNT(I)+T(I,J)*EPSXY(J)
                 END DO
      END DO
*
*INITIALISATION DU EPSM
*
      IF (ISTEP .EQ. 2) THEN
        EPSNNM=EPSNN
      ELSE
        EPSNNM=EPSNT(1)
      END IF
      EPSMAX1=MAX(EPSMAX,EPCR)
*
*CALCUL DE MU DANS LES DIFFERENTS CAS
*
        IF (EPSNNM.LE.0.d0) THEN
          MUP=1.D0
          MU=MUP
          CAS=1
        ELSE IF (EPSNNM .LE. EPSMAX1) THEN
          IF (EPSMAX1.LE. EPCR*(1.D0-1.D0/MUP0))THEN
            MUP=(EPCR+MUP0*(EPSMAX1-EPCR))/EPSMAX1
          ELSE
            MUP=0.D0
          END IF
                 CAS=2
          MU=MUP
        ELSE IF (EPSNNM .LE. EPCR*(1.D0-1.D0/MUP0))THEN
          IF (EPSMAX1 .LT. EPCR)THEN
            MUP=(EPCR+MUP0*(EPSNNM-EPCR)-EPSMAX1)/(EPSNNM-EPSMAX1)
          ELSE
            MUP=MUP0
          END IF
          MU=(EPCR+MUP0*(EPSNNM-EPCR))/EPSNNM
          EPSMAX=EPSNNM
          CAS=3
        ELSE
          IF ( EPSMAX1 .LT. EPCR*(1.D0-1.D0/MUP0))  then
            MUP=(EPCR+MUP0*(EPSMAX1-EPCR))/(EPSMAX1-EPSNNM)
          ELSE
            MUP=0.D0
          END IF
          MU=0.D0
          CAS=4
          EPSMAX1=EPSNNM
        END IF
C
C       On calcule la contrainte dans le repere principal
C
      IF (ISTEP .NE. 1) THEN
        EPSNN=EPSNT(1)
        EPSTT=EPSNT(2)
        SIGNN=MU*YOUN/(1.D0-XNU*XNU*MU)*(EPSNN+XNU*EPSTT)
        SIGTT=YOUN/(1.D0-XNU*XNU*MU)*(EPSTT+XNU*MU*EPSNN)
        SIGNT(1)=SIGNN
        SIGNT(2)=SIGTT
        SIGNT(3)=0.D0
C
C       Finalement la contrainte est calculee dans le repere de travail
C
        DO I=1,3
          SIGXY(I)=0.D0
          DO J=1,3
            SIGXY(I)=SIGXY(I)+T(J,I)*SIGNT(J)
          END DO
        END DO
        SIGF(1)=SIGXY(1)
        SIGF(2)=SIGXY(2)
        SIGF(3)=XZERO
        SIGF(4)=SIGXY(3)
 
C
C         et les deformations inelastiques finales
C
         EPSIN=(UN-MU)/(UN-XNU*XNU*MU)*(EPSNN+XNU*EPSTT)
         EPINF(1)=T(1,1)*EPSIN
         EPINF(2)=T(1,2)*EPSIN
         EPINF(3)=XZERO
         EPINF(4)=T(1,3)*EPSIN
      END IF
      VARF(1)= MAX(EPSMAX,EPSNN)
      VARF(2)=EPSNNM
C      print*,cas,epsmax1,epsnnm,mu,epsin
C      print*,'epsnt=',epsnt
C      print*,'signt=',signt
C      print*,'sigxy=',sigxy evol1 fx);
C      print*,'istep=',istep
C      print*,'epsnn=',epsnn
C      print*,'epsnnm=',epsnnm
C      print*,'epcr=',epcr,'mup0=',mup0
C      print*,'mu=',mu,epsin
C      PRINT*,'VARF',(VARF(I),I=1,2)
C      PRINT*,'EPINF',(EPINF(I),I=1,NSTRS)
C      PRINT*,'SIGF',(SIGF(I),I=1,NSTRS)
C      PRINT*,'EPSILO',(EPSILO(I),I=1,NSTRS)
C      PRINT*,'EPSILI',(EPSILI(I),I=1,NSTRS)
C      PRINT*,'DEPST',(DEPST(I),I=1,NSTRS)
C      print*
      RETURN
      END