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

Go to the source code of this file.

Functions/Subroutines

subroutine crk_vitesse2 (iparg, ngrouc, igrouc, elcutc, crkedge, nodedge, ixc, ixtg, xedge4n, xedge3n, iadc_crk, iel_crk, inod_crk, itab)
subroutine upxvit_c1 (nel, nft, nxlay, elcutc, iel_crk, iadc_crk)
subroutine upxvit_t1 (nel, nft, nxlay, elcutg, iel_xtg, iadc_xtg)
subroutine upxvit_c2 (nel, nft, nxlay, ixc, xedge4n, crkedge, nodedge, iel_crk, iadc_crk, inod_crk, elcutc, itab)
subroutine upxvit_t2 (nel, nft, nxlay, ixtg, xedge3n, crkedge, nodedge, iel_xtg, iadc_xtg, inod_crk, elcutg, itab)

Function/Subroutine Documentation

◆ crk_vitesse2()

subroutine crk_vitesse2 ( integer, dimension(nparg,*) iparg,
integer ngrouc,
integer, dimension(*) igrouc,
integer, dimension(2,*) elcutc,
type (xfem_edge_), dimension(*) crkedge,
integer, dimension(2,*) nodedge,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(4,*) xedge4n,
integer, dimension(3,*) xedge3n,
integer, dimension(*) iadc_crk,
integer, dimension(*) iel_crk,
integer, dimension(*) inod_crk,
integer, dimension(*) itab )

Definition at line 35 of file crk_vitesse2.F.

38C-----------------------------------------------
39 USE crackxfem_mod
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "param_c.inc"
48#include "com04_c.inc"
49#include "com_xfem1.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER NGROUC
54 INTEGER IPARG(NPARG,*),IGROUC(*),IADC_CRK(*),IEL_CRK(*),INOD_CRK(*),
55 . ELCUTC(2,*),NODEDGE(2,*),IXC(NIXC,*),IXTG(NIXTG,*),ITAB(*),
56 . XEDGE4N(4,*),XEDGE3N(3,*)
57 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER IG,ITY,NG,NEL,NFT,ITG1,ITG2,IXFEM,NXLAY,GOFF,XOFF
62C=======================================================================
63C Boucle parallele dynamique SMP
64!$OMP DO SCHEDULE(DYNAMIC,1)
65 DO ig = 1, ngrouc
66 ng = igrouc(ig)
67 ixfem = iparg(54,ng)
68 goff = iparg(8,ng) ! GROUP OFF
69 xoff = iparg(70,ng) ! XFEEM GROUP ACTIVITY FLAG
70 IF (ixfem == 0 .or. goff == 1 .or. xoff == 0) cycle
71 ity = iparg(5,ng)
72 nel = iparg(2,ng)
73 nft = iparg(3,ng)
74 nxlay= iparg(59,ng)
75c copy velocities inside cracked element if ITRI/=0
76 IF (ity == 3) THEN
77 CALL upxvit_c1(nel ,nft ,nxlay ,elcutc,
78 . iel_crk ,iadc_crk)
79 ELSEIF (ity == 7) THEN
80 itg1 = 1 + numelc
81 itg2 = 1 + ecrkxfec*4
82 CALL upxvit_t1(nel ,nft ,nxlay ,elcutc(1,itg1) ,
83 . iel_crk(itg1) ,iadc_crk(itg2))
84 ENDIF
85 END DO
86!$OMP END DO
87c
88c-----------
89c
90C Boucle parallele dynamique SMP
91!$OMP DO SCHEDULE(DYNAMIC,1)
92 DO ig = 1, ngrouc
93 ng = igrouc(ig)
94 ixfem = iparg(54,ng)
95 goff = iparg(8,ng) ! GROUP OFF
96 xoff = iparg(70,ng) ! XFEEM GROUP ACTIVITY FLAG
97 IF (ixfem == 0 .or. goff == 1 .or. xoff == 0) cycle
98 ity = iparg(5,ng)
99 nel = iparg(2,ng)
100 nft = iparg(3,ng)
101 nxlay= iparg(59,ng)
102c copy velocities between cracked elements
103 IF (ity == 3) THEN
104 CALL upxvit_c2(nel ,nft ,nxlay ,ixc ,xedge4n ,
105 . crkedge ,nodedge ,iel_crk ,iadc_crk ,inod_crk ,
106 . elcutc ,itab )
107 ELSEIF (ity == 7) THEN
108 itg1 = 1 + numelc
109 itg2 = 1 + ecrkxfec*4
110 CALL upxvit_t2(nel ,nft ,nxlay ,ixtg ,xedge3n,
111 . crkedge ,nodedge ,iel_crk(itg1),iadc_crk(itg2),inod_crk ,
112 . elcutc(1,itg1) ,itab )
113 ENDIF
114 END DO
115!$OMP END DO
116c-----------
117 RETURN
upxvit_t1
subroutine upxvit_t1(nel, nft, nxlay, elcutg, iel_xtg, iadc_xtg)
Definition crk_vitesse2.F:223
upxvit_c2
subroutine upxvit_c2(nel, nft, nxlay, ixc, xedge4n, crkedge, nodedge, iel_crk, iadc_crk, inod_crk, elcutc, itab)
Definition crk_vitesse2.F:318
upxvit_c1
subroutine upxvit_c1(nel, nft, nxlay, elcutc, iel_crk, iadc_crk)
Definition crk_vitesse2.F:129
upxvit_t2
subroutine upxvit_t2(nel, nft, nxlay, ixtg, xedge3n, crkedge, nodedge, iel_xtg, iadc_xtg, inod_crk, elcutg, itab)
Definition crk_vitesse2.F:419
crackxfem_mod
Definition crackxfem_mod.F:121

◆ upxvit_c1()

subroutine upxvit_c1 ( integer nel,
integer nft,
integer nxlay,
integer, dimension(2,*) elcutc,
integer, dimension(*) iel_crk,
integer, dimension(4,*) iadc_crk )

Definition at line 127 of file crk_vitesse2.F.

129C-----------------------------------------------
130 USE crackxfem_mod
131C-----------------------------------------------
132C I m p l i c i t T y p e s
133C-----------------------------------------------
134#include "implicit_f.inc"
135C-----------------------------------------------
136C C o m m o n B l o c k s
137C-----------------------------------------------
138#include "com_xfem1.inc"
139C-----------------------------------------------
140C D u m m y A r g u m e n t s
141C-----------------------------------------------
142 INTEGER NEL,NFT,NXLAY
143 INTEGER ELCUTC(2,*),IADC_CRK(4,*),IEL_CRK(*)
144C-----------------------------------------------
145C L o c a l V a r i a b l e s
146C-----------------------------------------------
147 INTEGER I,II,K,ILAY,IXEL,ILEV,IL,ICUT,ELEM,ELCRK,IAD,ITRI,EN,EN0,EN1
148C=======================================================================
149 DO ilay=1,nxlay
150 ii = nxel*(ilay-1)
151 DO i=1,nel
152 elem = i+nft
153 elcrk = iel_crk(elem)
154 icut = elcutc(1,elem)
155 IF (elcrk > 0 .and. icut > 0) THEN
156 itri = xfem_phantom(ilay)%ITRI(1,elcrk)
157c print*,'vit2 :ELCRK,ITRI=', ELCRK,ITRI
158c----
159 IF (itri < 0) THEN ! copy IXEL=3 => IXEL=2
160 ixel = 2
161 ilev = ii + ixel
162 DO k=1,4
163 iad = iadc_crk(k,elcrk)
164 en0 = crklvset(ilev)%ENR0(2,iad) ! enr initial du debut de cycle
165 en = crklvset(ilev)%ENR0(1,iad) ! enr mise a jour dans le cycle
166 IF (en0 < 0 .and. en > 0) THEN
167 il = ilev+1
168 en1 = crklvset(il)%ENR0(2,iad)
169 IF (en1 > 0) THEN
170 crkavx(ilev)%X(1,iad) = crkavx(il)%X(1,iad)
171 crkavx(ilev)%X(2,iad) = crkavx(il)%X(2,iad)
172 crkavx(ilev)%X(3,iad) = crkavx(il)%X(3,iad)
173 crkavx(ilev)%V(1,iad) = crkavx(il)%V(1,iad)
174 crkavx(ilev)%V(2,iad) = crkavx(il)%V(2,iad)
175 crkavx(ilev)%V(3,iad) = crkavx(il)%V(3,iad)
176 crkavx(ilev)%VR(1,iad) = crkavx(il)%VR(1,iad)
177 crkavx(ilev)%VR(2,iad) = crkavx(il)%VR(2,iad)
178 crkavx(ilev)%VR(3,iad) = crkavx(il)%VR(3,iad)
179 ENDIF
180 ENDIF
181 ENDDO
182 ELSEIF (itri > 0) THEN ! copy IXEL=3 => IXEL=1
183 ixel = 1
184 ilev = ii + ixel
185 DO k=1,4
186 iad = iadc_crk(k,elcrk)
187 en0 = crklvset(ilev)%ENR0(2,iad) ! enr initial du debut de cycle
188 en = crklvset(ilev)%ENR0(1,iad) ! enr mise a jour dans le cycle
189 IF (en0 < 0 .and. en > 0) THEN
190 il = ilev+2
191 en1 = crklvset(il)%ENR0(2,iad)
192 IF (en1 > 0) THEN
193 crkavx(ilev)%X(1,iad) = crkavx(il)%X(1,iad)
194 crkavx(ilev)%X(2,iad) = crkavx(il)%X(2,iad)
195 crkavx(ilev)%X(3,iad) = crkavx(il)%X(3,iad)
196 crkavx(ilev)%V(1,iad) = crkavx(il)%V(1,iad)
197 crkavx(ilev)%V(2,iad) = crkavx(il)%V(2,iad)
198 crkavx(ilev)%V(3,iad) = crkavx(il)%V(3,iad)
199 crkavx(ilev)%VR(1,iad) = crkavx(il)%VR(1,iad)
200 crkavx(ilev)%VR(2,iad) = crkavx(il)%VR(2,iad)
201 crkavx(ilev)%VR(3,iad) = crkavx(il)%VR(3,iad)
202 ENDIF
203 ENDIF
204 ENDDO
205 END IF
206c----
207 END IF
208 ENDDO
209 ENDDO
210c-----------
211 RETURN
crackxfem_mod::xfem_phantom
type(xfem_phantom_), dimension(:), allocatable xfem_phantom
Definition crackxfem_mod.F:139
crackxfem_mod::crkavx
type(xfem_avx_), dimension(:), allocatable crkavx
Definition crackxfem_mod.F:163
crackxfem_mod::crklvset
type(xfem_lvset_), dimension(:), allocatable crklvset
Definition crackxfem_mod.F:146

◆ upxvit_c2()

subroutine upxvit_c2 ( integer nel,
integer nft,
integer nxlay,
integer, dimension(nixc,*) ixc,
integer, dimension(4,*) xedge4n,
type (xfem_edge_), dimension(*) crkedge,
integer, dimension(2,*) nodedge,
integer, dimension(*) iel_crk,
integer, dimension(4,*) iadc_crk,
integer, dimension(*) inod_crk,
integer, dimension(2,*) elcutc,
integer, dimension(*) itab )

Definition at line 315 of file crk_vitesse2.F.

318C-----------------------------------------------
319 USE crackxfem_mod
320C-----------------------------------------------
321C I m p l i c i t T y p e s
322C-----------------------------------------------
323#include "implicit_f.inc"
324C-----------------------------------------------
325C C o m m o n B l o c k s
326C-----------------------------------------------
327#include "com_xfem1.inc"
328C-----------------------------------------------
329C D u m m y A r g u m e n t s
330C-----------------------------------------------
331 INTEGER NEL,NFT,NXLAY
332 INTEGER IXC(NIXC,*),INOD_CRK(*),IADC_CRK(4,*),IEL_CRK(*),ELCUTC(2,*),
333 . NODEDGE(2,*),XEDGE4N(4,*),ITAB(*)
334 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
335C-----------------------------------------------
336C L o c a l V a r i a b l e s
337C-----------------------------------------------
338 INTEGER I,II,K,KK,NSX,NN,IEL,ILAY,IXEL,ILEV,IL_SEND,COUNT,NOD1,NOD2,
339 . ICUT,ELCRK,IADS,IADR,EN,EN0,EN1,EDGE,BOUNDEDGE
340C=======================================================================
341 DO ilay=1,nxlay
342 ii = nxel*(ilay-1)
343 DO i=1,nel
344 iel = i+nft
345 elcrk = iel_crk(iel)
346 icut = elcutc(1,iel)
347 IF (elcrk > 0 .and. icut > 0) THEN
348c----
349 DO ixel=1,2 ! receiver is IXEL=1 or IXEL=2
350 ilev = ii + ixel
351 DO k=1,4
352 kk = iadc_crk(k,elcrk)
353 en0 = crklvset(ilev)%ENR0(2,kk) ! enr initial de debut du cycle
354 en = crklvset(ilev)%ENR0(1,kk) ! enr mise a jour dans le cycle
355c
356 IF (en0 <= 0 .and. en > 0) THEN
357 nn = ixc(k+1,iel) ! n node sys std
358 nsx = inod_crk(nn) ! n node sys xfem
359 iads = xfem_phantom(ilay)%TAGXP(1,nsx,en) ! IAD sender
360 il_send = xfem_phantom(ilay)%TAGXP(2,nsx,en) ! ILEV sender
361 iadr = xfem_phantom(ilay)%TAGXP(4,nsx,en) ! IAD receiver
362 count = xfem_phantom(ilay)%TAGXP(3,nsx,en)
363c----
364 IF (iads > 0 .and. il_send > 0 .and. count > 0.and.
365 . iadr == kk .and. iads /= kk) THEN
366!!! EN1 = CRKLVSET(IL_SEND)%ENR0(2,IADS)
367 en1 = crklvset(il_send)%ENR0(1,iads)
368 IF (en1 == en) THEN
369 nod1 = 0
370 nod2 = 0
371 edge = xedge4n(k,elcrk) ! global egdge number
372 boundedge = crkedge(ilay)%IBORDEDGE(edge)
373 IF (boundedge == 2) THEN ! Node N is boundary
374 nod1 = nodedge(1,edge)
375 nod2 = nodedge(2,edge)
376 ENDIF
377 IF (nn /= nod1 .and. nn /= nod2) THEN
378 crkavx(ilev)%X(1,kk) = crkavx(il_send)%X(1,iads)
379 crkavx(ilev)%X(2,kk) = crkavx(il_send)%X(2,iads)
380 crkavx(ilev)%X(3,kk) = crkavx(il_send)%X(3,iads)
381 crkavx(ilev)%V(1,kk) = crkavx(il_send)%V(1,iads)
382 crkavx(ilev)%V(2,kk) = crkavx(il_send)%V(2,iads)
383 crkavx(ilev)%V(3,kk) = crkavx(il_send)%V(3,iads)
384 crkavx(ilev)%VR(1,kk) = crkavx(il_send)%VR(1,iads)
385 crkavx(ilev)%VR(2,kk) = crkavx(il_send)%VR(2,iads)
386 crkavx(ilev)%VR(3,kk) = crkavx(il_send)%VR(3,iads)
387 count = count - 1
388 xfem_phantom(ilay)%TAGXP(3,nsx,en) = count
389c
390 IF (xfem_phantom(ilay)%TAGXP(3,nsx,en) == 0) THEN
391 xfem_phantom(ilay)%TAGXP(1,nsx,en) = 0
392 xfem_phantom(ilay)%TAGXP(2,nsx,en) = 0
393 ENDIF
394 ENDIF
395 ENDIF
396 ENDIF
397c----
398 ENDIF
399 ENDDO
400 ENDDO
401c----
402 ENDIF
403 ENDDO
404 ENDDO
405c-----------
406 RETURN

◆ upxvit_t1()

subroutine upxvit_t1 ( integer nel,
integer nft,
integer nxlay,
integer, dimension(2,*) elcutg,
integer, dimension(*) iel_xtg,
integer, dimension(3,*) iadc_xtg )

Definition at line 221 of file crk_vitesse2.F.

223C-----------------------------------------------
224 USE crackxfem_mod
225C-----------------------------------------------
226C I m p l i c i t T y p e s
227C-----------------------------------------------
228#include "implicit_f.inc"
229C-----------------------------------------------
230C C o m m o n B l o c k s
231C-----------------------------------------------
232#include "com_xfem1.inc"
233C-----------------------------------------------
234C D u m m y A r g u m e n t s
235C-----------------------------------------------
236 INTEGER NEL,NFT,NXLAY
237 INTEGER ELCUTG(2,*),IADC_XTG(3,*),IEL_XTG(*)
238C-----------------------------------------------
239C L o c a l V a r i a b l e s
240C-----------------------------------------------
241 INTEGER I,II,K,IG,NG,ILAY,IXEL,ILEV,IL,ICUT,ELEM,ELCRK,ELCRKTG,
242 . IAD,ITRI,EN,EN0,EN1
243C=======================================================================
244 DO ilay=1,nxlay
245 ii = nxel*(ilay-1)
246 DO i=1,nel
247 elem = i+nft
248 elcrktg = iel_xtg(elem)
249 icut = elcutg(1,elem)
250 IF (elcrktg > 0 .and. icut > 0) THEN
251 elcrk = elcrktg + ecrkxfec
252 itri = xfem_phantom(ilay)%ITRI(1,elcrk)
253c----
254 IF (itri < 0) THEN
255 ixel = 2
256 ilev = ii + ixel
257 DO k=1,3
258 iad = iadc_xtg(k,elcrktg)
259 en0 = crklvset(ilev)%ENR0(2,iad) ! enr initial du debut de cycle
260 en = crklvset(ilev)%ENR0(1,iad) ! enr mise a jour dans le cycle
261 IF (en0 < 0 .and. en > 0) THEN
262 il = ilev+1
263 en1 = crklvset(il)%ENR0(2,iad)
264 IF (en1 > 0) THEN
265 crkavx(ilev)%X(1,iad) = crkavx(il)%X(1,iad)
266 crkavx(ilev)%X(2,iad) = crkavx(il)%X(2,iad)
267 crkavx(ilev)%X(3,iad) = crkavx(il)%X(3,iad)
268 crkavx(ilev)%V(1,iad) = crkavx(il)%V(1,iad)
269 crkavx(ilev)%V(2,iad) = crkavx(il)%V(2,iad)
270 crkavx(ilev)%V(3,iad) = crkavx(il)%V(3,iad)
271 crkavx(ilev)%VR(1,iad) = crkavx(il)%VR(1,iad)
272 crkavx(ilev)%VR(2,iad) = crkavx(il)%VR(2,iad)
273 crkavx(ilev)%VR(3,iad) = crkavx(il)%VR(3,iad)
274 ENDIF
275 ENDIF
276 ENDDO
277 ELSEIF (itri > 0) THEN
278 ixel = 1
279 ilev = ii + ixel
280 DO k=1,3
281 iad = iadc_xtg(k,elcrktg)
282 en0 = crklvset(ilev)%ENR0(2,iad) ! enr initial du debut de cycle
283 en = crklvset(ilev)%ENR0(1,iad) ! enr mise a jour dans le cycle
284 IF (en0 < 0 .and. en > 0) THEN
285 il = ilev+2
286 en1 = crklvset(il)%ENR0(2,iad)
287 IF (en1 > 0) THEN
288 crkavx(ilev)%X(1,iad) = crkavx(il)%X(1,iad)
289 crkavx(ilev)%X(2,iad) = crkavx(il)%X(2,iad)
290 crkavx(ilev)%X(3,iad) = crkavx(il)%X(3,iad)
291 crkavx(ilev)%V(1,iad) = crkavx(il)%V(1,iad)
292 crkavx(ilev)%V(2,iad) = crkavx(il)%V(2,iad)
293 crkavx(ilev)%V(3,iad) = crkavx(il)%V(3,iad)
294 crkavx(ilev)%VR(1,iad) = crkavx(il)%VR(1,iad)
295 crkavx(ilev)%VR(2,iad) = crkavx(il)%VR(2,iad)
296 crkavx(ilev)%VR(3,iad) = crkavx(il)%VR(3,iad)
297 ENDIF
298 ENDIF
299 ENDDO
300 END IF
301c----
302 END IF
303 ENDDO
304 ENDDO
305c-----------
306 RETURN

◆ upxvit_t2()

subroutine upxvit_t2 ( integer nel,
integer nft,
integer nxlay,
integer, dimension(nixtg,*) ixtg,
integer, dimension(3,*) xedge3n,
type (xfem_edge_), dimension(*) crkedge,
integer, dimension(2,*) nodedge,
integer, dimension(*) iel_xtg,
integer, dimension(3,*) iadc_xtg,
integer, dimension(*) inod_crk,
integer, dimension(2,*) elcutg,
integer, dimension(*) itab )

Definition at line 416 of file crk_vitesse2.F.

419C-----------------------------------------------
420 USE crackxfem_mod
421C-----------------------------------------------
422C I m p l i c i t T y p e s
423C-----------------------------------------------
424#include "implicit_f.inc"
425C-----------------------------------------------
426C C o m m o n B l o c k s
427C-----------------------------------------------
428#include "com_xfem1.inc"
429C-----------------------------------------------
430C D u m m y A r g u m e n t s
431C-----------------------------------------------
432 INTEGER NEL,NFT,NXLAY
433 INTEGER IXTG(NIXTG,*),INOD_CRK(*),IADC_XTG(3,*),IEL_XTG(*),ELCUTG(2,*),
434 . NODEDGE(2,*),XEDGE3N(3,*),ITAB(*)
435 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
436C-----------------------------------------------
437C L o c a l V a r i a b l e s
438C-----------------------------------------------
439 INTEGER I,II,K,KK,NSX,NN,IEL,ILAY,IXEL,ILEV,IL,COUNT,NOD1,NOD2,
440 . ICUT,ELCRK,ELCRKTG,IADS,IADR,EN,EN0,EN1,EDGE,BOUNDEDGE
441C=======================================================================
442 DO ilay=1,nxlay
443 ii = nxel*(ilay-1)
444 DO i=1,nel
445 iel = i+nft
446 elcrktg = iel_xtg(iel)
447 icut = elcutg(1,iel)
448 IF (elcrktg > 0 .and. icut > 0) THEN
449 elcrk = elcrktg + ecrkxfec
450c----
451 DO ixel=1,2 ! receiver is IXEL=1 or IXEL=2
452 ilev = ii + ixel
453 DO k=1,3
454 kk = iadc_xtg(k,elcrktg)
455 en0 = crklvset(ilev)%ENR0(2,kk) ! enr initial de debut du cycle
456 en = crklvset(ilev)%ENR0(1,kk) ! enr mise a jour dans le cycle
457 IF (en0 <= 0 .and. en > 0) THEN
458 nn = ixtg(k+1,iel) ! n node sys std
459 nsx = inod_crk(nn) ! n node sys xfem
460 iads = xfem_phantom(ilay)%TAGXP(1,nsx,en) ! IAD sender
461 il = xfem_phantom(ilay)%TAGXP(2,nsx,en) ! ILEV sender
462 iadr = xfem_phantom(ilay)%TAGXP(4,nsx,en) ! IAD receiver
463 count = xfem_phantom(ilay)%TAGXP(3,nsx,en)
464c----
465 IF (iads > 0 .and. il > 0 .and. count > 0.and.
466 . iadr == kk .and. iads /= kk) THEN
467c EN1 = CRKLVSET(IL)%ENR0(2,IADS)
468 en1 = crklvset(il)%ENR0(1,iads)
469 IF (en1 == en) THEN
470 nod1 = 0
471 nod2 = 0
472 edge = xedge3n(k,elcrktg) ! global egdge N
473 boundedge = crkedge(ilay)%IBORDEDGE(edge)
474 IF (boundedge == 2) THEN ! Node N is boundary
475 nod1 = nodedge(1,edge)
476 nod2 = nodedge(2,edge)
477 ENDIF
478 IF (nn /= nod1 .and. nn /= nod2) THEN
479 crkavx(ilev)%X(1,kk) = crkavx(il)%X(1,iads)
480 crkavx(ilev)%X(2,kk) = crkavx(il)%X(2,iads)
481 crkavx(ilev)%X(3,kk) = crkavx(il)%X(3,iads)
482 crkavx(ilev)%V(1,kk) = crkavx(il)%V(1,iads)
483 crkavx(ilev)%V(2,kk) = crkavx(il)%V(2,iads)
484 crkavx(ilev)%V(3,kk) = crkavx(il)%V(3,iads)
485 crkavx(ilev)%VR(1,kk) = crkavx(il)%VR(1,iads)
486 crkavx(ilev)%VR(2,kk) = crkavx(il)%VR(2,iads)
487 crkavx(ilev)%VR(3,kk) = crkavx(il)%VR(3,iads)
488 count = count - 1
489 xfem_phantom(ilay)%TAGXP(3,nsx,en) = count
490 IF (xfem_phantom(ilay)%TAGXP(3,nsx,en) == 0) THEN
491 xfem_phantom(ilay)%TAGXP(1,nsx,en) = 0
492 xfem_phantom(ilay)%TAGXP(2,nsx,en) = 0
493 ENDIF
494 ENDIF
495 ENDIF
496 ENDIF
497c----
498 ENDIF
499 ENDDO
500 ENDDO
501c----
502 ENDIF
503 ENDDO
504 ENDDO
505c-----------
506 RETURN