OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
xfeconnec3n.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "comlock.inc"
#include "com_xfem1.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine xfeconnec3n (jft, jlt, nft, ixtg, elcutc, iel_crktg, iad_crktg, ilev, nodedge, crkedge, xedge3n)

Function/Subroutine Documentation

◆ xfeconnec3n()

subroutine xfeconnec3n ( integer jft,
integer jlt,
integer nft,
integer, dimension(nixtg,*) ixtg,
integer, dimension(2,*) elcutc,
integer, dimension(*) iel_crktg,
integer, dimension(3,*) iad_crktg,
integer ilev,
integer, dimension(2,*) nodedge,
type (xfem_edge_), dimension(*) crkedge,
integer, dimension(3,*) xedge3n )

Definition at line 31 of file xfeconnec3n.F.

35C-----------------------------------------------
37 use element_mod , only : nixtg
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C G l o b a l P a r a m e t e r s
44C-----------------------------------------------
45#include "mvsiz_p.inc"
46#include "comlock.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com_xfem1.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER JFT,JLT,NFT,ILEV,IXTG(NIXTG,*),ELCUTC(2,*),IEL_CRKTG(*),
55 . IAD_CRKTG(3,*),XEDGE3N(3,*),NODEDGE(2,*)
56 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER I,K,K1,K2,K3,KK,P1,P2,P3,IFI1,IFI2,
61 . EDGE,IEDGE1,IEDGE2,EDGE1,EDGE2,IED1,IED2,
62 . IADC1,IADC2,IADC3,ILAY,IXEL,ELCUT,ELCRK,ELCRKTG,
63 . IED0,IFI10,NOD1,NOD2,ITRI,NX1,NX2,NX3
64 INTEGER IFI0(3,MVSIZ),D1(3),D2(3),DX(6)
66 . xin(3,mvsiz),yin(3,mvsiz),zin(3,mvsiz),
67 . xx(3,mvsiz),yy(3,mvsiz),zz(3,mvsiz)
68 my_real x10,y10,z10,x20,y20,z20,beta
69C-------------------
70 DATA d1/2,3,1/
71 DATA d2/3,1,2/
72 DATA dx/1,2,3,1,2,3/
73c DATA ED/1,3,2,1,3,2/
74C=======================================================================
75c Re-built phantom connectivities
76C-----------------------------------------------
77 ixel = mod(ilev-1, nxel) + 1
78 ilay = (ilev-ixel)/nxel + 1
79 p1 = 0
80 p2 = 0
81 p3 = 0
82c
83 DO i=jft,jlt
84 xin(1,i) = zero
85 yin(1,i) = zero
86 zin(1,i) = zero
87 xin(2,i) = zero
88 yin(2,i) = zero
89 zin(2,i) = zero
90 xin(3,i) = zero
91 yin(3,i) = zero
92 zin(3,i) = zero
93 END DO
94C-----------------
95 DO i=jft,jlt
96 elcrktg = iel_crktg(i+nft)
97 iadc1 = iad_crktg(1,elcrktg)
98 iadc2 = iad_crktg(2,elcrktg)
99 iadc3 = iad_crktg(3,elcrktg)
100C
101 ifi0(1,i) = xfem_phantom(ilay)%IFI(iadc1)
102 ifi0(2,i) = xfem_phantom(ilay)%IFI(iadc2)
103 ifi0(3,i) = xfem_phantom(ilay)%IFI(iadc3)
104C
105 ifi0(1,i) = isign(1,ifi0(1,i))
106 ifi0(2,i) = isign(1,ifi0(2,i))
107 ifi0(3,i) = isign(1,ifi0(3,i))
108C--------------
109c Copy local phantom node coordinates (per ILEV)
110C--------------
111c node 1:
112 xx(1,i) = crkavx(ilev)%X(1,iadc1)
113 yy(1,i) = crkavx(ilev)%X(2,iadc1)
114 zz(1,i) = crkavx(ilev)%X(3,iadc1)
115c node 2:
116 xx(2,i) = crkavx(ilev)%X(1,iadc2)
117 yy(2,i) = crkavx(ilev)%X(2,iadc2)
118 zz(2,i) = crkavx(ilev)%X(3,iadc2)
119c node 3:
120 xx(3,i) = crkavx(ilev)%X(1,iadc3)
121 yy(3,i) = crkavx(ilev)%X(2,iadc3)
122 zz(3,i) = crkavx(ilev)%X(3,iadc3)
123 END DO
124c-----------------------------------------------
125c calculate intersection coordinates of cut edges : XIN, YIN, ZIN
126c-----------------------------------------------
127 DO i=jft,jlt
128 elcrktg = iel_crktg(i+nft)
129 elcrk = elcrktg + ecrkxfec
130 elcut = xfem_phantom(ilay)%ELCUT(elcrk)
131 IF (elcut /= 0) THEN
132 DO k=1,3
133 ied0 = crkedge(ilay)%IEDGETG(k,elcrktg)
134 IF (ied0 > 0) THEN
135 edge = xedge3n(k,elcrktg)
136 beta = crkedge(ilay)%RATIO(edge)
137 nod1 = nodedge(1,edge)
138 nod2 = nodedge(2,edge)
139 IF (nod1 == ixtg(k+1,i+nft) .and.
140 . nod2 == ixtg(d1(k)+1,i+nft)) THEN
141 p1 = k
142 p2 = d1(k)
143 ELSEIF (nod2 == ixtg(k+1,i+nft).and.
144 . nod1 == ixtg(d1(k)+1,i+nft)) THEN
145 p1 = d1(k)
146 p2 = k
147 ENDIF
148 x10 = xx(p1,i)
149 y10 = yy(p1,i)
150 z10 = zz(p1,i)
151 x20 = xx(p2,i)
152 y20 = yy(p2,i)
153 z20 = zz(p2,i)
154 xin(ied0,i) = x10+beta*(x20-x10)
155 yin(ied0,i) = y10+beta*(y20-y10)
156 zin(ied0,i) = z10+beta*(z20-z10)
157 END IF
158 END DO
159 END IF
160 END DO
161c-----------------------------------------------
162c main loop over elements
163C SIMPLE CRACKED ELEMENT
164C only one crack inside element
165c-----------------------------------------------
166 DO i=jft,jlt
167 elcrktg = iel_crktg(i+nft)
168 elcrk = elcrktg + ecrkxfec
169 elcut = xfem_phantom(ilay)%ELCUT(elcrk)
170C---
171 IF (elcutc(1,i+nft) == 0) cycle
172 p1 = 0
173 p2 = 0
174 p3 = 0
175 DO k=1,3
176 ifi10 = ifi0(k,i)
177 ifi1 = ifi0(d1(k),i)
178 ifi2 = ifi0(d2(k),i)
179 IF (ifi10*ifi1 < 0 .and. ifi10*ifi2 < 0) THEN
180 p1 = k
181 p2 = d1(k)
182 p3 = d2(k)
183 EXIT
184 END IF
185 END DO
186C
187 IF (p1==0 .or. p2==0 .or. p3==0) cycle
188C--------------------------
189 itri = xfem_phantom(ilay)%ITRI(1,elcrk)
190 nx1 = xfem_phantom(ilay)%ITRI(2,elcrk)
191 nx2 = dx(nx1+1)
192 nx3 = dx(nx1+2)
193 ied1 = nx1
194 ied2 = nx3
195 iedge1 = crkedge(ilay)%IEDGETG(ied1,elcrktg)
196 iedge2 = crkedge(ilay)%IEDGETG(ied2,elcrktg)
197 edge1 = xedge3n(ied1,elcrktg) ! global xfem edge number
198 edge2 = xedge3n(ied2,elcrktg) ! global xfem edge number
199c
200 kk = crkshell(ilev)%XNODEL(nx1,elcrk)
201 k1 = kk - crknod(ilev)%CRKNUMNODS * (ilev-1)
202 kk = crkshell(ilev)%XNODEL(nx2,elcrk)
203 k2 = kk - crknod(ilev)%CRKNUMNODS * (ilev-1)
204 kk = crkshell(ilev)%XNODEL(nx3,elcrk)
205 k3 = kk - crknod(ilev)%CRKNUMNODS * (ilev-1)
206C--------------------------
207 IF (itri < 0) THEN
208C--------------------------
209 IF (ixel == 1) THEN
210c NX1 -> unchanged
211c NX2 -> intersec edge1 : Nx1->Nx2
212c NX3 -> intersec edge2 : Nx3->Nx1
213c
214 crkavx(ilev)%XX(1,k2) = xin(iedge1,i)
215 crkavx(ilev)%XX(2,k2) = yin(iedge1,i)
216 crkavx(ilev)%XX(3,k2) = zin(iedge1,i)
217 crkavx(ilev)%XX(1,k3) = xin(iedge2,i)
218 crkavx(ilev)%XX(2,k3) = yin(iedge2,i)
219 crkavx(ilev)%XX(3,k3) = zin(iedge2,i)
220c
221 ELSEIF (ixel == 2) THEN
222c NX1 -> intersec edge2 : Nx3->Nx1
223c NX2 -> unchanged
224c NX3 -> unchanged
225c
226 crkavx(ilev)%XX(1,k1) = xin(iedge2,i)
227 crkavx(ilev)%XX(2,k1) = yin(iedge2,i)
228 crkavx(ilev)%XX(3,k1) = zin(iedge2,i)
229c
230 ELSEIF (ixel == 3) THEN
231c NX1 -> intersec edge1 : Nx1->Nx2
232c NX2 -> unchanged
233c NX3 -> moved
234 crkavx(ilev)%XX(1,k1) = xin(iedge1,i)
235 crkavx(ilev)%XX(2,k1) = yin(iedge1,i)
236 crkavx(ilev)%XX(3,k1) = zin(iedge1,i)
237
238 crkavx(ilev)%XX(1,k3) = xin(iedge2,i)
239 crkavx(ilev)%XX(2,k3) = yin(iedge2,i)
240 crkavx(ilev)%XX(3,k3) = zin(iedge2,i)
241 END IF
242C--------------------------
243 ELSEIF (itri > 0) THEN
244C--------------------------
245 IF (ixel == 1) THEN
246c NX1 -> intersec edge1 : Nx1->Nx2
247c NX2 -> unchanged
248c NX3 -> unchanged
249c
250 crkavx(ilev)%XX(1,k1) = xin(iedge1,i)
251 crkavx(ilev)%XX(2,k1) = yin(iedge1,i)
252 crkavx(ilev)%XX(3,k1) = zin(iedge1,i)
253c
254 ELSEIF (ixel == 2) THEN
255c NX1 -> unchanged
256c NX2 -> intersec edge1 : Nx1->Nx2
257c NX3 -> intersec edge2 : Nx3->Nx1
258 crkavx(ilev)%XX(1,k2) = xin(iedge1,i)
259 crkavx(ilev)%XX(2,k2) = yin(iedge1,i)
260 crkavx(ilev)%XX(3,k2) = zin(iedge1,i)
261 crkavx(ilev)%XX(1,k3) = xin(iedge2,i)
262 crkavx(ilev)%XX(2,k3) = yin(iedge2,i)
263 crkavx(ilev)%XX(3,k3) = zin(iedge2,i)
264 ELSEIF (ixel == 3) THEN
265c NX1 -> intersec edge2 : Nx3->Nx1
266c NX2 -> moved
267c NX3 -> unchanged
268 crkavx(ilev)%XX(1,k1) = xin(iedge2,i)
269 crkavx(ilev)%XX(2,k1) = yin(iedge2,i)
270 crkavx(ilev)%XX(3,k1) = zin(iedge2,i)
271c
272 crkavx(ilev)%XX(1,k2) = crkavx(ilev-2)%XX(1,k1)
273 crkavx(ilev)%XX(2,k2) = crkavx(ilev-2)%XX(2,k1)
274 crkavx(ilev)%XX(3,k2) = crkavx(ilev-2)%XX(3,k1)
275c CRKAVX(ILEV)%XX(1,K2) = XIN(IEDGE1,I)
276c CRKAVX(ILEV)%XX(2,K2) = YIN(IEDGE1,I)
277c CRKAVX(ILEV)%XX(3,K2) = ZIN(IEDGE1,I)
278 END IF ! IXEL
279C---
280 ENDIF ! ITRI
281C-----------------
282 ENDDO ! I=JFT,JLT
283C-----------------
284 RETURN
#define my_real
Definition cppsort.cpp:32
type(xfem_phantom_), dimension(:), allocatable xfem_phantom
type(xfem_nodes_), dimension(:), allocatable crknod
type(xfem_avx_), dimension(:), allocatable crkavx
type(xfem_shell_), dimension(:), allocatable crkshell