OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
xfemfsky.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| cupdt3_crk ../engine/source/elements/xfem/xfemfsky.F
25!||--- called by ------------------------------------------------------
26!|| cforc3_crk ../engine/source/elements/xfem/cforc3_crk.F
27!||--- uses -----------------------------------------------------
28!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
29!||====================================================================
30 SUBROUTINE cupdt3_crk(
31 . JFT ,JLT ,NFT ,IXC ,OFF ,IADC ,
32 . F11 ,F21 ,F31 ,F12 ,F22 ,F32 ,
33 . F13 ,F23 ,F33 ,F14 ,F24 ,F34 ,
34 . M11 ,M21 ,M31 ,M12 ,M22 ,M32 ,
35 . M13 ,M23 ,M33 ,M14 ,M24 ,M34 ,
36 . STI ,STIR ,FSKY ,ELCUTC ,IADC_CRK,IEL_CRK ,
37 . ILEV ,INOD_CRK,OFFG ,EINT ,PARTSAV ,IPARTC ,
38 . ILAY ,CRKSKY )
39C-----------------------------------------------
40 USE crackxfem_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "param_c.inc"
49#include "parit_c.inc"
50#include "com_xfem1.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER IADC(4,*),IADC_CRK(4,*),IXC(NIXC,*),IEL_CRK(*),
55 . ELCUTC(2,*),INOD_CRK(*),IPARTC(*)
56 INTEGER JFT,JLT,NFT,IXFEM,ILEV,ILAY
57 my_real
58 . FSKY(8,LSKY),OFF(*),OFFG(*),
59 . F11(*),F21(*),F31(*),F12(*),F22(*),F32(*),
60 . F13(*),F23(*),F33(*),F14(*),F24(*),F34(*),
61 . M11(*),M21(*),M31(*),M12(*),M22(*),M32(*),
62 . m13(*),m23(*),m33(*),m14(*),m24(*),m34(*),
63 . sti(*),stir(*),eint(jlt,2),partsav(npsav,*)
64 TYPE(xfem_sky_) , DIMENSION(*) :: CRKSKY
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I,K,KK,ELCRK,ELCUT,ENR,IOFF
69 my_real OFF_L,AREAP
70C=======================================================================
71 IOFF=0
72 DO i=jft,jlt
73 IF (off(i) == zero .AND. offg(i) > zero) ioff=1
74 ENDDO
75 IF (ioff == 1) THEN
76 numelcrk = numelcrk + 1
77 ENDIF
78 off_l = zero
79 DO i=jft,jlt
80 IF (off(i) < one) offg(i) = off(i)
81 off_l = min(off_l,offg(i))
82 ENDDO
83c----------------------
84 IF (off_l <= zero) THEN
85 DO i=jft,jlt
86 IF (off(i) <= zero) THEN
87 f11(i) = zero
88 f21(i) = zero
89 f31(i) = zero
90 m11(i) = zero
91 m21(i) = zero
92 m31(i) = zero
93 f12(i) = zero
94 f22(i) = zero
95 f32(i) = zero
96 m12(i) = zero
97 m22(i) = zero
98 m32(i) = zero
99 f13(i) = zero
100 f23(i) = zero
101 f33(i) = zero
102 m13(i) = zero
103 m23(i) = zero
104 m33(i) = zero
105 f14(i) = zero
106 f24(i) = zero
107 f34(i) = zero
108 m14(i) = zero
109 m24(i) = zero
110 m34(i) = zero
111 sti(i) = zero
112 stir(i)= zero
113 ENDIF
114 ENDDO
115 ENDIF
116c----------------------
117 DO i=jft,jlt
118 elcrk = iel_crk(i+nft)
119 elcut = xfem_phantom(ilay)%ELCUT(elcrk)
120 IF (elcut /= 0) THEN
121 areap = crklvset(ilev)%AREA(elcrk)
122c
123 kk = iadc_crk(1,elcrk)
124 crksky(ilev)%FSKY(1,kk) = -f11(i)*areap
125 crksky(ilev)%FSKY(2,kk) = -f21(i)*areap
126 crksky(ilev)%FSKY(3,kk) = -f31(i)*areap
127 crksky(ilev)%FSKY(4,kk) = -m11(i)*areap
128 crksky(ilev)%FSKY(5,kk) = -m21(i)*areap
129 crksky(ilev)%FSKY(6,kk) = -m31(i)*areap
130 crksky(ilev)%FSKY(7,kk) = sti(i)
131 crksky(ilev)%FSKY(8,kk) = stir(i)
132C
133 kk = iadc_crk(2,elcrk)
134 crksky(ilev)%FSKY(1,kk) = -f12(i)*areap
135 crksky(ilev)%FSKY(2,kk) = -f22(i)*areap
136 crksky(ilev)%FSKY(3,kk) = -f32(i)*areap
137 crksky(ilev)%FSKY(4,kk) = -m12(i)*areap
138 crksky(ilev)%FSKY(5,kk) = -m22(i)*areap
139 crksky(ilev)%FSKY(6,kk) = -m32(i)*areap
140 crksky(ilev)%FSKY(7,kk) = sti(i)
141 crksky(ilev)%FSKY(8,kk) = stir(i)
142C
143 kk = iadc_crk(3,elcrk)
144 crksky(ilev)%FSKY(1,kk) = -f13(i)*areap
145 crksky(ilev)%FSKY(2,kk) = -f23(i)*areap
146 crksky(ilev)%FSKY(3,kk) = -f33(i)*areap
147 crksky(ilev)%FSKY(4,kk) = -m13(i)*areap
148 crksky(ilev)%FSKY(5,kk) = -m23(i)*areap
149 crksky(ilev)%FSKY(6,kk) = -m33(i)*areap
150 crksky(ilev)%FSKY(7,kk) = sti(i)
151 crksky(ilev)%FSKY(8,kk) = stir(i)
152C
153 kk = iadc_crk(4,elcrk)
154 crksky(ilev)%FSKY(1,kk) = -f14(i)*areap
155 crksky(ilev)%FSKY(2,kk) = -f24(i)*areap
156 crksky(ilev)%FSKY(3,kk) = -f34(i)*areap
157 crksky(ilev)%FSKY(4,kk) = -m14(i)*areap
158 crksky(ilev)%FSKY(5,kk) = -m24(i)*areap
159 crksky(ilev)%FSKY(6,kk) = -m34(i)*areap
160 crksky(ilev)%FSKY(7,kk) = sti(i)
161 crksky(ilev)%FSKY(8,kk) = stir(i)
162 END IF
163 END DO
164c--------------------------------------------------
165 DO i=jft,jlt
166 elcrk = iel_crk(i+nft)
167 elcut = xfem_phantom(ilay)%ELCUT(elcrk)
168 IF (elcut == 0) cycle
169C---
170c NODE 1
171C---
172 k = iadc(1,i)
173 kk = iadc_crk(1,elcrk)
174 enr = crklvset(ilev)%ENR0(2,kk)
175C
176 IF (enr <= 0) THEN
177 fsky(1,k) = fsky(1,k) + crksky(ilev)%FSKY(1,kk)
178 fsky(2,k) = fsky(2,k) + crksky(ilev)%FSKY(2,kk)
179 fsky(3,k) = fsky(3,k) + crksky(ilev)%FSKY(3,kk)
180 fsky(4,k) = fsky(4,k) + crksky(ilev)%FSKY(4,kk)
181 fsky(5,k) = fsky(5,k) + crksky(ilev)%FSKY(5,kk)
182 fsky(6,k) = fsky(6,k) + crksky(ilev)%FSKY(6,kk)
183C
184 crksky(ilev)%FSKY(1,kk) = zero
185 crksky(ilev)%FSKY(2,kk) = zero
186 crksky(ilev)%FSKY(3,kk) = zero
187 crksky(ilev)%FSKY(4,kk) = zero
188 crksky(ilev)%FSKY(5,kk) = zero
189 crksky(ilev)%FSKY(6,kk) = zero
190 END IF
191C---
192c NODE 2
193C---
194 k = iadc(2,i)
195 kk = iadc_crk(2,elcrk)
196 enr = crklvset(ilev)%ENR0(2,kk)
197C
198 IF (enr <= 0) THEN
199 fsky(1,k) = fsky(1,k) + crksky(ilev)%FSKY(1,kk)
200 fsky(2,k) = fsky(2,k) + crksky(ilev)%FSKY(2,kk)
201 fsky(3,k) = fsky(3,k) + crksky(ilev)%FSKY(3,kk)
202 fsky(4,k) = fsky(4,k) + crksky(ilev)%FSKY(4,kk)
203 fsky(5,k) = fsky(5,k) + crksky(ilev)%FSKY(5,kk)
204 fsky(6,k) = fsky(6,k) + crksky(ilev)%FSKY(6,kk)
205C
206 crksky(ilev)%FSKY(1,kk) = zero
207 crksky(ilev)%FSKY(2,kk) = zero
208 crksky(ilev)%FSKY(3,kk) = zero
209 crksky(ilev)%FSKY(4,kk) = zero
210 crksky(ilev)%FSKY(5,kk) = zero
211 crksky(ilev)%FSKY(6,kk) = zero
212 END IF
213C---
214c NODE 3
215C---
216 k = iadc(3,i)
217 kk = iadc_crk(3,elcrk)
218 enr = crklvset(ilev)%ENR0(2,kk)
219C
220 IF (enr <= 0) THEN
221 fsky(1,k) = fsky(1,k) + crksky(ilev)%FSKY(1,kk)
222 fsky(2,k) = fsky(2,k) + crksky(ilev)%FSKY(2,kk)
223 fsky(3,k) = fsky(3,k) + crksky(ilev)%FSKY(3,kk)
224 fsky(4,k) = fsky(4,k) + crksky(ilev)%FSKY(4,kk)
225 fsky(5,k) = fsky(5,k) + crksky(ilev)%FSKY(5,kk)
226 fsky(6,k) = fsky(6,k) + crksky(ilev)%FSKY(6,kk)
227C
228 crksky(ilev)%FSKY(1,kk) = zero
229 crksky(ilev)%FSKY(2,kk) = zero
230 crksky(ilev)%FSKY(3,kk) = zero
231 crksky(ilev)%FSKY(4,kk) = zero
232 crksky(ilev)%FSKY(5,kk) = zero
233 crksky(ilev)%FSKY(6,kk) = zero
234 END IF
235C---
236c NODE 4
237C---
238 k = iadc(4,i)
239 kk = iadc_crk(4,elcrk)
240 enr = crklvset(ilev)%ENR0(2,kk)
241C
242 IF (enr <= 0) THEN
243 fsky(1,k) = fsky(1,k) + crksky(ilev)%FSKY(1,kk)
244 fsky(2,k) = fsky(2,k) + crksky(ilev)%FSKY(2,kk)
245 fsky(3,k) = fsky(3,k) + crksky(ilev)%FSKY(3,kk)
246 fsky(4,k) = fsky(4,k) + crksky(ilev)%FSKY(4,kk)
247 fsky(5,k) = fsky(5,k) + crksky(ilev)%FSKY(5,kk)
248 fsky(6,k) = fsky(6,k) + crksky(ilev)%FSKY(6,kk)
249C
250 crksky(ilev)%FSKY(1,kk) = zero
251 crksky(ilev)%FSKY(2,kk) = zero
252 crksky(ilev)%FSKY(3,kk) = zero
253 crksky(ilev)%FSKY(4,kk) = zero
254 crksky(ilev)%FSKY(5,kk) = zero
255 crksky(ilev)%FSKY(6,kk) = zero
256 END IF
257C---
258 ENDDO
259C-----------
260 RETURN
261 END
262!||====================================================================
263!|| cupdtn3_crk ../engine/source/elements/xfem/xfemfsky.F
264!||--- called by ------------------------------------------------------
265!|| czforc3_crk ../engine/source/elements/xfem/czforc3_crk.F
266!||--- uses -----------------------------------------------------
267!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
268!||====================================================================
269 SUBROUTINE cupdtn3_crk(
270 . JFT ,JLT ,NFT ,IXC ,OFF ,IADC ,
271 . F11 ,F21 ,F31 ,F12 ,F22 ,F32 ,
272 . F13 ,F23 ,F33 ,F14 ,F24 ,F34 ,
273 . M11 ,M21 ,M31 ,M12 ,M22 ,M32 ,
274 . M13 ,M23 ,M33 ,M14 ,M24 ,M34 ,
275 . STI ,STIR ,FSKY ,ELCUTC,IADC_CRK,IEL_CRK,
276 . ILEV ,INOD_CRK,FAC,OFFG ,EINT ,PARTSAV,
277 . IPARTC,ILAY ,CRKSKY )
278C-----------------------------------------------
279 USE crackxfem_mod
280C-----------------------------------------------
281C I m p l i c i t T y p e s
282C-----------------------------------------------
283#include "implicit_f.inc"
284C-----------------------------------------------
285C C o m m o n B l o c k s
286C-----------------------------------------------
287#include "param_c.inc"
288#include "parit_c.inc"
289#include "com_xfem1.inc"
290C-----------------------------------------------
291C D u m m y A r g u m e n t s
292C-----------------------------------------------
293 INTEGER JFT,JLT,NFT,IADC(4,*),IADC_CRK(4,*),IXC(NIXC,*),
294 . IEL_CRK(*),ILEV,ELCUTC(2,*),INOD_CRK(*),IPARTC(*),
295 . ixfem,ilay
296 my_real
297 . fsky(8,lsky),off(*),
298 . f11(*),f21(*),f31(*),f12(*),f22(*),f32(*),
299 . f13(*),f23(*),f33(*),f14(*),f24(*),f34(*),
300 . m11(*),m21(*),m31(*),m12(*),m22(*),m32(*),
301 . m13(*),m23(*),m33(*),m14(*),m24(*),m34(*),
302 . sti(*),stir(*),fac(2,*),offg(*),eint(jlt,2),partsav(npsav,*)
303 TYPE(xfem_sky_) , DIMENSION(*) :: CRKSKY
304C-----------------------------------------------
305C L o c a l V a r i a b l e s
306C-----------------------------------------------
307 INTEGER I,K,KK,ELCRK,ELCUT,ENR,IOFF
308 my_real OFF_L,AREAP
309C=======================================================================
310 ioff = 0
311 DO i=jft,jlt
312 IF (off(i) == zero .AND. offg(i) > zero) ioff=1
313 ENDDO
314 IF (ioff == 1) THEN ! debug anim only
315 numelcrk = numelcrk + 1
316 ENDIF
317 off_l = zero
318 DO i=jft,jlt
319 IF (off(i) < one) offg(i) = off(i)
320 off_l = min(off_l,offg(i))
321 ENDDO
322C----------------------
323 IF (off_l <= zero) THEN
324 DO i=jft,jlt
325 IF (off(i) <= zero) THEN
326 f11(i) = zero
327 f21(i) = zero
328 f31(i) = zero
329 m11(i) = zero
330 m21(i) = zero
331 m31(i) = zero
332 f12(i) = zero
333 f22(i) = zero
334 f32(i) = zero
335 m12(i) = zero
336 m22(i) = zero
337 m32(i) = zero
338 f13(i) = zero
339 f23(i) = zero
340 f33(i) = zero
341 m13(i) = zero
342 m23(i) = zero
343 m33(i) = zero
344 f14(i) = zero
345 f24(i) = zero
346 f34(i) = zero
347 m14(i) = zero
348 m24(i) = zero
349 m34(i) = zero
350 sti(i) = zero
351 stir(i)= zero
352 ENDIF
353 ENDDO
354 ENDIF
355C
356 DO i=jft,jlt
357 elcrk = iel_crk(i+nft)
358 elcut = xfem_phantom(ilay)%ELCUT(elcrk)
359 IF (elcut /= 0) THEN
360 areap = crklvset(ilev)%AREA(elcrk)
361c
362 kk = iadc_crk(1,elcrk)
363 crksky(ilev)%FSKY(1,kk) = -f11(i)*areap
364 crksky(ilev)%FSKY(2,kk) = -f21(i)*areap
365 crksky(ilev)%FSKY(3,kk) = -f31(i)*areap
366 crksky(ilev)%FSKY(4,kk) = -m11(i)*areap
367 crksky(ilev)%FSKY(5,kk) = -m21(i)*areap
368 crksky(ilev)%FSKY(6,kk) = -m31(i)*areap
369 crksky(ilev)%FSKY(7,kk) = sti(i) *fac(1,i)
370 crksky(ilev)%FSKY(8,kk) = stir(i)*fac(1,i)
371C
372 kk = iadc_crk(2,elcrk)
373 crksky(ilev)%FSKY(1,kk) = -f12(i)*areap
374 crksky(ilev)%FSKY(2,kk) = -f22(i)*areap
375 crksky(ilev)%FSKY(3,kk) = -f32(i)*areap
376 crksky(ilev)%FSKY(4,kk) = -m12(i)*areap
377 crksky(ilev)%FSKY(5,kk) = -m22(i)*areap
378 crksky(ilev)%FSKY(6,kk) = -m32(i)*areap
379 crksky(ilev)%FSKY(7,kk) = sti(i) *fac(2,i)
380 crksky(ilev)%FSKY(8,kk) = stir(i)*fac(2,i)
381C
382 kk = iadc_crk(3,elcrk)
383 crksky(ilev)%FSKY(1,kk) = -f13(i)*areap
384 crksky(ilev)%FSKY(2,kk) = -f23(i)*areap
385 crksky(ilev)%FSKY(3,kk) = -f33(i)*areap
386 crksky(ilev)%FSKY(4,kk) = -m13(i)*areap
387 crksky(ilev)%FSKY(5,kk) = -m23(i)*areap
388 crksky(ilev)%FSKY(6,kk) = -m33(i)*areap
389 crksky(ilev)%FSKY(7,kk) = sti(i) *fac(1,i)
390 crksky(ilev)%FSKY(8,kk) = stir(i)*fac(1,i)
391C
392 kk = iadc_crk(4,elcrk)
393 crksky(ilev)%FSKY(1,kk) = -f14(i)*areap
394 crksky(ilev)%FSKY(2,kk) = -f24(i)*areap
395 crksky(ilev)%FSKY(3,kk) = -f34(i)*areap
396 crksky(ilev)%FSKY(4,kk) = -m14(i)*areap
397 crksky(ilev)%FSKY(5,kk) = -m24(i)*areap
398 crksky(ilev)%FSKY(6,kk) = -m34(i)*areap
399 crksky(ilev)%FSKY(7,kk) = sti(i) *fac(2,i)
400 crksky(ilev)%FSKY(8,kk) = stir(i)*fac(2,i)
401 END IF
402 END DO
403C-----------------------------------------------
404 DO i=jft,jlt
405 elcrk = iel_crk(i+nft)
406 elcut = xfem_phantom(ilay)%ELCUT(elcrk)
407 IF (elcut == 0) cycle
408C---
409c NODE 1
410C---
411 k = iadc(1,i)
412 kk = iadc_crk(1,elcrk)
413 enr = crklvset(ilev)%ENR0(2,kk)
414c
415 IF (enr <= 0) THEN
416 fsky(1,k) = fsky(1,k) + crksky(ilev)%FSKY(1,kk)
417 fsky(2,k) = fsky(2,k) + crksky(ilev)%FSKY(2,kk)
418 fsky(3,k) = fsky(3,k) + crksky(ilev)%FSKY(3,kk)
419 fsky(4,k) = fsky(4,k) + crksky(ilev)%FSKY(4,kk)
420 fsky(5,k) = fsky(5,k) + crksky(ilev)%FSKY(5,kk)
421 fsky(6,k) = fsky(6,k) + crksky(ilev)%FSKY(6,kk)
422C
423 crksky(ilev)%FSKY(1,kk) = zero
424 crksky(ilev)%FSKY(2,kk) = zero
425 crksky(ilev)%FSKY(3,kk) = zero
426 crksky(ilev)%FSKY(4,kk) = zero
427 crksky(ilev)%FSKY(5,kk) = zero
428 crksky(ilev)%FSKY(6,kk) = zero
429 END IF
430C---
431c NODE 2
432C---
433 k = iadc(2,i)
434 kk = iadc_crk(2,elcrk)
435 enr = crklvset(ilev)%ENR0(2,kk)
436c
437 IF (enr <= 0) THEN
438 fsky(1,k) = fsky(1,k) + crksky(ilev)%FSKY(1,kk)
439 fsky(2,k) = fsky(2,k) + crksky(ilev)%FSKY(2,kk)
440 fsky(3,k) = fsky(3,k) + crksky(ilev)%FSKY(3,kk)
441 fsky(4,k) = fsky(4,k) + crksky(ilev)%FSKY(4,kk)
442 fsky(5,k) = fsky(5,k) + crksky(ilev)%FSKY(5,kk)
443 fsky(6,k) = fsky(6,k) + crksky(ilev)%FSKY(6,kk)
444C
445 crksky(ilev)%FSKY(1,kk) = zero
446 crksky(ilev)%FSKY(2,kk) = zero
447 crksky(ilev)%FSKY(3,kk) = zero
448 crksky(ilev)%FSKY(4,kk) = zero
449 crksky(ilev)%FSKY(5,kk) = zero
450 crksky(ilev)%FSKY(6,kk) = zero
451 END IF
452C---
453c NODE 3
454C---
455 k = iadc(3,i)
456 kk = iadc_crk(3,elcrk)
457 enr = crklvset(ilev)%ENR0(2,kk)
458c
459 IF (enr <= 0) THEN
460 fsky(1,k) = fsky(1,k) + crksky(ilev)%FSKY(1,kk)
461 fsky(2,k) = fsky(2,k) + crksky(ilev)%FSKY(2,kk)
462 fsky(3,k) = fsky(3,k) + crksky(ilev)%FSKY(3,kk)
463 fsky(4,k) = fsky(4,k) + crksky(ilev)%FSKY(4,kk)
464 fsky(5,k) = fsky(5,k) + crksky(ilev)%FSKY(5,kk)
465 fsky(6,k) = fsky(6,k) + crksky(ilev)%FSKY(6,kk)
466C
467 crksky(ilev)%FSKY(1,kk) = zero
468 crksky(ilev)%FSKY(2,kk) = zero
469 crksky(ilev)%FSKY(3,kk) = zero
470 crksky(ilev)%FSKY(4,kk) = zero
471 crksky(ilev)%FSKY(5,kk) = zero
472 crksky(ilev)%FSKY(6,kk) = zero
473 END IF
474C---
475c NODE 4
476C---
477 k = iadc(4,i)
478 kk = iadc_crk(4,elcrk)
479 enr = crklvset(ilev)%ENR0(2,kk)
480c
481 IF (enr <= 0) THEN
482 fsky(1,k) = fsky(1,k) + crksky(ilev)%FSKY(1,kk)
483 fsky(2,k) = fsky(2,k) + crksky(ilev)%FSKY(2,kk)
484 fsky(3,k) = fsky(3,k) + crksky(ilev)%FSKY(3,kk)
485 fsky(4,k) = fsky(4,k) + crksky(ilev)%FSKY(4,kk)
486 fsky(5,k) = fsky(5,k) + crksky(ilev)%FSKY(5,kk)
487 fsky(6,k) = fsky(6,k) + crksky(ilev)%FSKY(6,kk)
488C
489 crksky(ilev)%FSKY(1,kk) = zero
490 crksky(ilev)%FSKY(2,kk) = zero
491 crksky(ilev)%FSKY(3,kk) = zero
492 crksky(ilev)%FSKY(4,kk) = zero
493 crksky(ilev)%FSKY(5,kk) = zero
494 crksky(ilev)%FSKY(6,kk) = zero
495 END IF
496C---
497 ENDDO
498C-------------
499 RETURN
500 END
501!||====================================================================
502!|| c3updt3_crk ../engine/source/elements/xfem/xfemfsky.F
503!||--- called by ------------------------------------------------------
504!|| c3forc3_crk ../engine/source/elements/xfem/c3forc3_crk.F
505!||--- uses -----------------------------------------------------
506!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
507!||====================================================================
508 SUBROUTINE c3updt3_crk(
509 . JFT ,JLT ,NFT ,IXTG ,OFF ,IADC ,
510 . F11 ,F21 ,F31 ,F12 ,F22 ,F32 ,
511 . F13 ,F23 ,F33 ,
512 . M11 ,M21 ,M31 ,M12 ,M22 ,M32 ,
513 . M13 ,M23 ,M33 ,
514 . STI ,STIR ,FSKY ,ELCUTC,IAD_CRKTG,IEL_CRKTG,
515 . ILEV ,ILAY ,OFFG ,CRKSKY)
516C-----------------------------------------------
517 USE crackxfem_mod
518C-----------------------------------------------
519C I m p l i c i t T y p e s
520C-----------------------------------------------
521#include "implicit_f.inc"
522C-----------------------------------------------
523C C o m m o n B l o c k s
524C-----------------------------------------------
525#include "parit_c.inc"
526#include "com_xfem1.inc"
527C-----------------------------------------------
528C D u m m y A r g u m e n t s
529C-----------------------------------------------
530 INTEGER JFT,JLT,NFT,IADC(3,*),IAD_CRKTG(3,*),IXTG(NIXTG,*),
531 . iel_crktg(*),ilev,elcutc(2,*),ixfem,ilay
532C REAL
533 my_real
534 . fsky(8,lsky),off(*),offg(*),
535 . f11(*),f21(*),f31(*),f12(*),f22(*),f32(*),
536 . f13(*),f23(*),f33(*),
537 . m11(*),m21(*),m31(*),m12(*),m22(*),m32(*),
538 . m13(*),m23(*),m33(*),
539 . sti(*),stir(*)
540 TYPE(xfem_sky_) , DIMENSION(*) :: CRKSKY
541C-----------------------------------------------
542C L o c a l V a r i a b l e s
543C-----------------------------------------------
544 INTEGER I,K,KK,ELCUT,ELCRK,ELCRKTG,ENR,IOFF
545 INTEGER IAD(3),IADXFE(3),UNENR0(3,JLT)
546 my_real OFF_L,AREAP
547C=======================================================================
548 IOFF=0
549 do i=jft,jlt
550 IF (off(i) == zero .AND. offg(i) > zero) ioff=1
551 ENDDO
552 IF (ioff == 1) numelcrk = numelcrk + 1
553C
554 off_l = zero
555 DO i=jft,jlt
556 IF (off(i) < one) offg(i) = off(i)
557 off_l = min(off_l,offg(i))
558 ENDDO
559C----------------------
560 IF (off_l <= zero) THEN
561 DO i=jft,jlt
562 IF (off(i) <= zero) THEN
563 f11(i) = zero
564 f21(i) = zero
565 f31(i) = zero
566 m11(i) = zero
567 m21(i) = zero
568 m31(i) = zero
569 f12(i) = zero
570 f22(i) = zero
571 f32(i) = zero
572 m12(i) = zero
573 m22(i) = zero
574 m32(i) = zero
575 f13(i) = zero
576 f23(i) = zero
577 f33(i) = zero
578 m13(i) = zero
579 m23(i) = zero
580 m33(i) = zero
581 sti(i) = zero
582 stir(i)= zero
583 ENDIF
584 ENDDO
585 ENDIF
586C
587 DO i=jft,jlt
588 elcrktg = iel_crktg(i+nft)
589 elcrk = elcrktg + ecrkxfec
590 elcut = xfem_phantom(ilay)%ELCUT(elcrk)
591 IF (elcut /= 0) THEN
592 areap = crklvset(ilev)%AREA(elcrk)
593c
594 kk = iad_crktg(1,elcrktg)
595 crksky(ilev)%FSKY(1,kk) = -f11(i)*areap
596 crksky(ilev)%FSKY(2,kk) = -f21(i)*areap
597 crksky(ilev)%FSKY(3,kk) = -f31(i)*areap
598 crksky(ilev)%FSKY(4,kk) = -m11(i)*areap
599 crksky(ilev)%FSKY(5,kk) = -m21(i)*areap
600 crksky(ilev)%FSKY(6,kk) = -m31(i)*areap
601 crksky(ilev)%FSKY(7,kk) = sti(i)
602 crksky(ilev)%FSKY(8,kk) = stir(i)
603C
604 kk = iad_crktg(2,elcrktg)
605 crksky(ilev)%FSKY(1,kk) = -f12(i)*areap
606 crksky(ilev)%FSKY(2,kk) = -f22(i)*areap
607 crksky(ilev)%FSKY(3,kk) = -f32(i)*areap
608 crksky(ilev)%FSKY(4,kk) = -m12(i)*areap
609 crksky(ilev)%FSKY(5,kk) = -m22(i)*areap
610 crksky(ilev)%FSKY(6,kk) = -m32(i)*areap
611 crksky(ilev)%FSKY(7,kk) = sti(i)
612 crksky(ilev)%FSKY(8,kk) = stir(i)
613C
614 kk = iad_crktg(3,elcrktg)
615 crksky(ilev)%FSKY(1,kk) = -f13(i)*areap
616 crksky(ilev)%FSKY(2,kk) = -f23(i)*areap
617 crksky(ilev)%FSKY(3,kk) = -f33(i)*areap
618 crksky(ilev)%FSKY(4,kk) = -m13(i)*areap
619 crksky(ilev)%FSKY(5,kk) = -m23(i)*areap
620 crksky(ilev)%FSKY(6,kk) = -m33(i)*areap
621 crksky(ilev)%FSKY(7,kk) = sti(i)
622 crksky(ilev)%FSKY(8,kk) = stir(i)
623 END IF
624 END DO
625C-----------------------------------------------
626 DO i=jft,jlt
627 elcrktg = iel_crktg(i+nft)
628 elcrk = elcrktg + ecrkxfec
629 elcut = xfem_phantom(ilay)%ELCUT(elcrk)
630 IF (elcut == 0) cycle
631C---
632c NODE 1
633C---
634 k = iadc(1,i)
635 kk = iad_crktg(1,elcrktg)
636 enr = crklvset(ilev)%ENR0(2,kk)
637C
638 IF (enr <= 0) THEN
639 fsky(1,k) = fsky(1,k) + crksky(ilev)%FSKY(1,kk)
640 fsky(2,k) = fsky(2,k) + crksky(ilev)%FSKY(2,kk)
641 fsky(3,k) = fsky(3,k) + crksky(ilev)%FSKY(3,kk)
642 fsky(4,k) = fsky(4,k) + crksky(ilev)%FSKY(4,kk)
643 fsky(5,k) = fsky(5,k) + crksky(ilev)%FSKY(5,kk)
644 fsky(6,k) = fsky(6,k) + crksky(ilev)%FSKY(6,kk)
645C
646 crksky(ilev)%FSKY(1,kk) = zero
647 crksky(ilev)%FSKY(2,kk) = zero
648 crksky(ilev)%FSKY(3,kk) = zero
649 crksky(ilev)%FSKY(4,kk) = zero
650 crksky(ilev)%FSKY(5,kk) = zero
651 crksky(ilev)%FSKY(6,kk) = zero
652 END IF
653C---
654c NODE 2
655C---
656 k = iadc(2,i)
657 kk = iad_crktg(2,elcrktg)
658 enr = crklvset(ilev)%ENR0(2,kk)
659C
660 IF (enr <= 0) THEN
661 fsky(1,k) = fsky(1,k) + crksky(ilev)%FSKY(1,kk)
662 fsky(2,k) = fsky(2,k) + crksky(ilev)%FSKY(2,kk)
663 fsky(3,k) = fsky(3,k) + crksky(ilev)%FSKY(3,kk)
664 fsky(4,k) = fsky(4,k) + crksky(ilev)%FSKY(4,kk)
665 fsky(5,k) = fsky(5,k) + crksky(ilev)%FSKY(5,kk)
666 fsky(6,k) = fsky(6,k) + crksky(ilev)%FSKY(6,kk)
667C
668 crksky(ilev)%FSKY(1,kk) = zero
669 crksky(ilev)%FSKY(2,kk) = zero
670 crksky(ilev)%FSKY(3,kk) = zero
671 crksky(ilev)%FSKY(4,kk) = zero
672 crksky(ilev)%FSKY(5,kk) = zero
673 crksky(ilev)%FSKY(6,kk) = zero
674 END IF
675C---
676c NODE 3
677C---
678 k = iadc(3,i)
679 kk = iad_crktg(3,elcrktg)
680 enr = crklvset(ilev)%ENR0(2,kk)
681C
682 IF (enr <= 0) THEN
683 fsky(1,k) = fsky(1,k) + crksky(ilev)%FSKY(1,kk)
684 fsky(2,k) = fsky(2,k) + crksky(ilev)%FSKY(2,kk)
685 fsky(3,k) = fsky(3,k) + crksky(ilev)%FSKY(3,kk)
686 fsky(4,k) = fsky(4,k) + crksky(ilev)%FSKY(4,kk)
687 fsky(5,k) = fsky(5,k) + crksky(ilev)%FSKY(5,kk)
688 fsky(6,k) = fsky(6,k) + crksky(ilev)%FSKY(6,kk)
689C
690 crksky(ilev)%FSKY(1,kk) = zero
691 crksky(ilev)%FSKY(2,kk) = zero
692 crksky(ilev)%FSKY(3,kk) = zero
693 crksky(ilev)%FSKY(4,kk) = zero
694 crksky(ilev)%FSKY(5,kk) = zero
695 crksky(ilev)%FSKY(6,kk) = zero
696 END IF
697C---
698 ENDDO
699C-----------
700 RETURN
701 END
702!||====================================================================
703!|| spmd_crk_adv ../engine/source/elements/xfem/xfemfsky.F
704!||--- called by ------------------------------------------------------
705!|| resol ../engine/source/engine/resol.F
706!||--- calls -----------------------------------------------------
707!|| spmd_exch_nodenr ../engine/source/mpi/elements/spmd_xfem.F
708!||--- uses -----------------------------------------------------
709!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
710!||====================================================================
711 SUBROUTINE spmd_crk_adv(IAD_ELEM ,FR_ELEM, INOD_CRK ,ENRTAG)
712C-----------------------------------------------
713 USE crackxfem_mod
714C-----------------------------------------------
715C I m p l i c i t T y p e s
716C-----------------------------------------------
717#include "implicit_f.inc"
718C-----------------------------------------------
719C C o m m o n B l o c k s
720C-----------------------------------------------
721#include "com01_c.inc"
722#include "com04_c.inc"
723#include "com_xfem1.inc"
724C-----------------------------------------------
725C D u m m y A r g u m e n t s
726C-----------------------------------------------
727 INTEGER IAD_ELEM(2,NSPMD+1),FR_ELEM(*),INOD_CRK(*),
728 . ENRTAG(NUMNOD,*)
729C-----------------------------------------------
730C L o c a l V a r i a b l e s
731C-----------------------------------------------
732 INTEGER SIZE,LENR,FLAG
733C-----------------------------------------------
734 SIZE = ienrnod
735 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
736 flag = 1
737 CALL spmd_exch_nodenr(iad_elem,fr_elem,SIZE,lenr,inod_crk,
738 . enrtag,flag)
739C-------------
740 RETURN
741 END
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
crackxfem_mod
Definition crackxfem_mod.F:121
crackxfem_mod::xfem_phantom
type(xfem_phantom_), dimension(:), allocatable xfem_phantom
Definition crackxfem_mod.F:139
crackxfem_mod::crklvset
type(xfem_lvset_), dimension(:), allocatable crklvset
Definition crackxfem_mod.F:146
spmd_exch_nodenr
subroutine spmd_exch_nodenr(iad_elem, fr_elem, size, lenr, inod_crk, enrtag, flag)
Definition spmd_xfem.F:483
crackxfem_mod::xfem_sky_
Definition crackxfem_mod.F:148
c3updt3_crk
subroutine c3updt3_crk(jft, jlt, nft, ixtg, off, iadc, f11, f21, f31, f12, f22, f32, f13, f23, f33, m11, m21, m31, m12, m22, m32, m13, m23, m33, sti, stir, fsky, elcutc, iad_crktg, iel_crktg, ilev, ilay, offg, crksky)
Definition xfemfsky.F:516
spmd_crk_adv
subroutine spmd_crk_adv(iad_elem, fr_elem, inod_crk, enrtag)
Definition xfemfsky.F:712
cupdtn3_crk
subroutine cupdtn3_crk(jft, jlt, nft, ixc, off, iadc, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, m11, m21, m31, m12, m22, m32, m13, m23, m33, m14, m24, m34, sti, stir, fsky, elcutc, iadc_crk, iel_crk, ilev, inod_crk, fac, offg, eint, partsav, ipartc, ilay, crksky)
Definition xfemfsky.F:278
cupdt3_crk
subroutine cupdt3_crk(jft, jlt, nft, ixc, off, iadc, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, m11, m21, m31, m12, m22, m32, m13, m23, m33, m14, m24, m34, sti, stir, fsky, elcutc, iadc_crk, iel_crk, ilev, inod_crk, offg, eint, partsav, ipartc, ilay, crksky)
Definition xfemfsky.F:39