37
38
39
40 USE elbufdef_mod
41
42
43
44#include "implicit_f.inc"
45
46
47
48#include "mvsiz_p.inc"
49
50
51
52#include "param_c.inc"
53
54
55
56 INTEGER JFT, JLT
57 INTEGER MAT(*)
58
60 . pm(npropm,*),dama_g(mvsiz,3)
61 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
62
63
64
65 INTEGER I,MX,IAD,J,K,ipr,NBDAMA,ISYM
66
68 . cc(mvsiz,3,3),b(mvsiz,3,3),g33(mvsiz,3,3)
70 . nu,lamda,gg,c1,qc(mvsiz,9),qcg(mvsiz,9),qg(mvsiz,9),
71 . qgc(mvsiz,9),g3(mvsiz,3),dam
73 . c3(mvsiz,3),damang(mvsiz,6)
74 TYPE(L_BUFEL_) ,POINTER :: LBUF
75
76 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
77 mx = mat(1)
78
79 CALL mmodul24c(jlt ,pm(1,mx),lbuf%DAM,lbuf%CRAK ,
80 . cc ,g3 ,lbuf%ANG,damang ,nbdama)
81 IF (nbdama==0) THEN
82 dama_g(jft:jlt,1:3)= zero
83 ELSE
84 c3(jft:jlt,1:3)=pm(24,mx)
85
86 CALL gettransv(jft,jlt,damang ,qc,qcg,qgc,qg)
87 b(jft:jlt,1:3,1:3)=zero
88
89 DO j= 1,3
90 DO i=jft,jlt
91 b(i,j,j)=g3(i,j)
92 ENDDO
93 ENDDO
94 isym = 1
95 CALL cbatran3v(jft ,jlt ,qc ,cc ,qc ,isym)
97
98 DO j= 1,3
99 DO i=jft,jlt
100 cc(i,j,j)=cc(i,j,j)+four*b(i,j,j)
101 ENDDO
102 ENDDO
103
104 DO j= 1,3
105 DO i=jft,jlt
106 dam = one-cc(i,j,j)/c3(i,j)
107 dama_g(i,j)=
max(zero,dam)
108 ENDDO
109 ENDDO
110 END IF
111
112 RETURN
subroutine cbatran3v(jft, jlt, vqi, kk, vqj, isym)
subroutine gettransv(jft, jlt, gama, qc, qcg, qgc, qg)
subroutine mmodul24c(nel, pm, dam, crak, cdam, g3, ang, damang, nbdama)