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!|| element_mod ../common_source/modules/elements/element_mod.F90
30!||====================================================================
31 SUBROUTINE xfeconnec3n(
32 . JFT ,JLT ,NFT ,IXTG ,ELCUTC ,
33 . IEL_CRKTG,IAD_CRKTG,ILEV ,NODEDGE ,CRKEDGE ,
34 . XEDGE3N )
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)
65 my_real
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
285 END
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
subroutine xfeconnec3n(jft, jlt, nft, ixtg, elcutc, iel_crktg, iad_crktg, ilev, nodedge, crkedge, xedge3n)
Definition xfeconnec3n.F:35