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

Go to the source code of this file.

Functions/Subroutines

subroutine upenric2_n4 (iparg, ixc, nft, jft, jlt, elcutc, iadc_crk, iel_crk, inod_crk, enrtag, nxlay, crkedge, xedge4n)

Function/Subroutine Documentation

◆ upenric2_n4()

subroutine upenric2_n4 ( integer, dimension(nparg,*) iparg,
integer, dimension(nixc,*) ixc,
integer nft,
integer jft,
integer jlt,
integer, dimension(2,*) elcutc,
integer, dimension(4,*) iadc_crk,
integer, dimension(*) iel_crk,
integer, dimension(*) inod_crk,
integer, dimension(numnod,*) enrtag,
integer nxlay,
type (xfem_edge_), dimension(*) crkedge,
integer, dimension(4,*) xedge4n )

Definition at line 30 of file upenric2_n4.F.

33C-----------------------------------------------
34 USE crackxfem_mod
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C G l o b a l P a r a m e t e r s
41C-----------------------------------------------
42#include "mvsiz_p.inc"
43#include "param_c.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "com04_c.inc"
48#include "com_xfem1.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER NFT,JFT,JLT,NXLAY
53 INTEGER IPARG(NPARG,*),IXC(NIXC,*),ELCUTC(2,*),INOD_CRK(*),
54 . IADC_CRK(4,*),IEL_CRK(*),ENRTAG(NUMNOD,*),XEDGE4N(4,*)
55 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER I,K,IR,IAD,NELCRK,ELCRK,ILEV,ILAY,IXEL,ELCUT,LAYCUT,
60 . IECUT,ENR,IBOUNDEDGE,IED,EDGE,FAC,COUNT,ITIP,ITRI,NUMXEL,NSX
61 INTEGER JCT(MVSIZ),NTAG(4),D(4),NS(4),IADC(4)
62 DATA d/2,3,4,1/
63C=======================================================================
64 nelcrk = 0
65 DO i=jft,jlt
66 jct(i) = 0
67 IF (elcutc(1,i+nft) /= 0) THEN
68 nelcrk = nelcrk + 1
69 jct(nelcrk) = i
70 ENDIF
71 ENDDO
72 IF (nelcrk == 0) RETURN
73c--------------------
74 DO ilay=1,nxlay
75 DO ir=1,nelcrk
76 i = jct(ir)
77 elcrk = iel_crk(i+nft)
78 elcut = xfem_phantom(ilay)%ELCUT(elcrk)
79 IF (elcut /= 0) THEN
80 itri = xfem_phantom(ilay)%ITRI(1,elcrk)
81 laycut = crkedge(ilay)%LAYCUT(elcrk)
82 ns(1) = ixc(2,i+nft)
83 ns(2) = ixc(3,i+nft)
84 ns(3) = ixc(4,i+nft)
85 ns(4) = ixc(5,i+nft)
86 iadc(1) = iadc_crk(1,elcrk)
87 iadc(2) = iadc_crk(2,elcrk)
88 iadc(3) = iadc_crk(3,elcrk)
89 iadc(4) = iadc_crk(4,elcrk)
90 IF (itri == 0) THEN
91 numxel = 2
92 ELSE
93 numxel = nxel
94 ENDIF
95c
96 DO ixel=1,numxel
97 ilev = nxel*(ilay-1) + ixel
98 fac = 0
99 ntag(1:4)= 0
100c---------------------------------------
101 IF (abs(laycut) == 1) THEN
102c new advancing (or init) crack => LAYCUT = +/- 1
103c---------------------------------------
104 DO k=1,4
105 ied = crkedge(ilay)%IEDGEC(k,elcrk) ! = 1,2 => sequence des arretes coupes
106 edge = xedge4n(k,elcrk) ! global egdge N
107 iecut = crkedge(ilay)%ICUTEDGE(edge)
108c Tip edges => NTAG = 2
109 IF (ied > 0 .and. iecut == 2) THEN ! (cas IECUT=3 traite avant)
110 ntag(k) = 2
111 ntag(d(k)) = 2
112 fac = fac + 1
113 ENDIF
114 ENDDO
115c crack touches boundary or goes through a hole due to erased element
116c touching boundary => (IBOUNDEDGE == 1)
117c going through a hole => (IBOUNDEDGE == 2)
118 DO k=1,4
119 ied = crkedge(ilay)%IEDGEC(k,elcrk)
120 edge = xedge4n(k,elcrk)
121 iboundedge = crkedge(ilay)%IBORDEDGE(edge)
122c Tag boundary edges : NTAG=1
123 IF ( ied > 0 .and. iboundedge > 0) THEN
124 ntag(k) = 1
125 ntag(d(k)) = 1
126 fac = fac + 1
127 ENDIF
128 ENDDO
129c
130 DO k=1,4
131 ied = crkedge(ilay)%IEDGEC(k,elcrk)
132 edge = xedge4n(k,elcrk)
133 itip = crkedge(ilay)%EDGETIP(2,edge)
134 IF (ied > 0 .and. itip == 1) THEN
135 IF (itri /= 0 .and. ixel == 3) THEN
136 ntag(k) = 1
137 ntag(d(k)) = 1
138 fac = fac + 1
139 ENDIF
140 ENDIF
141 ENDDO
142c NTAG = 1 for all except internal tip nodes
143 IF (fac > 0) THEN
144 DO k=1,4
145 IF (ntag(k) /= 2) ntag(k) = 1
146 ENDDO
147 ENDIF
148c---------------------------------------
149 ELSE IF (laycut == 2) THEN
150c old crack, element already cut previously
151c---------------------------------------
152 DO k=1,4
153 ied = crkedge(ilay)%IEDGEC(k,elcrk)
154 edge = xedge4n(k,elcrk)
155 iboundedge = crkedge(ilay)%IBORDEDGE(edge)
156 IF (ied > 0 .and. iboundedge == 2) THEN
157 ntag(k) = 1
158 ntag(d(k)) = 1
159 fac = fac + 1
160 ENDIF
161 END DO
162c
163c check if no tip edge in phantom element (count=0 => no tip)
164c
165 count = 0
166 DO k=1,4
167 ied = crkedge(ilay)%IEDGEC(k,elcrk)
168 edge = xedge4n(k,elcrk)
169 itip = crkedge(ilay)%EDGETIP(2,edge)
170 IF (ied > 0 .and. itip == 1) count = count + 1
171 END DO
172c
173 IF (count == 0) THEN ! already cracked phantom, no tip edge => no negative enrichments
174 DO k=1,4
175 iad = iadc(k)
176 IF (itri < 0 .and. ixel == 2 .and. crklvset(ilev)%ENR0(1,iad) < 0) THEN
177c enrichment of IXEL = 2 < 0 => copy from IXEL = 3 and tag edge
178 crklvset(ilev)%ENR0(1,iad) = crklvset(ilev+1)%ENR0(1,iad)
179 fac = fac + 1
180 ntag(k) = 1
181 ntag(d(k)) = 1
182 ELSEIF (itri > 0 .and. ixel == 1 .and. crklvset(ilev)%ENR0(1,iad) < 0) THEN
183c enrichment of IXEL = 1 < 0 => copy from IXEL = 3 and tag edge
184 crklvset(ilev)%ENR0(1,iad) = crklvset(ilev+2)%ENR0(1,iad)
185 fac = fac + 1
186 ntag(k) = 1
187 ntag(d(k)) = 1
188 ENDIF
189 END DO
190 ENDIF ! COUNT == 0
191c
192 ENDIF ! LAYCUT
193C--------------------------------------------------------------------------
194c set ENRTAG for nodal enrichment update (ENR > 0 only for boundary nodes)
195C--------------------------------------------------------------------------
196 IF (fac > 0) THEN
197 DO k=1,4
198 enr = abs(crklvset(ilev)%ENR0(1,iadc(k)))
199 IF (enr > 0 .and. ntag(k) == 1) THEN
200 IF (enrtag(ns(k),enr) == 0) enrtag(ns(k),enr) = enr
201 ENDIF
202 ENDDO
203 ENDIF
204C--------------------------------------------------------------------------
205 ENDDO ! DO IXEL=1,NXEL
206 ENDIF ! IF(ELCUT /= 0)THEN
207 ENDDO ! DO IR=1,NELCRK
208 ENDDO ! DO ILAY=1,NXLAY
209C-----------------------------------------------
210 RETURN
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::crklvset
type(xfem_lvset_), dimension(:), allocatable crklvset
Definition crackxfem_mod.F:146