40
41
42
43#include "implicit_f.inc"
44
45
46
47#include "mvsiz_p.inc"
48
49
50
51#include "scr18_c.inc"
52
53
54
55 INTEGER ICP,G_PLA,G_EPSD,IEXPAN,NEL
56 INTEGER, INTENT(IN) :: NODADT_THERM
58 . sigor(nel,6),
59 . vol(*),qvis(*),pp(*),
60 . eint(*),rho(*),q(*),defpm(*),defp(*),
61 . sigm(nel,6),eintm(*),rhom(*),qm(*),epsd(*),epsdm(*),
62 . volg(*),sti(*),stin(*),off(*),vol0(*),vol0g(*),
63 . eintth(*),eintthm(*),conde(*),conden(*)
64 my_real,
DIMENSION(MVSIZ,6),
INTENT(INOUT) :: svis
65 INTEGER, INTENT(IN) :: G_WPLA_FLAG
66 my_real,
DIMENSION(NEL*G_WPLA_FLAG),
INTENT(INOUT) :: g_wpla
67 my_real,
DIMENSION(NEL*G_WPLA_FLAG),
INTENT(IN) :: l_wpla
68
69
70
71 INTEGER I, J
72
74 . p,fac(mvsiz),fac2(mvsiz
75
76
77 DO i=1,nel
78 fac(i) = off(i)*vol(i)/volg(i)
79 fac2(i) = vol(i)/volg(i)
80 sigm(i,1) = sigm(i,1) + fac(i) * sigor(i,1)
81 sigm(i,2) = sigm(i,2) + fac(i) * sigor(i,2)
82 sigm(i,3) = sigm(i,3) + fac(i) * sigor(i,3)
83 sigm(i,4) = sigm(i,4) + fac(i) * sigor(i,4)
84 sigm(i,5) = sigm(i,5) + fac(i) * sigor(i,5)
85 sigm(i,6) = sigm(i,6) + fac(i) * sigor(i,6)
86 rhom(i) = rhom(i) + fac2(i)* rho(i)
87 eintm(i) = eintm(i) + eint(i)* vol0(i)/vol0g(i)
88 IF (g_wpla_flag > 0) g_wpla(i) = g_wpla(i) + l_wpla(i)
89 qm(i) = qm(i) + fac(i) * q(i)
90 stin(i) = stin(i) + sti(i)
91 ENDDO
92
93 IF(nodadt_therm == 1) THEN
94 DO i=1,nel
95 conden(i)= conden(i)+ conde(i)
96 ENDDO
97 ENDIF
98
99 IF (iexpan > 0) THEN
100 DO i=1,nel
101 eintthm(i) = eintthm(i) + eintth(i)*vol0(i)/vol0g(i)
102 ENDDO
103 ENDIF
104
105 IF (g_pla > 0) THEN
106 DO i=1,nel
107 defpm(i) = defpm(i) + fac(i) * defp(i)
108 ENDDO
109 ENDIF
110
111 IF (g_epsd > 0) THEN
112 DO i=1,nel
113 epsdm(i) = epsdm(i) + fac(i) * epsd(i)
114 ENDDO
115 ENDIF
116
117 IF (icp == 1) THEN
118 DO i=1,nel
119 p =zep3*(sigor(i,1)+sigor(i,2)+sigor(i,3)
120 . +svis(i,1)+svis(i,2)+svis(i,3))
121 pp(i) = pp(i) + fac(i)* (p-qvis(i))
122 ENDDO
123 ENDIF
124
125 RETURN