37
38
39
40#include "implicit_f.inc"
41
42
43
44#include "mvsiz_p.inc"
45
46
47
48 INTEGER, INTENT(IN) :: ISRAT
49 INTEGER, INTENT(IN) :: G_PLA,NEL,G_EPSD
50 INTEGER, INTENT(IN) :: NODADT_THERM
51
53 . px(mvsiz,10),py(mvsiz,10),pz(mvsiz,10),
54 . fx(mvsiz,10), fy(mvsiz,10), fz(mvsiz,10),
55 . sig(nel,6),vol(*),qvis(*),eint(*),rho(*),q(*),eplasg(*),eplas(*),
56 . sigg(nel,6),eintg(*),rhog(*),qg(*),wip,sti(*),stig(*),epsd(*),
57 . epsdg(*),conde(*),condeg(*)
58 my_real,
DIMENSION(MVSIZ,6),
INTENT(INOUT) :: svis
59
60
61
62#include "scr18_c.inc"
63
64
65
66 INTEGER I,N
67
69 . s1(mvsiz), s2(mvsiz), s3(mvsiz),
70 . s4(mvsiz), s5(mvsiz), s6(mvsiz),
71 . fint, qvis_loc, vol_loc
72
73 DO i=1,nel
74 qvis_loc = qvis(i)
75 vol_loc = vol(i)
76 sigg(i,1) = sigg(i,1) + wip * sig(i,1)
77 sigg(i,2) = sigg(i,2) + wip * sig(i,2)
78 sigg(i,3) = sigg(i,3) + wip * sig(i,3)
79 sigg(i,4) = sigg(i,4) + wip * sig(i,4)
80 sigg(i,5) = sigg(i,5) + wip * sig(i,5)
81 sigg(i,6) = sigg(i,6) + wip * sig(i,6)
82 rhog(i) = rhog(i) + wip * rho(i)
83 eintg(i) = eintg(i) + wip * eint(i)
84 qg(i) = qg(i) + wip * q(i)
85 stig(i)=stig(i)+sti(i)
86 s1(i)=(sig(i,1)+svis(i,1)-qvis_loc)*vol_loc
87 s2(i)=(sig(i,2)+svis(i,2)-qvis_loc)*vol_loc
88 s3(i)=(sig(i,3)+svis(i,3)-qvis_loc)*vol_loc
89 s4(i)=(sig(i,4)+svis(i,4))*vol_loc
90 s5(i)=(sig(i,5)+svis(i,5))*vol_loc
91 s6(i)=(sig(i,6)+svis(i,6))*vol_loc
92 ENDDO
93
94 IF(nodadt_therm == 1) THEN
95 DO i=1,nel
96 condeg(i)= condeg(i)+ conde(i)
97 ENDDO
98 ENDIF
99
100 IF ((israt > 0).OR.(g_epsd > 0)) THEN
101 DO i=1,nel
102 epsdg(i) = epsdg(i) + wip * epsd(i)
103 ENDDO
104 ENDIF
105 IF (g_pla > 0) THEN
106 DO i=1,nel
107 eplasg(i) = eplasg(i) + wip * eplas(i)
108 ENDDO
109 ENDIF
110
111 DO n=1,10
112 DO i=1,nel
113 fx(i,n)=fx(i,n)-(s1(i)*px(i,n)+s4(i)*py(i,n)+s6(i)*pz(i,n))
114 fy(i,n)=fy(i,n
115 fz(i,n)=fz(i,n)-(s3(i)*pz(i,n)+s6(i)*px(i,n)+s5(i)*py(i,n))
116 ENDDO
117 ENDDO
118
119 RETURN