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