OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
crklen4n_adv.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!|| crklen4n_adv ../engine/source/elements/xfem/crklen4n_adv.F
25!||--- called by ------------------------------------------------------
26!|| cforc3 ../engine/source/elements/shell/coque/cforc3.f
27!|| czforc3 ../engine/source/elements/shell/coquez/czforc3.F
28!||--- calls -----------------------------------------------------
29!|| arret ../engine/source/system/arret.F
30!||--- uses -----------------------------------------------------
31!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
32!||====================================================================
33 SUBROUTINE crklen4n_adv(
34 . NEL ,NFT ,ILAY ,NLAY ,IXC ,
35 . CRKLEN ,ELCRKINI ,IEL_CRK ,DIR1 ,DIR2 ,
36 . NODEDGE ,CRKEDGE ,XEDGE4N ,NGL ,XL2 ,
37 . XL3 ,XL4 ,YL2 ,YL3 ,YL4 ,
38 . ALDT )
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
359 END
cforc3
subroutine cforc3(timers, elbuf_str, jft, jlt, pm, ixc, x, f, m, v, vr, failwave, nvc, mtn, geo, tf, npf, bufmat, partsav, dt2t, neltst, ityptst, stifn, stifr, fsky, iadc, itab, d, dr, tani, offset, eani, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, m34, indxof, ipartc, thke, group_param, mat_elem, nel, istrain, ihbe, ithk, iofc, ipla, nft, ismstr, npt, kfts, fzero, igeo, ipm, ifailure, itask, jthe, temp, fthe, fthesky, iexpan, gresav, grth, xedge4n, igrth, msc, dmelc, jsms, table, iparg, ixfem, knod2elc, sensors, elcutc, inod_crk, iel_crk, ibordnode, nodenr, iadc_crk, nodedge, crknodiad, condn, condnsky, stack, isubstack, xfem_str, crkedge, drape_sh4n, ipri, nloc_dmg, indx_drape, igre, jtur, output, dt, snpc, stf, glob_therm, userl_avail, maxfunc, sbufmat)
Definition cforc3.F:112
crklen4n_adv
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)
Definition crklen4n_adv.F:39
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