OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
crklen4n_adv.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine crklen4n_adv (nel, nft, ilay, nlay, ixc, crklen, elcrkini, iel_crk, dir1, dir2, nodedge, crkedge, xedge4n, ngl, xl2, xl3, xl4, yl2, yl3, yl4, aldt)

Function/Subroutine Documentation

◆ crklen4n_adv()

subroutine crklen4n_adv ( integer nel,
integer nft,
integer ilay,
integer nlay,
integer, dimension(nixc,*) ixc,
crklen,
integer, dimension(nlay,nel) elcrkini,
integer, dimension(*) iel_crk,
dir1,
dir2,
integer, dimension(2,*) nodedge,
type (xfem_edge_), dimension(*) crkedge,
integer, dimension(4,*) xedge4n,
integer, dimension(nel) ngl,
xl2,
xl3,
xl4,
yl2,
yl3,
yl4,
aldt )

Definition at line 33 of file crklen4n_adv.F.

39C-----------------------------------------------
40C crack advancement, shells 4N
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE crackxfem_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "units_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER NEL,NFT,ILAY,NLAY
57 INTEGER IXC(NIXC,*),NGL(NEL),IEL_CRK(*),ELCRKINI(NLAY,NEL),
58 . NODEDGE(2,*),XEDGE4N(4,*)
59 my_real dir1(nlay,nel),dir2(nlay,nel),crklen(nel),aldt(nel),
60 . xl2(nel),yl2(nel),xl3(nel),yl3(nel),xl4(nel),yl4(nel)
61 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER I,J,K,R,IR,P1,P2,NEWCRK,IED,OK,ELCRK,NX1,NX2,NX3,NX4,NM,NP,
66 . FAC,IFI1,IFI2,IEDGE,ICUT,SIGBETA,ICRK,IELCRK,NOD1,NOD2
67c
68 INTEGER JCT(NEL),EDGEL(4,NEL),TIP(NEL),ECUT(2,NEL),dd(4),d(8),KPERM(8)
69c
70 my_real
71 . xin(2,nel),yin(2,nel),len(4,nel),xmi(2),ymi(2),
72 . xxl(4,nel),yyl(4,nel),beta0(4,nel)
73 my_real
74 . xint,yint,zint,fi,xxx,yyy,zzz,cross,acd,bcd,dlx,dly,
75 . x10,y10,z10,x20,y20,z20,d12,m12,mm,xint0,yint0,dir11,dir22,
76 . x1,y1,x2,y2,x3,y3,x4,y4,beta,bmin,bmax
77C----------
78 DATA d/1,2,2,3,4,3,1,4/
79 DATA dd/2,3,4,1/
80 DATA kperm/1,2,3,4,1,2,3,4/
81 parameter(bmin = 0.01, bmax = 0.99)
82C=======================================================================
83 newcrk = 0
84 DO i=1,nel
85 jct(i) = 0
86 IF (elcrkini(ilay,i) == 5) THEN ! avancement de fissure
87 newcrk = newcrk + 1
88 jct(newcrk) = i
89 elcrkini(ilay,i) = 2 ! reset pour l avancement
90 ELSEIF (elcrkini(ilay,i) == -5) THEN ! initialisation de fissure
91 crklen(i) = aldt(i)
92 elcrkini(ilay,i) = 0 ! reset pour initialisation
93 ENDIF
94 ENDDO
95 IF (newcrk == 0) RETURN
96C---
97 DO ir=1,newcrk
98 i = jct(ir)
99 tip(i) = 0
100 ecut(1:2,i) = 0
101 edgel(1:4,i) = 0
102 beta0(1:4,i) = zero
103 xin(1,i) = zero ! first inters point in local skew
104 yin(1,i) = zero
105 xin(2,i) = zero ! second inters point in local skew
106 yin(2,i) = zero
107c
108 xxl(1,i) = zero
109 yyl(1,i) = zero
110 xxl(2,i) = xl2(i)
111 yyl(2,i) = yl2(i)
112 xxl(3,i) = xl3(i)
113 yyl(3,i) = yl3(i)
114 xxl(4,i) = xl4(i)
115 yyl(4,i) = yl4(i)
116c
117 len(1,i) = xl2(i)*xl2(i) + yl2(i)*yl2(i)
118 len(2,i) = (xl3(i)-xl2(i))*(xl3(i)-xl2(i))+
119 . (yl3(i)-yl2(i))*(yl3(i)-yl2(i))
120 len(3,i) = (xl4(i)-xl3(i))*(xl4(i)-xl3(i))+
121 . (yl4(i)-yl3(i))*(yl4(i)-yl3(i))
122 len(4,i) = xl4(i)*xl4(i) + yl4(i)*yl4(i)
123 ENDDO
124C------------------------------------------------
125c First intersection (already cut edge)
126C------------------------------------------------
127 DO ir=1,newcrk ! loop over elems (layers) with advancing cracks
128 i = jct(ir)
129 elcrk = iel_crk(i+nft) ! N element sys xfem
130 ok = 0
131 icut = 0
132 ied = 0
133 DO k=1,4 ! edges
134 iedge = xedge4n(k,elcrk)
135 IF (iedge > 0) THEN
136 icut = crkedge(ilay)%ICUTEDGE(iedge)
137 IF (icut == 1) THEN
138 nod1 = nodedge(1,iedge) ! noeud std
139 nod2 = nodedge(2,iedge)
140 IF (nod1 == ixc(k+1,i) .and. nod2 == ixc(dd(k)+1,i)) THEN
141 p1 = k
142 p2 = dd(k)
143 ELSE IF (nod2 == ixc(k+1,i) .and. nod1 == ixc(dd(k)+1,i)) THEN
144 p1 = dd(k)
145 p2 = k
146 ENDIF
147 ok = 1
148 ied = k
149 ecut(1,i)= k
150 EXIT
151 ENDIF ! IF (ICUT == 1) THEN
152 ENDIF
153 ENDDO ! DO K=1,4
154C---
155 IF (ok == 1) THEN ! edge found
156 beta = crkedge(ilay)%RATIO(iedge)
157 xin(1,i) = xxl(p1,i) + beta*(xxl(p2,i) - xxl(p1,i))
158 yin(1,i) = yyl(p1,i) + beta*(yyl(p2,i) - yyl(p1,i))
159c
160 edgel(ied,i) = 1 ! local : premier edge coupe
161 iedge = xedge4n(ied,elcrk) ! N edge element sys xfem
162 tip(i) = crkedge(ilay)%EDGETIP(1,iedge) ! 1 ou 2 , debut ou fin de fissure
163 ELSE
164 WRITE(iout,*) 'ERROR IN ADVANCING CRACK --- CHECK CRACK TIP'
165 CALL arret(2)
166 ENDIF
167C---
168 END DO ! DO IR=1,NEWCRK
169C--------------------------------------------------
170c Search for second intersection (new cut edge)
171C--------------------------------------------------
172 DO ir=1,newcrk
173 i = jct(ir)
174 elcrk = iel_crk(i+nft)
175 r = ecut(1,i)
176 xint0 = xin(1,i)
177 yint0 = yin(1,i)
178 dir11 =-dir2(ilay,i)
179 dir22 = dir1(ilay,i)
180C---
181 IF (dir11 == zero) THEN
182 DO k=1,3
183 r = kperm(ecut(1,i) + k)
184 iedge = xedge4n(r,elcrk)
185 nod1 = nodedge(1,iedge)
186 nod2 = nodedge(2,iedge)
187 IF (nod1 == ixc(r+1,i) .and. nod2 == ixc(dd(r)+1,i))THEN
188 p1 = r
189 p2 = dd(r)
190 ELSE IF (nod2 == ixc(r+1,i).and.nod1 == ixc(dd(r)+1,i))THEN
191 p1 = dd(r)
192 p2 = r
193 ENDIF
194 dlx = xxl(p2,i) - xxl(p1,i)
195 IF (dlx /= zero) THEN
196 dly = yyl(p2,i) - yyl(p1,i)
197 m12 = dly / dlx
198 xint = xint0
199 yint = yyl(p1,i) + m12*(xint-xxl(p1,i))
200 IF ((xint-xxl(p1,i))*(xint-xxl(p2,i)) <= zero .and.
201 . (yint-yyl(p1,i))*(yint-yyl(p2,i)) <= zero) THEN
202 cross = (xxl(p1,i) - xint)**2 + (yyl(p1,i) - yint)**2
203 beta = sqrt(cross / len(r,i))
204 IF (beta > bmax .OR. beta < bmin) THEN
205 beta = max(beta, bmin)
206 beta = min(beta, bmax)
207 yint = yyl(p1,i) + beta*(yyl(p2,i)-yyl(p1,i))
208 ENDIF
209C
210 ecut(2,i) = r
211 xin(2,i) = xint
212 yin(2,i) = yint
213 edgel(r,i) = 2
214 beta0(r,i) = beta
215 EXIT
216 ENDIF
217 ENDIF
218 ENDDO
219c
220 ELSEIF (dir22 == zero) THEN
221 DO k=1,3
222 r = kperm(ecut(1,i) + k)
223 iedge = xedge4n(r,elcrk)
224 nod1 = nodedge(1,iedge)
225 nod2 = nodedge(2,iedge)
226 IF (nod1 == ixc(r+1,i) .and. nod2 == ixc(dd(r)+1,i)) THEN
227 p1 = r
228 p2 = dd(r)
229 ELSE IF (nod2 == ixc(r+1,i).and.nod1 == ixc(dd(r)+1,i)) THEN
230 p1 = dd(r)
231 p2 = r
232 ENDIF
233 dly = yyl(p2,i) - yyl(p1,i)
234 IF (dly /= zero) THEN
235 dlx = xxl(p2,i) - xxl(p1,i)
236 m12 = dlx / dly
237 yint = yint0
238 xint = xxl(p1,i) + m12*(yint-yyl(p1,i))
239 IF ((xint-xxl(p1,i))*(xint-xxl(p2,i)) <= zero .and.
240 . (yint-yyl(p1,i))*(yint-yyl(p2,i)) <= zero) THEN
241 cross = (xxl(p1,i) - xint)**2 + (yyl(p1,i) - yint)**2
242 beta = sqrt(cross / len(r,i))
243 IF (beta > bmax .OR. beta < bmin) THEN
244 beta = max(beta, bmin)
245 beta = min(beta, bmax)
246 xint = xxl(p1,i) + beta*(xxl(p2,i)-xxl(p1,i))
247 ENDIF
248C
249 ecut(2,i) = r
250 xin(2,i) = xint
251 yin(2,i) = yint
252 edgel(r,i) = 2
253 beta0(r,i) = beta
254 EXIT
255 ENDIF
256 ENDIF
257 ENDDO
258c
259 ELSEIF (dir11 /= zero .and. dir22 /= zero) THEN
260 DO k=1,3
261 r = kperm(ecut(1,i) + k)
262 iedge = xedge4n(r,elcrk)
263 nod1 = nodedge(1,iedge)
264 nod2 = nodedge(2,iedge)
265 IF (nod1 == ixc(r+1,i) .and. nod2 == ixc(dd(r)+1,i)) THEN
266 p1 = r
267 p2 = dd(r)
268 ELSE IF (nod2 == ixc(r+1,i).and.nod1 == ixc(dd(r)+1,i)) THEN
269 p1 = dd(r)
270 p2 = r
271 ENDIF
272C
273 dlx = xxl(p2,i) - xxl(p1,i)
274 dly = yyl(p2,i) - yyl(p1,i)
275 mm = dir22/dir11
276 IF (dlx == zero) THEN
277 xint = xxl(p1,i)
278 yint = yint0 + mm*(xint-xint0)
279 IF ((yint-yyl(p1,i))*(yint-yyl(p2,i)) <= zero) THEN
280 cross = (yyl(p1,i) - yint)**2
281 beta = sqrt(cross / len(r,i))
282 IF (beta > bmax .OR. beta < bmin) THEN
283 beta = max(beta, bmin)
284 beta = min(beta, bmax)
285 yint = yyl(p1,i) + beta*(yyl(p2,i)-yyl(p1,i))
286 ENDIF
287 ecut(2,i) = r
288 xin(2,i) = xint
289 yin(2,i) = yint
290 edgel(r,i) = 2
291 beta0(r,i) = beta
292 EXIT
293 ENDIF
294 ELSEIF (dly == zero) THEN
295 yint = yyl(p1,i)
296 xint = xint0 + (yint0-yyl(p1,i)) / mm
297 IF ((xint-xxl(p1,i))*(xint-xxl(p2,i)) <= zero) THEN
298 cross = (xxl(p1,i) - xint)**2
299 beta = sqrt(cross / len(r,i))
300 IF (beta > bmax .OR. beta < bmin) THEN
301 beta = max(beta, bmin)
302 beta = min(beta, bmax)
303 xint = xxl(p1,i) + beta*(xxl(p2,i)-xxl(p1,i))
304 ENDIF
305 ecut(2,i) = r
306 xin(2,i) = xint
307 yin(2,i) = yint
308 edgel(r,i) = 2
309 beta0(r,i) = beta
310 EXIT
311 ENDIF
312 ELSE
313 m12 = dly / dlx
314 IF (mm /= m12) THEN
315 xint = (yint0-yyl(p1,i) + m12*xxl(p1,i) - mm*xint0)/(m12-mm)
316 yint = yint0 + mm*(xint-xint0)
317 acd = (yint-yyl(p1,i))*(xint0 - xxl(p1,i))
318 . - (xint-xxl(p1,i))*(yint0 - yyl(p1,i))
319 bcd = (yint-yyl(p2,i))*(xint0 - xxl(p2,i))
320 . - (xint-xxl(p2,i))*(yint0 - yyl(p2,i))
321 IF (acd*bcd <= zero) THEN
322 cross = (xxl(p1,i) - xint)**2 + (yyl(p1,i) - yint)**2
323 beta = sqrt(cross / len(r,i))
324 IF (beta > bmax .OR. beta < bmin) THEN
325 beta = max(beta, bmin)
326 beta = min(beta, bmax)
327 xint = xxl(p1,i) + beta*(xxl(p2,i)-xxl(p1,i))
328 yint = yyl(p1,i) + beta*(yyl(p2,i)-yyl(p1,i))
329 ENDIF
330 ecut(2,i) = r
331 xin(2,i) = xint
332 yin(2,i) = yint
333 edgel(r,i) = 2
334 beta0(r,i) = beta
335 EXIT
336 ENDIF
337 ENDIF
338 ENDIF
339 ENDDO
340 ENDIF
341 ENDDO
342C-----------------------------------------------------------------------
343C check for getting both intersections
344C-----------------------------------------------------------------------
345 DO ir=1,newcrk
346 i = jct(ir)
347 fac = 0
348 DO r=1,4
349 IF (edgel(r,i)==1 .or. edgel(r,i)==2) fac=fac+1
350 ENDDO
351 IF (fac /= 2) THEN
352 WRITE(iout,*) 'ERROR IN ADVANCING CRACK. NO CUT EDGES'
353 CALL arret(2)
354 ENDIF
355 crklen(i) = sqrt((xin(2,i) - xin(1,i))**2 + (yin(2,i) - yin(1,i))**2)
356 ENDDO
357c-----------
358 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
crackxfem_mod
Definition crackxfem_mod.F:121
arret
subroutine arret(nn)
Definition arret.F:87