39 2 IXC, THK, EINT, PARTSAV,
40 3 AREA, MAT, IPARTC, X,
41 4 VR, VOL0, VOL00, THK0,
42 5 THK02, IFLA, OFF, NFT1,
43 6 GRESAV, GRTH, IGRTH, VL1,
44 7 VL2, VL3, VL4, VRL1,
45 8 VRL2, VRL3, VRL4, X1G,
48 B Z2G, Z3G, Z4G, IXFEM,
49 C IEXPAN, EINTTH, ITASK, GVOL,
50 D ACTIFXFEM,IGRE, SENSORS, NEL,
59#include
"implicit_f.inc"
68#include "com_xfem1.inc"
72 INTEGER,
INTENT(IN) :: IGRE
73 INTEGER IXC(NIXC,*),MAT(MVSIZ), JFT, JLT,IFLA,IEXPAN,
74 . IPARTC(*),NFT1,GRTH(*),IGRTH(*),IXFEM,ITASK
75 INTEGER,
INTENT(IN) :: ACTIFXFEM
78 . PM(NPROPM,*), V(3,*), THK(*), EINT(JLT,2),
79 . PARTSAV(NPSAV,*), AREA(*),X(3,*),VR(3,*) ,VOL0(*),(*),
80 . THK0(*), THK02(*),OFF(*),
83 . X1G(MVSIZ), X2G(MVSIZ), X3G(MVSIZ), X4G(MVSIZ),
84 . Y1G(MVSIZ), Y2G(MVSIZ), Y3G(MVSIZ), Y4G(),
85 . Z1G(MVSIZ), Z2G(MVSIZ), Z3G(MVSIZ), Z4G(MVSIZ),
86 . vl1(mvsiz,3),vl2(mvsiz,3),vl3(mvsiz,3),vl4(mvsiz,3),
87 . vrl1(mvsiz,3),vrl2(mvsiz,3),vrl3(mvsiz,3),vrl4
88 my_real,
INTENT(IN) :: gvol(mvsiz)
89 type (sensors_),
INTENT(INOUT) :: SENSORS
90 INTEGER,
INTENT(IN) :: NEL,G_WPLA
91 my_real,
DIMENSION(NEL*G_WPLA),
INTENT(IN) :: wpla
95 INTEGER I, MX, II, J, IC, JST(MVSIZ+1),FLAG,
96 . ixctmp2,ixctmp3,ixctmp4,ixctmp5,ijk
99 . in25,xx,yy,zz,xy,yz,zx,va2, inel,
100 . vxa(mvsiz), vya(mvsiz), vza(mvsiz),
101 . xmas(mvsiz), rho, ei(mvsiz),rei(mvsiz),rek(mvsiz),
102 . ek(mvsiz), xm(mvsiz), ym(mvsiz), zm(mvsiz), xmas25(mvsiz),
103 . xxm(mvsiz), yym(mvsiz), zzm(mvsiz),
104 . xcg(mvsiz), ycg(mvsiz), zcg(mvsiz),
105 . ixx(mvsiz), iyy(mvsiz), izz(mvsiz),
106 . ixy(mvsiz), iyz(mvsiz), izx(mvsiz),
108 INTEGER :: K,IPART,LOCAL_INDEX
109 my_real,
DIMENSION(MVSIZ,2) :: fstparit
136 vl1(i,1)=v(1,ixctmp2)
137 vl1(i,2)=v(2,ixctmp2)
138 vl1(i,3)=v(3,ixctmp2)
139 vl2(i,1)=v(1,ixctmp3)
140 vl2(i,2)=v(2,ixctmp3)
141 vl2(i,3)=v(3,ixctmp3)
142 vl3(i,1)=v(1,ixctmp4)
143 vl3(i,2)=v(2,ixctmp4)
144 vl3(i,3)=v(3,ixctmp4)
145 vl4(i,1)=v(1,ixctmp5)
146 vl4(i,2)=v(2,ixctmp5)
147 vl4(i,3)=v(3,ixctmp5)
148 vrl1(i,1)=vr(1,ixctmp2)
149 vrl1(i,2)=vr(2,ixctmp2)
150 vrl1(i,3)=vr(3,ixctmp2)
151 vrl2(i,1)=vr(1,ixctmp3)
152 vrl2(i,2)=vr(2,ixctmp3)
153 vrl2(i,3)=vr(3,ixctmp3)
154 vrl3(i,1)=vr(1,ixctmp4)
155 vrl3(i,2)=vr(2,ixctmp4)
156 vrl3(i,3)=vr(3,ixctmp4)
157 vrl4(i,1)=vr(1,ixctmp5)
158 vrl4(i,2)=vr(2,ixctmp5)
159 vrl4(i,3)=vr(3,ixctmp5)
164 vxa(i)=vl1(i,1)+vl2(i,1)+vl3(i,1)+vl4(i,1)
165 vya(i)=vl1(i,2)+vl2(i,2)+vl3(i,2)+vl4(i,2)
166 vza(i)=vl1(i,3)+vl2(i,3)+vl3(i,3)+vl4(i,3)
175 va2 = vl1(i,1)*vl1(i,1)+vl2(i,1)*vl2(i,1)
176 2 +vl3(i,1)*vl3(i,1)+vl4(i,1)*vl4(i,1)
177 3 +vl1(i,2)*vl1(i,2)+vl2(i,2)*vl2(i,2)
178 4 +vl3(i,2)*vl3(i,2)+vl4(i,2)*vl4(i,2)
179 5 +vl1(i,3)*vl1(i,3)+vl2(i,3)*vl2(i,3)
180 6 +vl3(i,3)*vl3(i,3)+vl4(i,3)*vl4(i,3)
181 ei(i)= eint(i,1) + eint(i,2)
182 ek(i)= xmas(i)*va2*one_over_8
183 xmas25(i)= xmas(i)*fourth
184 xm(i)= xmas25(i)*vxa(i)
185 ym(i)= xmas25(i)*vya(i)
186 zm(i)= xmas25(i)*vza(i)
191 IF(ifla/=0.AND.npsav>=21)
THEN
193 xx= x1g(i)+x2g(i)+x3g(i)+x4g(i)
194 yy= y1g(i)+y2g(i)+y3g(i)+y4g(i)
195 zz= z1g(i)+z2g(i)+z3g(i)+z4g(i)
200 in25 = xmas25(i)*(thk02(i)+area(i))*one_over_12
211 ixx(i)= inel + yy + zz
212 iyy(i)= inel + zz + xx
213 izz(i)= inel + xx + yy
217 xxm(i)= vza(i)*ycg(i)-vya(i)*zcg(i)
219 . (vrl1(i,1)+vrl2(i,1)+vrl3(i,1)+vrl4(i,1))
220 yym(i)= vxa(i)*zcg(i)-vza(i)*xcg(i)
222 . (vrl1(i,2)+vrl2(i,2)+vrl3(i,2)+vrl4(i,2))
223 zzm(i)= vya(i)*xcg(i)-vxa(i)*ycg(i)
225 . (vrl1(i,3)+vrl2(i,3)+vrl3(i,3)+vrl4(i,3))
226 va2 = vrl1(i,1)*vrl1(i,1)+vrl2(i,1)*vrl2(i,1)
227 2 + vrl3(i,1)*vrl3(i,1)+vrl4(i,1)*vrl4(i,1)
228 3 + vrl1(i,2)*vrl1(i,2)+vrl2(i,2)*vrl2(i,2)
229 4 + vrl3(i,2)*vrl3(i,2)+vrl4(i,2)*vrl4(i,2)
230 5 + vrl1(i,3)*vrl1(i,3)+vrl2(i,3)*vrl2(i,3)
231 6 + vrl3(i,3)*vrl3(i,3)+vrl4(i,3)*vrl4(i,3)
233 rek(i)= in25*va2*half
238 CALL grelem_sav(jft ,jlt ,gresav,igrth ,grth ,
239 2 off ,ei ,ek ,xm ,ym ,
240 3 zm ,xmas ,xcg ,ycg ,zcg ,
241 4 xxm ,yym ,zzm ,ixx ,iyy ,
242 5 izz ,ixy ,iyz ,izx ,rei ,
249 IF (ipartc(j)/=ipartc(j-1))
THEN
258 IF (icrack3d > 0 .AND. ixfem > 0 .AND. actifxfem > 0)
THEN
260 partsav(1,mx)=partsav(1,mx) + ei(i)
261 IF (g_wpla > 0) partsav(29,mx)=partsav(29,mx) + wpla(i)
262 partsav(2,mx)=partsav(2,mx) + ek(i)
263 partsav(3,mx)=partsav(3,mx) + xm(i)
264 partsav(4,mx)=partsav(4,mx) + ym(i)
265 partsav(5,mx)=partsav(5,mx) + zm(i)
268 partsav(1,mx)=partsav(1,mx) + ei(i)
269 IF (g_wpla > 0) partsav(29,mx)=partsav(29,mx) + wpla(i)
270 partsav(2,mx)=partsav(2,mx) + ek(i)
271 partsav(3,mx)=partsav(3,mx) + xm(i)
272 partsav(4,mx)=partsav(4,mx) + ym(i)
273 partsav(5,mx)=partsav(5,mx) + zm(i)
276 partsav(6,mx)=partsav(6,mx) + xmas(i)
279 partsav(9,mx) =partsav(9,mx) + xcg(i)
280 partsav(10,mx)=partsav(10,mx) + ycg(i)
281 partsav(11,mx)=partsav(11,mx) + zcg(i)
282 partsav(12,mx)=partsav(12,mx) + xxm(i)
283 partsav(13,mx)=partsav(13,mx) + yym(i)
284 partsav(14,mx)=partsav(14,mx) + zzm(i)
285 partsav(15,mx)=partsav(15,mx) + ixx(i)
286 partsav(16,mx)=partsav(16,mx) + iyy(i)
287 partsav(17,mx)=partsav(17,mx) + izz(i)
288 partsav(18,mx)=partsav(18,mx) + ixy(i)
289 partsav(19,mx)=partsav(19,mx) + iyz(i)
290 partsav(20,mx)=partsav(20,mx) + izx(i)
291 partsav(21,mx)=partsav(21,mx) + rei(i)
292 partsav(22,mx)=partsav(22,mx) + rek(i)
298 IF (jst(ii+1)-jst(ii)>15)
THEN
299 DO i=jst(ii),jst(ii+1)-1
300 IF (icrack3d > 0 .AND. ixfem > 0 .AND. actifxfem > 0)
THEN
302 partsav(1,mx)=partsav(1,mx) + ei(i)
303 IF (g_wpla > 0) partsav(29,mx)=partsav(29,mx) + wpla(i)
304 partsav(2,mx)=partsav(2,mx) + ek(i)
305 partsav(3,mx)=partsav(3,mx) + xm(i)
306 partsav(4,mx)=partsav(4,mx) + ym(i)
307 partsav(5,mx)=partsav(5,mx) + zm(i)
310 partsav(1,mx)=partsav(1,mx) + ei(i)
311 IF (g_wpla > 0) partsav(29,mx)=partsav(29,mx) + wpla(i)
312 partsav(2,mx)=partsav(2,mx) + ek(i)
313 partsav(3,mx)=partsav(3,mx) + xm(i)
314 partsav(4,mx)=partsav(4,mx) + ym(i)
315 partsav(5,mx)=partsav(5,mx) + zm(i)
318 partsav(6,mx)=partsav(6,mx) + xmas(i)
321 partsav(9,mx) =partsav(9,mx) + xcg(i)
322 partsav(10,mx)=partsav(10,mx) + ycg(i)
323 partsav(11,mx)=partsav(11,mx) + zcg(i)
324 partsav(12,mx)=partsav(12,mx) + xxm(i)
325 partsav(13,mx)=partsav(13,mx) + yym(i)
326 partsav(14,mx)=partsav(14,mx) + zzm(i)
327 partsav(15,mx)=partsav(15,mx) + ixx(i)
328 partsav(16,mx)=partsav(16,mx) + iyy(i)
329 partsav(17,mx)=partsav(17,mx) + izz(i)
330 partsav(18,mx)=partsav(18,mx) + ixy(i)
331 partsav(19,mx)=partsav(19,mx) + iyz(i)
332 partsav(20,mx)=partsav(20,mx) + izx(i)
333 partsav(21,mx)=partsav(21,mx) + rei(i)
334 partsav(22,mx)=partsav(22,mx) + rek(i)
337 DO i=jst(ii),jst(ii+1)-1
338 IF (icrack3d > 0 .AND. ixfem > 0 .AND. actifxfem > 0)
THEN
339 IF (off(i)/=zero)
THEN
340 partsav(1,mx)=partsav(1,mx) + ei(i)
341 IF (g_wpla > 0) partsav(29,mx)=partsav(29,mx) + wpla(i)
342 partsav(2,mx)=partsav(2,mx) + ek(i)
343 partsav(3,mx)=partsav(3,mx) + xm(i)
344 partsav(4,mx)=partsav(4,mx) + ym(i)
345 partsav(5,mx)=partsav(5,mx) + zm(i)
348 partsav(1,mx)=partsav(1,mx) + ei(i)
349 IF (g_wpla > 0) partsav(29,mx)=partsav(29,mx) + wpla(i)
350 partsav(2,mx)=partsav(2,mx) + ek(i)
351 partsav(3,mx)=partsav(3,mx) + xm(i)
352 partsav(4,mx)=partsav(4,mx) + ym(i)
353 partsav(5,mx)=partsav(5,mx) + zm(i)
356 partsav(6,mx)=partsav(6,mx) + xmas(i)
359 partsav(9,mx) =partsav(9,mx) + xcg(i)
360 partsav(10,mx)=partsav(10,mx) + ycg(i)
361 partsav(11,mx)=partsav(11,mx) + zcg(i)
362 partsav(12,mx)=partsav(12,mx) + xxm(i)
363 partsav(13,mx)=partsav(13,mx) + yym(i)
364 partsav(14,mx)=partsav(14,mx) + zzm(i)
365 partsav(15,mx)=partsav(15,mx) + ixx(i)
366 partsav(16,mx)=partsav(16,mx) + iyy(i)
367 partsav(17,mx)=partsav(17,mx) + izz(i)
368 partsav(18,mx)=partsav(18,mx) + ixy(i)
369 partsav(19,mx)=partsav(19,mx) + iyz(i)
370 partsav(20,mx)=partsav(20,mx) + izx(i)
371 partsav(21,mx)=partsav(21,mx) + rei(i)
372 partsav(22,mx)=partsav(22,mx) + rek(i)
380 CALL grelem_sav(jft ,jlt ,gresav,igrth ,grth ,
381 2 off ,ei ,ek ,xm ,ym ,
382 3 zm ,xmas ,rbidon,rbidon,rbidon,
383 4 rbidon,rbidon,rbidon,rbidon,rbidon,
384 5 rbidon,rbidon,rbidon,rbidon,rbidon,
390 IF (ipartc(j)/=ipartc(j-1))
THEN
399 IF (icrack3d > 0 .AND. ixfem > 0 .AND. actifxfem > 0)
THEN
400 IF (off(i)/=zero)
THEN
401 partsav(1,mx)=partsav(1,mx) + ei(i)
402 IF (g_wpla > 0) partsav(29,mx)=partsav(29,mx) + wpla
403 partsav(2,mx)=partsav(2,mx) + ek(i)
404 partsav(3,mx)=partsav(3,mx) + xm(i)
405 partsav(4,mx)=partsav(4,mx) + ym(i)
406 partsav(5,mx)=partsav(5,mx) + zm(i)
409 partsav(1,mx)=partsav(1,mx) + ei(i)
410 IF (g_wpla > 0) partsav(29,mx)=partsav(29,mx) + wpla(i)
411 partsav(2,mx)=partsav(2,mx) + ek(i)
412 partsav(3,mx)=partsav(3,mx) + xm(i)
413 partsav(4,mx)=partsav(4,mx) + ym(i)
414 partsav(5,mx)=partsav(5,mx) + zm(i)
417 partsav(6,mx)=partsav(6,mx) + xmas(i)
424 IF (jst(ii+1)-jst(ii)>15)
THEN
425 DO i=jst(ii),jst(ii+1)-1
426 IF (icrack3d > 0 .AND. ixfem > 0 .AND. actifxfem > 0)
THEN
428 partsav(1,mx)=partsav(1,mx) + ei(i
429 IF (g_wpla > 0) partsav(29,mx)=partsav(29,mx) + wpla(i
430 partsav(2,mx)=partsav(2,mx)
431 partsav(3,mx)=partsav(3,mx) + xm(i
432 partsav(4,mx)=partsav(4,mx) + ym(i)
433 partsav(5,mx)=partsav(5,mx) + zm(i)
436 partsav(1,mx)=partsav(1,mx) + ei(i)
437 IF (g_wpla > 0) partsav(29,mx)=partsav(29,mx) + wpla(i)
438 partsav(2,mx)=partsav(2,mx) + ek(i)
439 partsav(3,mx)=partsav(3,mx) + xm(i)
440 partsav(4,mx)=partsav(4,mx) + ym(i)
441 partsav(5,mx)=partsav(5,mx) + zm
444 partsav(6,mx)=partsav(6,mx) + xmas(i)
449 DO i=jst(ii),jst(ii+1)-1
450 IF (icrack3d > 0 .AND. ixfem > 0 .AND. actifxfem > 0)
THEN
452 partsav(1,mx)=partsav(1,mx) + ei(i)
453 IF (g_wpla > 0) partsav(29,mx)=partsav(29,mx) + wpla(i)
454 partsav(2,mx)=partsav(2,mx) + ek(i)
455 partsav(3,mx)=partsav(3,mx) + xm(i)
456 partsav(4,mx)=partsav(4,mx) + ym(i)
457 partsav(5,mx)=partsav(5,mx) + zm(i)
460 partsav(1,mx)=partsav(1,mx) + ei(i)
461 IF (g_wpla > 0) partsav(29,mx)=partsav(29,mx) + wpla(i)
462 partsav(2,mx)=partsav(2,mx) + ek(i)
463 partsav(3,mx)=partsav(3,mx) + xm(i)
464 partsav(4,mx)=partsav(4,mx) + ym(i)
465 partsav(5,mx)=partsav(5,mx) + zm(i)
468 partsav(6,mx)=partsav(6,mx) + xmas(i)
481 partsav(27,mx)=partsav(27,mx) + eintth(i)
488 IF (off(i)==zero)
THEN
489 partsav(25,mx) = partsav(25,mx) + one