OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
xfemfsky.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "parit_c.inc"
#include "com_xfem1.inc"
#include "com01_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)
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)
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)
subroutine spmd_crk_adv (iad_elem, fr_elem, inod_crk, enrtag)

Function/Subroutine Documentation

◆ c3updt3_crk()

subroutine c3updt3_crk ( integer jft,
integer jlt,
integer nft,
integer, dimension(nixtg,*) ixtg,
off,
integer, dimension(3,*) iadc,
f11,
f21,
f31,
f12,
f22,
f32,
f13,
f23,
f33,
m11,
m21,
m31,
m12,
m22,
m32,
m13,
m23,
m33,
sti,
stir,
fsky,
integer, dimension(2,*) elcutc,
integer, dimension(3,*) iad_crktg,
integer, dimension(*) iel_crktg,
integer ilev,
integer ilay,
offg,
type(xfem_sky_), dimension(*) crksky )

Definition at line 508 of file xfemfsky.F.

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
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

◆ cupdt3_crk()

subroutine cupdt3_crk ( integer jft,
integer jlt,
integer nft,
integer, dimension(nixc,*) ixc,
off,
integer, dimension(4,*) 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,
integer, dimension(2,*) elcutc,
integer, dimension(4,*) iadc_crk,
integer, dimension(*) iel_crk,
integer ilev,
integer, dimension(*) inod_crk,
offg,
eint,
partsav,
integer, dimension(*) ipartc,
integer ilay,
type(xfem_sky_), dimension(*) crksky )

Definition at line 30 of file xfemfsky.F.

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

◆ cupdtn3_crk()

subroutine cupdtn3_crk ( integer jft,
integer jlt,
integer nft,
integer, dimension(nixc,*) ixc,
off,
integer, dimension(4,*) 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,
integer, dimension(2,*) elcutc,
integer, dimension(4,*) iadc_crk,
integer, dimension(*) iel_crk,
integer ilev,
integer, dimension(*) inod_crk,
fac,
offg,
eint,
partsav,
integer, dimension(*) ipartc,
integer ilay,
type(xfem_sky_), dimension(*) crksky )

Definition at line 269 of file xfemfsky.F.

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

◆ spmd_crk_adv()

subroutine spmd_crk_adv ( integer, dimension(2,nspmd+1) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) inod_crk,
integer, dimension(numnod,*) enrtag )

Definition at line 711 of file xfemfsky.F.

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
spmd_exch_nodenr
subroutine spmd_exch_nodenr(iad_elem, fr_elem, size, lenr, inod_crk, enrtag, flag)
Definition spmd_xfem.F:483