Sources Esope | Cast3M

ladep1
C LADEP1    SOURCE    CB215821  16/04/21    21:17:39     8920
C LADEP1    SOURCE   GEOR   95/11/29
      SUBROUTINE LADEP1(S1,DEP,PAECT,PAEC,NSTRS,IFOU,
     & DFSIG1,DFSIG2,D2FSI1,D2FSI2,DLAM,BETJEF)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION S1(4),DEP(4,4),DP(4,4),IS(4)
      DIMENSION D(4,4),D2FSI1(4,4),DFSIG1(4)
      DIMENSION AI(4,4), AJ(4,4),AK(4,4), AKI(4,4),AH(4,4)
      DIMENSION D2FSI2(4,4),DFSIG2(4),DLAM(2),AU(4,2),AV(2,4)
      DIMENSION AB(4,2),AC(2,4),AD(2,2),ADI(2,2),AE(2,2)
      DIMENSION ABC(2,4),ACD(4,4),AF(4,4)
*
      SEGMENT BETJEF
       REAL*8 AA,BETA,RB,ALPHA,YOUN,XNU,GFC,GFT,CAR,ETA,TDEF,
     &          TCON,DPSTF1,DPSTF2,TETA,PDT
       INTEGER ICT,ICC,IMOD,IVISS,ITER,
     &                ISIM,IBB1,IGAU1,IZON
      ENDSEGMENT
*
*     COMMON /DBETJEF/AA,BETA,RB,ALPHA,YOUN,XNU,GFC,GFT,CAR,ETA,TDEF,
*    &          TCON,DPSTF1,DPSTF2,TETA,PDT,ICT,ICC,IMOD,IVISS,ITER,
*    &                ISIM,IBB1,IGAU1,IZON
C
C             *************************************************
C             **  CALCUL DE LA MATRICE ELASTOPLASTIQUE [Dep] **
C             *************************************************
C-------------------------------------------------------------------
      CALL ZERO(DEP,NSTRS,NSTRS)
      CALL ZERO(DP,NSTRS,NSTRS)
      CALL ZERO(AK,4,4)
      CALL ZERO(AKI,4,4)
      CALL ZERO(AU,4,2)
      CALL ZERO(AV,2,4)
      CALL ZERO(AB,4,2)
      CALL ZERO(AC,2,4)
      CALL ZERO(AD,2,2)
      CALL ZERO(ADI,2,2)
      CALL ZERO(ABC,2,4)
      CALL ZERO(ACD,4,2)
C-------------------------------------------------------------------
      IF (IMOD.EQ.1.OR.IMOD.EQ.3) THEN
      ADD=YOUN/(1.D0-XNU*XNU)
      D(1,1)=ADD
      D(2,2)=D(1,1)
      D(3,3)=ADD*(1.D0-XNU)/2.D0
      D(1,2)=ADD*XNU
      D(2,1)=D(1,2)
      D(1,3)=0.D0
      D(2,3)=0.D0
      D(3,1)=0.D0
      D(3,2)=0.D0
      ENDIF
      IF (IMOD.EQ.2.OR.IMOD.EQ.4) THEN
      ADD=YOUN/((1.D0+XNU)*(1.D0-2.D0*XNU))
      D(1,1)=ADD*(1.D0-XNU)
      D(2,2)=D(1,1)
      D(3,3)=D(1,1)
      D(1,2)=ADD*XNU
      D(2,1)=D(1,2)
      D(1,3)=D(1,2)
      D(2,3)=D(1,2)
      D(3,1)=D(1,2)
      D(3,2)=D(1,2)
      D(1,4)=0.D0
      D(2,4)=0.D0
      D(3,4)=0.D0
      D(4,1)=0.D0
      D(4,2)=0.D0
      D(4,3)=0.D0
      D(4,4)=0.5*ADD*(1.D0-2.D0*XNU)
      ENDIF
C-------------------------------------------------------------------
      DO 1 I=1,NSTRS
      DO 1 J=1,NSTRS
        IF (I.EQ.J) THEN
         AI(I,J)=1.D0
        ELSE
         AI(I,J)=0.D0
        ENDIF
    1 CONTINUE
C
      DO 2 I=1,NSTRS
      DO 2 J=1,NSTRS
         AJ(I,J)=D(I,J)
    2 CONTINUE
C-------------------------------------------------------------------
      CALL INVMA2(AJ,NSTRS,ISING)
      IF (ISING.EQ.1) THEN
C       WRITE(*,*)'MATRICE AJ singuliere ds eladep '
      ENDIF
C-------------------------------------------------------------------
      DO 4 I=1,NSTRS
      DO 4 J=1,NSTRS
        AK(I,J)=AJ(I,J)+DLAM(1)*D2FSI1(I,J)+DLAM(2)*D2FSI2(I,J)
    4 CONTINUE
      DO 5 I=1,NSTRS
      DO 5 J=1,NSTRS
        AH(I,J)=AK(I,J)
    5 CONTINUE
C-------------------------------------------------------------------
      CALL INVMA2(AH,NSTRS,ISING)
      IF (ISING.EQ.1) THEN
C       WRITE(*,*)'MATRICE AH singuliere dans ladep1 '
      ENDIF
C-------------------------------------------------------------------
 
      DO 7 I=1,NSTRS
        AU(I,1)=DFSIG1(I)
    7 CONTINUE
C
      DO 8 I=1,NSTRS
        AU(I,2)=DFSIG2(I)
    8 CONTINUE
C
      DO 19 J=1,NSTRS
        AV(1,J)=DFSIG1(J)
   19 CONTINUE
C
      DO 20 J=1,NSTRS
        AV(2,J)=DFSIG2(J)
   20 CONTINUE
C
      AE(1,1)=PAECT
      AE(2,2)=PAEC
      AE(1,2)=0.D0
      AE(2,1)=0.D0
C-------------------------------------------------------------------
C
      DO 9 I=1,NSTRS
      DO 9 J=1,2
        AB(I,J)=AB(I,J)+AH(I,J)*AU(I,J)
    9 CONTINUE
C
      DO 10 I=1,2
      DO 10 J=1,NSTRS
       AC(I,J)=AC(I,J)+AV(I,J)*AB(I,J)
   10 CONTINUE
C
      DO 11 I=1,2
      DO 11 J=1,2
       AD(I,J)=AE(I,J)+AC(I,J)
   11 CONTINUE
C
      DO 12 I=1,2
      DO 12 J=1,2
       ADI(I,J)=AD(I,J)
   12 CONTINUE
C-------------------------------------------------------------------
      CALL INVER(ADI,2,ISING,AK,IS,1.D-5)
C-------------------------------------------------------------------
C
      DO 13 I=1,2
      DO 13 J=1,NSTRS
        ABC(I,J)=ABC(I,J)+ADI(I,J)*AV(I,J)
   13 CONTINUE
C
      DO 14 I=1,NSTRS
      DO 14 J=1,NSTRS
      DO 14 K=1,2
        ACD(I,J)=ACD(I,J)+AU(I,K)*ABC(K,J)
   14 CONTINUE
C
      DO 15 I=1,NSTRS
      DO 15 J=1,NSTRS
         AF(I,J)=0.D0
      DO 15 K=1,NSTRS
         AF(I,J)=AF(I,J)+ACD(I,K)*AH(K,J)
   15 CONTINUE
C
      DO 16 I=1,NSTRS
      DO 16 J=1,NSTRS
         DP(I,J)=0.D0
      DO 16 K=1,NSTRS
         DP(I,J)=DP(I,J)+AH(I,K)*AF(K,J)
   16 CONTINUE
C
      DO 17 I=1,NSTRS
      DO 17 J=1,NSTRS
       DEP(I,J)=AH(I,J)-DP(I,J)
   17 CONTINUE
C
      DO 18 I=1,NSTRS
      DO 18 J=1,NSTRS
        IF (ABS(DEP(I,J)).LT.1.D-5) THEN
          DEP(I,J)=0.D0
        ENDIF
   18 CONTINUE
C-------------------------------------------------------------------
      RETURN
      END