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 513 of file xfemfsky.F.

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
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 31 of file xfemfsky.F.

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

◆ 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 272 of file xfemfsky.F.

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

◆ 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 717 of file xfemfsky.F.

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