40
41
42
43 USE sensor_mod
44
45
46
47#include "implicit_f.inc"
48
49
50
51#include "mvsiz_p.inc"
52
53
54
55#include "param_c.inc"
56#include "vect01_c.inc"
57
58
59
60
62 . partsav(npsav,*),
63 . eint(*), rho(*), rk(*), vol(*),
64 . vx1(*), vx2(*), vx3(*), vx4(*),
65 . vy1(*), vy2(*), vy3(*), vy4(*),
66 . vz1(*), vz2(*), vz3(*), vz4(*),
67 . vnew(*),gresav(*),eintth(*), fill(*),
68 . x1(*), x2(*), x3(*), x4(*),
69 . y1(*), y2(*), y3(*), y4(*),
70 . z1(*), z2(*), z3(*), z4(*)
71 INTEGER IEXPAN,ITASK,
72 . IPARTS(*),GRTH(*),IGRTH(*),IPARG(*)
73 my_real,
INTENT(IN) :: offg(mvsiz)
74 type (sensors_),INTENT(INOUT) :: SENSORS
75 INTEGER, INTENT(IN) :: NEL,G_WPLA
76 my_real,
DIMENSION(NEL*G_WPLA),
INTENT(IN) :: wpla
77
78
79
80 INTEGER I, M,FLAG,NXS1,NXS2,NXS3,NXS4
81
83 . vxa(mvsiz), vya(mvsiz) , vza(mvsiz),
84 . va2(mvsiz), xmas(mvsiz),
85 . off(mvsiz), ei(mvsiz) , ek(mvsiz),
86 . xm(mvsiz) , ym(mvsiz) , zm(mvsiz),
87 . xx(mvsiz) , yy(mvsiz) , zz(mvsiz),
88 . xy(mvsiz) , yz(mvsiz) , zx(mvsiz),
89 . xx2(mvsiz), yy2(mvsiz), zz2(mvsiz),
90 . xcg(mvsiz), ycg(mvsiz), zcg(mvsiz),
91 . xxm(mvsiz), yym(mvsiz), zzm(mvsiz),
92 . ixx(mvsiz), iyy(mvsiz), izz(mvsiz),
93 . ixy(mvsiz), iyz(mvsiz), izx(mvsiz),
94 . rei(mvsiz), rek(mvsiz), off_l(mvsiz)
95
96 flag = iparg(80)
97
98
99
100 DO i=lft,llt
101 vxa(i)=vx1(i)+vx2(i)+vx3(i)+vx4(i)
102 vya(i)=vy1(i)+vy2(i)+vy3(i)+vy4(i)
103 vza(i)=vz1(i)+vz2(i)+vz3(i)+vz4(i)
104 va2(i)=vx1(i)**2+vx2(i)**2+vx3(i)**2+vx4(i)**2
105 + +vy1(i)**2+vy2(i)**2+vy3(i)**2+vy4(i)**2
106 + +vz1(i)**2+vz2(i)**2+vz3(i)**2+vz4(i)**2
107 ENDDO
108
109 DO i=lft,llt
110 vxa(i) = vxa(i)*fourth
111 vya(i) = vya(i)*fourth
112 vza(i) = vza(i)*fourth
113 va2(i) = va2(i)*fourth
114 ENDDO
115
116 DO i=lft,llt
117 xmas(i)= fill(i)*rho(i)*vnew(i)
118 ei(i) = fill(i)*eint(i)*vol(i)
119 ek(i) = xmas(i)*va2(i)*half
120 xm(i) = xmas(i)*vxa(i)
121 ym(i) = xmas(i)*vya(i)
122 zm(i) = xmas(i)*vza(i)
123 ENDDO
124
125 DO i=lft,llt
126 m=iparts(i)
127 partsav(1,m)=partsav(1,m) + ei(i)
128 partsav(2,m)=partsav(2,m) + ek(i)
129 partsav(3,m)=partsav(3,m) + xm(i)
130 partsav(4,m)=partsav(4,m) + ym(i)
131 partsav(5,m)=partsav(5,m) + zm(i)
132 IF (offg(i) >= one) partsav(6,m)=partsav(6,m) + xmas(i)
133 IF (g_wpla > 0) partsav(29,m)=partsav(29,m) + wpla(i)
134 ENDDO
135
136
137
138 IF(flag==1) THEN
139 DO i=lft,llt
140 xx(i)= x1(i)+x2(i)+x3(i)+x4(i)
141 yy(i)= y1(i)+y2(i)+y3(i)+y4(i)
142 zz(i)= z1(i)+z2(i)+z3(i)+z4(i)
143 xx2(i)= x1(i)**2+x2(i)**2+x3(i)**2+x4(i)**2
144 yy2(i)= y1(i)**2+y2(i)**2+y3(i)**2+y4(i)**2
145 zz2(i)= z1(i)**2+z2(i)**2+z3(i)**2+z4(i)**2
146 xy(i)= x1(i)*y1(i)+x2(i)*y2(i)+x3(i)*y3(i)+x4(i)*y4(i)
147 yz(i)= y1(i)*z1(i)+y2(i)*z2(i)+y3(i)*z3(i)+y4(i)*z4(i)
148 zx(i)= z1(i)*x1(i)+z2(i)*x2(i)+z3(i)*x3(i)+z4(i)*x4(i)
149 ENDDO
150
151 DO i=lft,llt
152 xx(i) = xx(i)*fourth
153 yy(i) = yy(i)*fourth
154 zz(i) = zz(i)*fourth
155 xy(i) = xy(i)*fourth
156 yz(i) = yz(i)*fourth
157 zx(i) = zx(i)*fourth
158 xx2(i)= xx2(i)*fourth
159 yy2(i)= yy2(i)*fourth
160 zz2(i)= zz2(i)*fourth
161 ENDDO
162
163 DO i=lft,llt
164 xcg(i)= xmas(i)*xx(i)
165 ycg(i)= xmas(i)*yy(i)
166 zcg(i)= xmas(i)*zz(i)
167 ixy(i)= -xmas(i)*xy(i)
168 iyz(i)= -xmas(i)*yz(i)
169 izx(i)= -xmas(i)*zx(i)
170 ixx(i)= xmas(i)*(yy2(i) + zz2(i))
171 iyy(i)= xmas(i)*(zz2(i) + xx2(i))
172 izz(i)= xmas(i)*(xx2(i) + yy2(i))
173 xxm(i)= vza(i)*ycg(i)-vya(i)*zcg(i)
174 yym(i)= vxa(i)*zcg(i)-vza(i)*xcg(i)
175 zzm(i)= vya(i)*xcg(i)-vxa(i)*ycg(i)
176 rei(i)= zero
177 rek(i)= zero
178 ENDDO
179
180 DO i=lft,llt
181 m=iparts(i)
182 partsav(9,m) =partsav(9,m) + xcg(i)
183 partsav(10,m)=partsav(10,m) + ycg(i)
184 partsav(11,m)=partsav(11,m) + zcg(i)
185 partsav(12,m)=partsav(12,m) + xxm(i)
186 partsav(13,m)=partsav(13,m) + yym(i)
187 partsav(14,m)=partsav(14,m) + zzm(i)
188 partsav(15,m)=partsav(15,m) + ixx(i)
189 partsav(16,m)=partsav(16,m) + iyy(i)
190 partsav(17,m)=partsav(17,m) + izz(i)
191 partsav(18,m)=partsav(18,m) + ixy(i)
192 partsav(19,m)=partsav(19,m) + iyz(i)
193 partsav(20,m)=partsav(20,m) + izx(i)
194 partsav(21,m)=partsav(21,m) + rei(i)
195 partsav(22,m)=partsav(22,m) + rek(i)
196 ENDDO
197 ENDIF
198
199
200 IF (igre /= 0) THEN
201 DO i=lft,llt
202 off(i) = one
203 ENDDO
204 CALL grelem_sav(lft ,llt ,gresav,igrth ,grth ,
205 2 off ,ei ,ek ,xm ,ym ,
206 3 zm ,xmas ,xcg ,ycg ,zcg ,
207 4 xxm ,yym ,zzm ,ixx ,iyy ,
208 5 izz ,ixy ,iyz ,izx ,rei ,
209 6 rek ,flag)
210 ENDIF
211
212
213 IF(jtur/=0)THEN
214 DO 50 i=lft,llt
215 m=iparts(i)
216 partsav(7,m)=partsav(7,m) + rk(i)*vol(i)
217 50 CONTINUE
218 ENDIF
219
220 IF(iexpan/=0)THEN
221 DO i=lft,llt
222 m=iparts(i)
223 partsav(27,m)=partsav(27,m) + eintth(i)*vol(i)
224 ENDDO
225 ENDIF
226
227 off_l(lft:llt) = one
228
229 DO i = lft,llt
230 m=iparts(i)
231 IF (offg(i) < one) THEN
232 partsav(25,m) = partsav(25,m) + one
233 ENDIF
234 ENDDO
235
237
238 RETURN
subroutine grelem_sav(jft, jlt, gresav, igrth, grth, off, ei, ek, xm, ym, zm, xmas, xcg, ycg, zcg, xxm, yym, zzm, ixx, iyy, izz, ixy, iyz, izx, rei, rek, flag)
subroutine sensor_energy_bilan(jft, jlt, ei, ek, off, ipart, itask, sensors)