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