1 : C LADEP SOURCE CHAT 05/01/13 01:12:04 5004 2 : SUBROUTINE LADEP(S1,DEP,PAEC,SEQ,NSTRS,IFOU, 3 : & DFSIG,D2FSIG,DLAM,D,DP,BETJEF) 4 : C 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : DIMENSION S1(4),DEP(4,4),DP(4,4),AH(4,4),IS(4) 8 : DIMENSION D(4,4),AC(6),AB(6),D2FSIG(4,4),DFSIG(4) 9 : DIMENSION AI(4,4), AJ(4,4), AK(4,4),AKI(4,4) 10 : * 11 : SEGMENT BETJEF 12 : REAL*8 AA,BETA,RB,ALPHA,YOUN,XNU,GFC,GFT,CAR,ETA,TDEF, 13 : & TCON,DPSTF1,DPSTF2,TETA,PDT,TP0 14 : INTEGER ICT,ICC,IMOD,IVISS,ITER, 15 : & ISIM,IBB1,IGAU1,IZON 16 : ENDSEGMENT 17 : * 18 : * COMMON /DBETJEF/AA,BETA,RB,ALPHA,YOUN,XNU,GFC,GFT,CAR,ETA,TDEF, 19 : * & TCON,DPSTF1,DPSTF2,TETA,PDT,ICT,ICC,IMOD,IVISS,ITER, 20 : * & ISIM,IBB1,IGAU1,IZON 21 : C ************************************************* 22 : C ** CALCUL DE LA MATRICE ELASTOPLASTIQUE [Dep] ** 23 : C ************************************************* 24 : C------------------------------------------------------------------- 24 : CALL ZERO(DEP,4,4) 24 : CALL ZERO(DP,4,4) 24 : CALL ZERO(AB,6,1) 24 : CALL ZERO(AC,6,1) 25 : C------------------------------------------------------------------- 26 : IF (IMOD.EQ.1.OR.IMOD.EQ.3) THEN 27 : AD=YOUN/(1.D0-XNU*XNU) 28 : D(1,1)=AD 29 : D(2,2)=D(1,1) 30 : D(3,3)=AD*(1.D0-XNU)/2.D0 31 : D(1,2)=AD*XNU 32 : D(2,1)=D(1,2) 33 : D(1,3)=0.D0 34 : D(2,3)=0.D0 35 : D(3,1)=0.D0 36 : D(3,2)=0.D0 37 : ENDIF 38 : IF (IMOD.EQ.2.OR.IMOD.EQ.4) THEN 39 : ADD=YOUN/((1.D0+XNU)*(1.D0-2.D0*XNU)) 40 : D(1,1)=ADD*(1.D0-XNU) 41 : D(2,2)=D(1,1) 42 : D(3,3)=D(1,1) 43 : D(1,2)=ADD*XNU 44 : D(2,1)=D(1,2) 45 : D(1,3)=D(1,2) 46 : D(2,3)=D(1,2) 47 : D(3,1)=D(1,2) 48 : D(3,2)=D(1,2) 49 : D(1,4)=0.D0 50 : D(2,4)=0.D0 51 : D(3,4)=0.D0 52 : D(4,1)=0.D0 53 : D(4,2)=0.D0 54 : D(4,3)=0.D0 55 : D(4,4)=0.5*ADD*(1.D0-2.D0*XNU) 56 : ENDIF 57 : C------------------------------------------------------------------- 58 : DO 1 I=1,NSTRS 59 : DO 1 J=1,NSTRS 60 : IF (I.EQ.J) THEN 61 : AI(I,J)=1.D0 62 : ELSE 63 : AI(I,J)=0.D0 64 : ENDIF 65 : 1 CONTINUE 66 : C 67 : DO 2 I=1,NSTRS 68 : DO 2 J=1,NSTRS 69 : AJ(I,J)=D(I,J) 70 : 2 CONTINUE 71 : C------------------------------------------------------------------- 71 : CALL INVMA2(AJ,NSTRS,ISING) 72 : IF (ISING.EQ.1) THEN 73 : C WRITE(*,*)'MATRICE AJ singuliere dans eladep ' 74 : ENDIF 75 : C------------------------------------------------------------------- 76 : C 77 : DO 3 I=1,NSTRS 78 : DO 3 J=1,NSTRS 79 : AK(I,J)=AJ(I,J)+DLAM*D2FSIG(I,J) 80 : 3 CONTINUE 81 : DO 13 I=1,NSTRS 82 : DO 13 J=1,NSTRS 83 : AH(I,J)=AK(I,J) 84 : 13 CONTINUE 85 : C------------------------------------------------------------------- 85 : CALL INVMA2(AH,NSTRS,ISING) 86 : IF (ISING.EQ.1) THEN 87 : C WRITE(*,*)'MATRICE AKI singuliere ds ladep ' 88 : ENDIF 89 : C------------------------------------------------------------------- 90 : C 91 : DO 5 I=1,NSTRS 92 : DO 5 J=1,NSTRS 93 : AB(I)=AB(I)+AH(I,J)*DFSIG(J) 94 : 5 CONTINUE 95 : C 96 : DO 6 I=1,NSTRS 97 : DO 6 J=1,NSTRS 98 : AC(I)=AC(I)+AH(J,I)*DFSIG(J) 99 : 6 CONTINUE 100 : C 101 : DO 7 I=1,NSTRS 102 : DO 7 J=1,NSTRS 103 : DP(I,J)=DP(I,J)+AB(I)*AC(J) 104 : 7 CONTINUE 105 : C 106 : H1=0.D0 107 : DO 8 I=1,NSTRS 108 : H1=H1+DFSIG(I)*AB(I) 109 : 8 CONTINUE 110 : C 111 : HA=H1+PAEC 112 : DO 9 I=1,NSTRS 113 : DO 9 J=1,NSTRS 114 : DP(I,J)=DP(I,J)/HA 115 : DEP(I,J)=AH(I,J)-DP(I,J) 116 : 9 CONTINUE 117 : C 118 : DO 10 I=1,NSTRS 119 : DO 10 J=1,NSTRS 120 : IF (DABS(DEP(I,J)).LT.1.D-5) THEN 121 : DEP(I,J)=0.D0 122 : ENDIF 123 : 10 CONTINUE 124 : C------------------------------------------------------------------- 125 : RETURN 126 : END 127 : 128 : 129 : 130 :
© Cast3M 2003 - All rights reserved.
Disclaimer