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