Sources Esope | Cast3M

vispla
C VISPLA    SOURCE    CHAT      05/01/13    04:07:29     5004
      SUBROUTINE VISPLA(SIGR,SIGF,DSIG1,NSTRS,DPSTF1,DPSTF2,
     &                      SIGP,SIGRV,DSTRN,DP,BETJEF,VISCO)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION SIGR(4),SIGF(4),DSIG(4),DSTRN(4),D(4,4),EPST(4)
      DIMENSION DSIG1(4),DSIG2(4),DSIG3(4),DSTRN1(4),DP(4,4)
      DIMENSION DSIGP(4),SIGP(4),SIGP0(4),SIGRV(4)
C
*
      SEGMENT BETJEF
       REAL*8 AA,BETA,RB,ALFA,YOUN,XNU,GFC,GFT,CAR,ETA,TDEF,
     &          TCON,DPS1,DPS2,TETA,PDT,TP0
       INTEGER ICT,ICC,IMOD,IVIS,ITER,
     &                ISIM,IBB1,IGAU1,IZON
      ENDSEGMENT
      SEGMENT VISCO
       REAL*8 DPSTV1,DPSTV2,SIGV1,SIGV2,ENDV
      ENDSEGMENT
*
*     COMMON /DBETJEF/AA,BETA,RB,ALFA,YOUN,XNU,GFC,GFT,CAR,ETA,TDEF,
*    &           TCON,DPS1,DPS2,TETA,PDT,ICT,ICC,IMOD,IVIS,ITER,
*    &                ISIM,IBB1,IGAU1,IZON
*     COMMON /VISCO/ DPSTV1,DPSTV2,SIGV1,SIGV2
C
C
C ********************************************************************
C **                 COMPORTEMENT VISCOPLASTIQUE                    **
C **                    DE TYPE DUVAUT LIONS                        **
C ********************************************************************
C
      IPAS=0
      CALL ZERO(DSIG2,4,1)
      CALL ZERO(DSIG3,4,1)
      CALL ZERO(DSTRN1,4,1)
C
C -------------- recalcul des increments de contrainte  -------------
C
C
      DO 2 I=1,NSTRS
        SIGP(I)=SIGF(I)
    2 CONTINUE
C
      DO 3 I=1,NSTRS
        DSIGP(I)=SIGF(I)-SIGR(I)
    3 CONTINUE
C
C ---------------- calcul des termes viscoplastiques -----------------
C
      GAMA = 0.5
      A = (ETA)/(ETA+GAMA*PDT)
      B = (GAMA*PDT)/ETA
      C = PDT
      G=EXP(-PDT/ETA)
      IF (C.EQ.0.D0) THEN
      WRITE(*,*)'l increment de temps est de longueur nulle'
      stop
      ENDIF
C
C -------------------- mise a jour des contraintes -------------------
C
      IF (IMOD.EQ.1) THEN
        CALL CREMAT(D,YOUN,XNU,3,-2)
      ENDIF
      IF (IMOD.EQ.2) THEN
        CALL CREMAT(D,YOUN,XNU,3,-1)
      ENDIF
C
C ------------ Calcul de la matrice tangente consistante --------------
C
      DO 10 I=1,NSTRS
      DO 10 J=1,NSTRS
        DP(I,J)=0.D0
        DP(I,J)=D(I,J)*A
   10 CONTINUE
C
C -------------------- algorithme type SLUYS -------------------
C
      IF (ISIM.EQ.0) THEN
C
      DO 20 I=1,NSTRS
        DSIG2(I)=0.D0
      DO 20 J=1,NSTRS
        DSIG2(I)=DSIG2(I)+D(I,J)*EPST(J)
   20 CONTINUE
C
      DO 30 I=1,NSTRS
        DSIG3(I)=A*(DSIG1(I)-C*DSIG2(I)+B*DSIGP(I))
   30 CONTINUE
C
      DO 40 I=1,NSTRS
        SIGF(I)=SIGR(I)+DSIG3(I)
   40 CONTINUE
      ENDIF
C
C -------------------- algorithme type SIMO -------------------
C
      IF (ISIM.EQ.1) THEN
      CALL ZERO(SIGF,4,1)
      DO 35 I=1,NSTRS
        SIGF(I)=G*SIGRV(I)+(1.D0-G)*SIGP(I)+((1.D0-G)/(C/ETA))*DSIG1(I)
   35 CONTINUE
      ENDIF
C
C ------- mise a jour des variables d'ecrouissages --------
C
      DPSTV1= DPSTV1*G+(1.D0-G)*DPSTF1
      CALL UNICOU(DPSTV1,PAEC,1,SIGV1,BETJEF)
      DPSTV2= DPSTV2*G+(1.D0-G)*DPSTF2
      CALL UNICOU(DPSTV2,PAEC,2,SIGV2,BETJEF)
C
C ------- mise a jour des taux de deformation --------
C
      IF (IMOD.EQ.1) THEN
        CALL MATSOU(D,YOUN,XNU,3,-2)
      ENDIF
      IF (IMOD.EQ.2) THEN
        CALL MATSOU(D,YOUN,XNU,4,-1)
      ENDIF
C
C -------  taux de deformation viscoplastique --------
C
      DO 50 I=1,NSTRS
        DSTRN1(I)=0.D0
      DO 50 J=1,NSTRS
        DSTRN1(I)=DSTRN1(I)+D(I,J)*(DSIG3(J)-DSIGP(J))/ETA
   50 CONTINUE
C
      DO 60 I=1,NSTRS
        EPST(I)=EPST(I)+DSTRN1(I)
   60 CONTINUE
C
C
C -------  taux de deformation en norme --------
C
      TDEF=0.D0
      D1=DSTRN(1)
      D2=DSTRN(2)
      D3=DSTRN(3)
      D4=DSTRN(4)
      TDEF=SQRT(D1*D1+D2*D2+D3*D3+D4*D4)/PDT
C
C -------  taux de contrainte en norme --------
C
      TCON=0.D0
      DO 62 I=1,NSTRS
      DSIG(I) = SIGF(I) - SIGRV(I)
   62 CONTINUE
      S1=DSIG(1)
      S2=DSIG(2)
      S3=DSIG(3)
      S4=DSIG(4)
      TCON=SQRT(S1*S1+S2*S2+S3*S3+S4*S4)/PDT
C
      CALL INDICA(DPSTV1,DPSTV2,IFIS,IPLA,3,BETJEF)
      RETURN
      END