C LADEP SOURCE CHAT 05/01/13 01:12:04 5004 SUBROUTINE LADEP(S1,DEP,PAEC,SEQ,NSTRS,IFOU, & DFSIG,D2FSIG,DLAM,D,DP,BETJEF) C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION S1(4),DEP(4,4),DP(4,4),AH(4,4),IS(4) DIMENSION D(4,4),AC(6),AB(6),D2FSIG(4,4),DFSIG(4) DIMENSION AI(4,4), AJ(4,4), AK(4,4),AKI(4,4) * SEGMENT BETJEF REAL*8 AA,BETA,RB,ALPHA,YOUN,XNU,GFC,GFT,CAR,ETA,TDEF, & TCON,DPSTF1,DPSTF2,TETA,PDT,TP0 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 ** CALCUL DE LA MATRICE ELASTOPLASTIQUE [Dep] ** C ************************************************* C------------------------------------------------------------------- CALL ZERO(DEP,4,4) CALL ZERO(DP,4,4) CALL ZERO(AB,6,1) CALL ZERO(AC,6,1) C------------------------------------------------------------------- IF (IMOD.EQ.1.OR.IMOD.EQ.3) THEN AD=YOUN/(1.D0-XNU*XNU) D(1,1)=AD D(2,2)=D(1,1) D(3,3)=AD*(1.D0-XNU)/2.D0 D(1,2)=AD*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 dans eladep ' ENDIF C------------------------------------------------------------------- C DO 3 I=1,NSTRS DO 3 J=1,NSTRS AK(I,J)=AJ(I,J)+DLAM*D2FSIG(I,J) 3 CONTINUE DO 13 I=1,NSTRS DO 13 J=1,NSTRS AH(I,J)=AK(I,J) 13 CONTINUE C------------------------------------------------------------------- CALL INVMA2(AH,NSTRS,ISING) IF (ISING.EQ.1) THEN C WRITE(*,*)'MATRICE AKI singuliere ds ladep ' ENDIF C------------------------------------------------------------------- C DO 5 I=1,NSTRS DO 5 J=1,NSTRS AB(I)=AB(I)+AH(I,J)*DFSIG(J) 5 CONTINUE C DO 6 I=1,NSTRS DO 6 J=1,NSTRS AC(I)=AC(I)+AH(J,I)*DFSIG(J) 6 CONTINUE C DO 7 I=1,NSTRS DO 7 J=1,NSTRS DP(I,J)=DP(I,J)+AB(I)*AC(J) 7 CONTINUE C H1=0.D0 DO 8 I=1,NSTRS H1=H1+DFSIG(I)*AB(I) 8 CONTINUE C HA=H1+PAEC DO 9 I=1,NSTRS DO 9 J=1,NSTRS DP(I,J)=DP(I,J)/HA DEP(I,J)=AH(I,J)-DP(I,J) 9 CONTINUE C DO 10 I=1,NSTRS DO 10 J=1,NSTRS IF (DABS(DEP(I,J)).LT.1.D-5) THEN DEP(I,J)=0.D0 ENDIF 10 CONTINUE C------------------------------------------------------------------- RETURN END