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