OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
crk_velocity2.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_velocity2 (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_velocity2()

subroutine crk_velocity2 ( 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 36 of file crk_velocity2.F.

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

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

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

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

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