Sources Esope | Cast3M

vispl1
C VISPL1    SOURCE    CHAT      05/01/13    04:07:26     5004
C VISPL1    SOURCE    AM        00/12/21    21:26:00     4062
      SUBROUTINE VISPL1(SIGP,DSIGT,NSTRS,SIGF,SIGRV,DSTRN,
     &         DEPS1,DEPS2,BETJEF,VISCO,NECH0,NECH1)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION SIGP(4),DSIGT(4),DSTRN(4),D(4,4)
      DIMENSION DSIG(4),DSIG2(4),DSIG3(4),DP(4,4)
      DIMENSION SIGF(4),SIGRV(4),DF(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 DPSITV1,DPSITV2,SIGV1,SIGV2,ENDV
      ENDSEGMENT
      SEGMENT NECH0
       REAL*8 DT,DC,ALFG,S0,ENDO
      ENDSEGMENT
      SEGMENT NECH1
       REAL*8 ENDL
      ENDSEGMENT
C
C
C ********************************************************************
C **              COMPORTEMENT VISCOPLASTIQUE_ENDOMMAGEABLE         **
C **                    DE TYPE DUVAUT LIONS                        **
C ********************************************************************
C
      IPAS=0
      DAM = 0.D0
      CALL ZERO(DSIG2,4,1)
      CALL ZERO(DSIG3,4,1)
      DPSTV1 = DPSITV1
      DPSTV2 = DPSITV2
      ENDV0 = ENDV
      ENDO0 = ENDO
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 -------------------- creation matrice de young -------------------
C
      IF (IMOD.EQ.1.OR.IMOD.EQ.3) THEN
        CALL CREMAT(D,YOUN,XNU,3,-2)
      ENDIF
      IF (IMOD.EQ.2.OR.IMOD.EQ.4) THEN
        CALL CREMAT(D,YOUN,XNU,4,-1)
      ENDIF
C
C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
C        MISE A JOUR DES VARIABLES D'ECROUISSAGES
C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
C
           DPSTV1=DPSTV1*G+(1.D0-G)*DEPS1
           CALL UNICO1(DPSTV1,PAEC,1,SIGV1,BETJEF,NECH0,NECH1)
           DPSTV2=DPSTV2*G+(1.D0-G)*DEPS2
           CALL UNICO1(DPSTV2,PAEC,2,SIGV2,BETJEF,NECH0,NECH1)
C
C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
C       MISE A JOUR DE LA VARIABLE D'ENDOMMAGEMENT VISQUEUSE
C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
C
        CALL DAMAG1(DPSTV1,DPSTV2,ENDC,
     &          ENDT,IFIS,IPLA,3,BETJEF,NECH0,NECH1)
       ENDV = 1.D0-((1.D0-ENDC)*(1.D0-ENDT))
C
C ------------ mise a jour contrainte ----------------------
C ------ methode explicite
CC      DD = (ENDV - ENDV0) / PDT
CC      FF = 1. - ENDV0
CC      FK = -((1./ETA)+(DD/FF))
CC      DO 15 I=1,NSTRS
CC      DF(I) = FK*SIGRV(I)+FF*(DSIGT(I)/PDT)+(SIGP(I)/ETA)
CC   15 CONTINUE
C ------------ resolution numerique de l equa diff ---------------
CC      CALL ZERO(SIGF,4,1)
CC      DO 36 I=1,NSTRS
CC      SIGF(I)= SIGRV(I) + PDT * DF(I)
CC   36 CONTINUE
C
      DD = (ENDV - ENDV0)/(1. - ENDV)
      FK = (PDT/ETA)
      CC = 1./(1 + FK + DD)
C
C ------------ resolution numerique de l equa diff ---------------
      CALL ZERO(SIGF,4,1)
      DO 37 I=1,NSTRS
      SIGF(I)= CC *(SIGRV(I) + (1.-ENDV)*DSIGT(I) + FK*SIGP(I))
   37 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 INDIC1(DPSTV1,DPSTV2,IFIS,IPLA,3,BETJEF,NECH0,NECH1)
C
      DPSITV1 = DPSTV1
      DPSITV2 = DPSTV2
      RETURN
      END