OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
crklayer4n_ini.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!|| crklayer4n_ini ../engine/source/elements/xfem/crklayer4n_ini.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!|| lsint4 ../engine/source/elements/xfem/crklayer4n_adv.F
31!||--- uses -----------------------------------------------------
32!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.f
33!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
34!|| element_mod ../common_source/modules/elements/element_mod.F90
35!||====================================================================
36 SUBROUTINE crklayer4n_ini(
37 . XFEM_STR ,NEL ,NFT ,IXC ,ELCUTC ,
38 . ILAY ,NLAY ,IEL_CRK ,INOD_CRK ,
39 . IADC_CRK ,NODENR ,ELCRKINI ,DIR1 ,DIR2 ,
40 . NODEDGE ,CRKNODIAD,KNOD2ELC ,CRKEDGE ,A_I ,
41 . XL2 ,XL3 ,XL4 ,YL2 ,YL3 ,
42 . YL4 ,XEDGE4N ,NGL )
43C-----------------------------------------------
44C crack initialisation, shells 4N
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE elbufdef_mod
49 USE crackxfem_mod
50 use element_mod , only : nixc
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "units_c.inc"
59#include "com04_c.inc"
60#include "com_xfem1.inc"
61#include "comlock.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER NEL,NFT,ILAY,IXC(NIXC,*),NLAY,NGL(NEL),IEL_CRK(*),
66 . INOD_CRK(*),NODENR(*),IADC_CRK(4,*),ELCRKINI(NLAY,NEL),
67 . ELCUTC(2,*),NODEDGE(2,*),CRKNODIAD(*),KNOD2ELC(*),XEDGE4N(4,*)
68C
69 my_real, DIMENSION(NLAY,NEL) :: DIR1,DIR2
70 my_real, DIMENSION(NEL) :: A_I
71 TYPE (ELBUF_STRUCT_), DIMENSION(NXEL), TARGET :: XFEM_STR
72 TYPE (XFEM_EDGE_) , DIMENSION(NXLAYMAX) :: CRKEDGE
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER I,J,K,R,II,IR,P1,P2,PP1,PP2,PP3,NEWCRK,FAC,
77 . iedge,icut,ied,icrk,elcrk,nod1,nod2,ie1,ie2,itri,
78 . ifi1,ifi2,ie10,ie20,np,nx1,nx2,nx3,nx4
79 INTEGER N(4),NN(4),dd(4),d(8),DX(8),
80 . ISIGN(4),IENR0(4),IENR(4),ECUT(2,NEL),
81 . IADC(4),JCT(NEL),EDGEL(4,NEL),KPERM(8)
82C
83 my_real
84 . xm(nel),ym(nel),xl2(nel),yl2(nel),xl3(nel),yl3(nel),
85 . xl4(nel),yl4(nel),xin(2,nel),yin(2,nel),xmi(2),ymi(2),
86 . fit(4,nel),xxl(4,nel),yyl(4,nel),len(4,nel),beta0(4,nel)
87C
88 my_real
89 . xint,yint,fi,m12,mm,cross,acd,bcd,dlx,dly,
90 . xint0,yint0,dir11,dir22,beta,bmin,bmax,
91 . x1,y1,x2,y2,x3,y3,x4,y4,area1,area2
92c---
93 DATA d/1,2,2,3,4,3,1,4/
94 DATA dd/2,3,4,1/
95 DATA dx/1,2,3,4,1,2,3,4/
96 DATA kperm/1,2,3,4,1,2,3,4/
97 parameter(bmin = 0.01, bmax = 0.99)
98C=======================================================================
99 newcrk = 0
100 DO i=1,nel
101 jct(i) = 0
102 IF (elcrkini(ilay,i) == -1) THEN ! crack initialization
103 newcrk = newcrk + 1
104 jct(newcrk) = i
105 ENDIF
106 ENDDO
107 IF (newcrk == 0) RETURN
108c------------------
109 ii = nxel*(ilay-1)
110 pp1 = ii + 1
111 pp2 = ii + 2
112 pp3 = ii + 3
113c------------------
114 DO ir=1,newcrk
115 i = jct(ir)
116 edgel(1:4,i) = 0
117 ecut(1:2,i) = 0
118 beta0(1:4,i) = zero
119 xin(1,i)=zero ! first inters point in local skew
120 yin(1,i)=zero
121 xin(2,i)=zero ! second inters point in local skew
122 yin(2,i)=zero
123c
124 xxl(1,i) = zero
125 yyl(1,i) = zero
126 xxl(2,i) = xl2(i)
127 yyl(2,i) = yl2(i)
128 xxl(3,i) = xl3(i)
129 yyl(3,i) = yl3(i)
130 xxl(4,i) = xl4(i)
131 yyl(4,i) = yl4(i)
132 xm(i) = fourth*(xl2(i)+xl3(i)+xl4(i))
133 ym(i) = fourth*(yl2(i)+yl3(i)+yl4(i))
134c
135 len(1,i) = xl2(i)*xl2(i) + yl2(i)*yl2(i)
136 len(2,i) = (xl3(i)-xl2(i))*(xl3(i)-xl2(i))+
137 . (yl3(i)-yl2(i))*(yl3(i)-yl2(i))
138 len(3,i) = (xl4(i)-xl3(i))*(xl4(i)-xl3(i))+
139 . (yl4(i)-yl3(i))*(yl4(i)-yl3(i))
140 len(4,i) = xl4(i)*xl4(i) + yl4(i)*yl4(i)
141 END DO
142C------------------------------------------------
143c search for first intersected edge
144C------------------------------------------------
145 DO ir=1,newcrk
146 i = jct(ir)
147 elcrk = iel_crk(i+nft)
148C---
149 dir11 = -dir2(ilay,i)
150 dir22 = dir1(ilay,i)
151 fac = 0
152C---
153 DO k=1,4
154 iedge = xedge4n(k,elcrk)
155 nod1 = nodedge(1,iedge)
156 nod2 = nodedge(2,iedge)
157 IF (nod1 == ixc(k+1,i) .and. nod2 == ixc(dd(k)+1,i)) THEN
158 p1 = k
159 p2 = dd(k)
160 ELSEIF (nod2 == ixc(k+1,i).and.nod1 == ixc(dd(k)+1,i)) THEN
161 p1 = dd(k)
162 p2 = k
163 ENDIF
164c
165 IF (dir11 == zero) THEN
166 dlx = xxl(p2,i) - xxl(p1,i)
167 IF (dlx /= zero) THEN
168 dly = yyl(p2,i) - yyl(p1,i)
169 m12 = dly / dlx
170 xint = xm(i)
171 yint = yyl(p1,i) + m12*(xint-xxl(p1,i))
172 IF ((xint-xxl(p1,i))*(xint-xxl(p2,i)) <= zero .and.
173 . (yint-yyl(p1,i))*(yint-yyl(p2,i)) <= zero) THEN
174 fac = 1
175 EXIT
176 ENDIF
177 ENDIF
178c
179 ELSEIF (dir22 == zero) THEN
180 dly = yyl(p2,i) - yyl(p1,i)
181 IF (dly /= zero) THEN
182 dlx = xxl(p2,i) - xxl(p1,i)
183 m12 = dlx / dly
184 yint = ym(i)
185 xint = xxl(p1,i) + m12*(yint-yyl(p1,i))
186 IF ((xint-xxl(p1,i))*(xint-xxl(p2,i)) <= zero .and.
187 . (yint-yyl(p1,i))*(yint-yyl(p2,i)) <= zero) THEN
188 fac = 1
189 EXIT
190 ENDIF
191 ENDIF
192c
193 ELSEIF (dir11 /= zero .AND. dir22 /= zero) THEN
194 dlx = xxl(p2,i) - xxl(p1,i)
195 dly = yyl(p2,i) - yyl(p1,i)
196 mm = dir22/dir11
197 IF (dlx == zero) THEN
198 xint = xxl(p1,i)
199 yint = ym(i) + mm*(xint-xm(i))
200 IF ((yint-yyl(p1,i))*(yint-yyl(p2,i)) <= zero) THEN
201 fac = 1
202 ENDIF
203 ELSEIF (dly == zero) THEN
204 yint = yyl(p1,i)
205 xint = xm(i) + (ym(i)-yyl(p1,i)) / mm
206 IF ((xint-xxl(p1,i))*(xint-xxl(p2,i)) <= zero) THEN
207 fac = fac + 1
208 EXIT
209 ENDIF
210 ELSE
211 m12 = dly / dlx
212 IF (mm /= m12) THEN
213 xint = (ym(i)-yyl(p1,i) + m12*xxl(p1,i) - mm*xm(i))/(m12-mm)
214 yint = ym(i) + mm*(xint-xm(i))
215 acd = (yint-yyl(p1,i))*(xm(i) - xxl(p1,i))
216 . - (xint-xxl(p1,i))*(ym(i) - yyl(p1,i))
217 bcd = (yint-yyl(p2,i))*(xm(i) - xxl(p2,i))
218 . - (xint-xxl(p2,i))*(ym(i) - yyl(p2,i))
219 IF (acd*bcd <= em3) THEN
220 fac = 1
221 EXIT
222 ENDIF
223 ENDIF
224 ENDIF
225 ENDIF
226c
227 ENDDO ! K=1,4
228c
229 IF (fac == 1) THEN
230 cross = (xxl(p1,i) - xint)**2 + (yyl(p1,i) - yint)**2
231 beta = sqrt(cross / len(k,i))
232 IF (beta > bmax .OR. beta < bmin) THEN
233 beta = max(beta, bmin)
234 beta = min(beta, bmax)
235 xint = xxl(p1,i) + beta*(xxl(p2,i)-xxl(p1,i))
236 yint = yyl(p1,i) + beta*(yyl(p2,i)-yyl(p1,i))
237 ENDIF
238C---
239 ecut(fac,i)= k
240 xin(fac,i) = xint
241 yin(fac,i) = yint
242 edgel(k,i) = fac
243 beta0(k,i) = beta
244 ELSE
245 WRITE(iout,*) 'ERROR IN ADVANCING CRACK --- CHECK CRACK TIP'
246 CALL arret(2)
247 ENDIF
248c
249 ENDDO ! IR=1,NEWCRK
250C--------------------------------------------------
251c Search for second intersection (new cut edge)
252C--------------------------------------------------
253 DO ir=1,newcrk
254 i = jct(ir)
255 elcrk = iel_crk(i+nft)
256 xint0 = xin(1,i)
257 yint0 = yin(1,i)
258 dir11 =-dir2(ilay,i)
259 dir22 = dir1(ilay,i)
260C---
261 k = ecut(1,i)
262 r = kperm(k + 2) ! second intersection must be on opposite edge
263 iedge = xedge4n(r,elcrk)
264 nod1 = nodedge(1,iedge)
265 nod2 = nodedge(2,iedge)
266 IF (nod1 == ixc(r+1,i) .and. nod2 == ixc(dd(r)+1,i))THEN
267 p1 = r
268 p2 = dd(r)
269 ELSE IF (nod2 == ixc(r+1,i).and.nod1 == ixc(dd(r)+1,i))THEN
270 p1 = dd(r)
271 p2 = r
272 ENDIF
273c
274 IF (dir11 == zero) THEN
275 dlx = xxl(p2,i) - xxl(p1,i)
276 IF (dlx /= zero) THEN
277 dly = yyl(p2,i) - yyl(p1,i)
278 m12 = dly / dlx
279 xint = xm(i)
280 yint = yyl(p1,i) + m12*(xint-xxl(p1,i))
281 IF ((xint-xxl(p1,i))*(xint-xxl(p2,i)) <= zero .and.
282 . (yint-yyl(p1,i))*(yint-yyl(p2,i)) <= zero) THEN
283 fac = 2
284 ENDIF
285 ENDIF
286c
287 ELSEIF (dir22 == zero) THEN
288 dly = yyl(p2,i) - yyl(p1,i)
289 IF (dly /= zero) THEN
290 dlx = xxl(p2,i) - xxl(p1,i)
291 m12 = dlx / dly
292 yint = ym(i)
293 xint = xxl(p1,i) + m12*(yint-yyl(p1,i))
294 IF ((xint-xxl(p1,i))*(xint-xxl(p2,i)) <= zero .and.
295 . (yint-yyl(p1,i))*(yint-yyl(p2,i)) <= zero) THEN
296 fac = 2
297 ENDIF
298 ENDIF
299c
300 ELSEIF (dir11 /= zero .AND. dir22 /= zero) THEN
301 dlx = xxl(p2,i) - xxl(p1,i)
302 dly = yyl(p2,i) - yyl(p1,i)
303 mm = dir22/dir11
304 IF (dlx == zero) THEN
305 xint = xxl(p1,i)
306 yint = ym(i) + mm*(xint-xm(i))
307 IF ((yint-yyl(p1,i))*(yint-yyl(p2,i)) <= zero) THEN
308 fac = 2
309 ENDIF
310 ELSEIF (dly == zero) THEN
311 yint = yyl(p1,i)
312 xint = xm(i) + (ym(i)-yyl(p1,i)) / mm
313 IF ((xint-xxl(p1,i))*(xint-xxl(p2,i)) <= zero) THEN
314 fac = 2
315 ENDIF
316 ELSE
317 m12 = dly / dlx
318 IF (mm /= m12) THEN
319 xint = (ym(i)-yyl(p1,i) + m12*xxl(p1,i) - mm*xm(i))/(m12-mm)
320 yint = ym(i) + mm*(xint-xm(i))
321 acd = (yint-yyl(p1,i))*(xm(i) - xxl(p1,i))
322 . - (xint-xxl(p1,i))*(ym(i) - yyl(p1,i))
323 bcd = (yint-yyl(p2,i))*(xm(i) - xxl(p2,i))
324 . - (xint-xxl(p2,i))*(ym(i) - yyl(p2,i))
325c IF (ACD*BCD <= ZERO) THEN
326 fac = 2
327c ENDIF
328 ENDIF
329 ENDIF
330 ENDIF
331
332 IF (fac == 2) THEN
333 cross = (xxl(p1,i) - xint)**2 + (yyl(p1,i) - yint)**2
334 beta = sqrt(cross / len(r,i))
335 IF (beta > bmax .OR. beta < bmin) THEN
336 beta = max(beta, bmin)
337 beta = min(beta, bmax)
338 xint = xxl(p1,i) + beta*(xxl(p2,i)-xxl(p1,i))
339 yint = yyl(p1,i) + beta*(yyl(p2,i)-yyl(p1,i))
340 ENDIF
341C
342 ecut(2,i) = r
343 xin(2,i) = xint
344 yin(2,i) = yint
345 edgel(r,i)= 2
346 beta0(r,i)= beta
347 ENDIF
348 ENDDO
349c----------------------------------------------------------------------
350C check for getting both intersections
351c----------------------------------------------------------------------
352 DO ir=1,newcrk
353 i = jct(ir)
354 fac = 0
355 DO j=1,2
356 k = ecut(j,i)
357 IF (edgel(k,i)==1 .or. edgel(k,i)==2) fac=fac+1
358 ENDDO
359 IF (fac /= 2) THEN
360 WRITE(iout,*) 'ERROR IN INITIATION CRACK.NO CUT EDGES'
361 CALL arret(2)
362 ENDIF
363 ENDDO
364c----------------------------------------------------------------------
365c save cut edges numbers on each layer
366c----------------------------------------------------------------------
367 DO ir=1,newcrk
368 i = jct(ir)
369 elcrk = iel_crk(i+nft)
370 DO j=1,2
371 k = ecut(j,i)
372 crkedge(ilay)%IEDGEC(k,elcrk) = edgel(k,i)
373 ENDDO
374 ENDDO
375C----------------------------------------------------------------------
376C SIGN DISTANCE OF NEW CRACKED LAYER
377C----------------------------------------------------------------------
378 DO ir=1,newcrk
379 i = jct(ir)
380 fit(1,i)=zero
381 fit(2,i)=zero
382 fit(3,i)=zero
383 fit(4,i)=zero
384 DO k=1,4
385 p1 = k
386 p2 = dd(k)
387 ied = edgel(k,i)
388 IF (ied > 0) THEN
389 xmi(ied) = half*(xxl(p1,i)+xxl(p2,i))
390 ymi(ied) = half*(yyl(p1,i)+yyl(p2,i))
391 ENDIF
392 ENDDO
393C
394 DO k=1,4
395 fi = zero
396 CALL lsint4(xmi(1),ymi(1),xmi(2),ymi(2),xxl(k,i),yyl(k,i),fi )
397 IF (fit(k,i)==zero) fit(k,i) = fi
398 ENDDO
399 ENDDO
400C-------------------
401 DO ir=1,newcrk
402 i = jct(ir)
403 elcrk = iel_crk(i+nft)
404 DO j=1,2
405 k = ecut(j,i)
406 iedge = xedge4n(k,elcrk)
407 icut = crkedge(ilay)%ICUTEDGE(iedge)
408 IF (icut > 0) THEN ! edge connecting two cracks (for spmd
409 crkedge(ilay)%ICUTEDGE(iedge) = 3 ! 2 cracks on the same edge
410 ELSE
411 crkedge(ilay)%ICUTEDGE(iedge) = 2 ! edge cut
412 crkedge(ilay)%RATIO(iedge) = beta0(k,i)
413 ENDIF
414 ENDDO
415 ENDDO
416C-----------------------
417C FILL new cut layer
418C-----------------------
419 DO ir=1,newcrk
420 i = jct(ir)
421 elcrk = iel_crk(i+nft)
422 elcutc(1,i) = 2
423 numelcrk = numelcrk + 1
424C
425 iadc(1) = iadc_crk(1,elcrk)
426 iadc(2) = iadc_crk(2,elcrk)
427 iadc(3) = iadc_crk(3,elcrk)
428 iadc(4) = iadc_crk(4,elcrk)
429C
430 n(1) = ixc(2,i)
431 n(2) = ixc(3,i)
432 n(3) = ixc(4,i)
433 n(4) = ixc(5,i)
434 nn(1) = inod_crk(n(1))
435 nn(2) = inod_crk(n(2))
436 nn(3) = inod_crk(n(3))
437 nn(4) = inod_crk(n(4))
438C
439 isign(1) = int(sign(one,fit(1,i)))
440 isign(2) = int(sign(one,fit(2,i)))
441 isign(3) = int(sign(one,fit(3,i)))
442 isign(4) = int(sign(one,fit(4,i)))
443C
444 IF (fit(1,i) == zero) isign(1) = 0
445 IF (fit(2,i) == zero) isign(2) = 0
446 IF (fit(3,i) == zero) isign(3) = 0
447 IF (fit(4,i) == zero) isign(4) = 0
448c
449 icrk = crkshell(pp1)%CRKSHELLID(elcrk)
450c
451 ienr0(1) = crknodiad(iadc(1))
452 ienr0(2) = crknodiad(iadc(2))
453 ienr0(3) = crknodiad(iadc(3))
454 ienr0(4) = crknodiad(iadc(4))
455C
456 ienr(1) = ienr0(1) + knod2elc(nn(1))*(ilay-1)
457 ienr(2) = ienr0(2) + knod2elc(nn(2))*(ilay-1)
458 ienr(3) = ienr0(3) + knod2elc(nn(3))*(ilay-1)
459 ienr(4) = ienr0(4) + knod2elc(nn(4))*(ilay-1)
460c--------------------------------------------
461 DO j=1,2
462 k = ecut(j,i)
463 iedge = xedge4n(k,elcrk)
464 nod1 = nodedge(1,iedge)
465 nod2 = nodedge(2,iedge)
466 ie10 = crkedge(ilay)%EDGEENR(1,iedge)
467 ie20 = crkedge(ilay)%EDGEENR(2,iedge)
468 IF (nod1 == n(k) .and. nod2 == n(dd(k))) THEN
469 ie1 = ienr(k)
470 ie2 = ienr(dd(k))
471 ifi1 = isign(k)
472 ifi2 = isign(dd(k))
473 ELSE IF (nod2 == n(k) .and. nod1 == n(dd(k))) THEN
474 ie1 = ienr(dd(k))
475 ie2 = ienr(k)
476 ifi1 = isign(dd(k))
477 ifi2 = isign(k)
478 END IF
479 crkedge(ilay)%EDGEENR(1,iedge) = max(ie1,ie10)
480 crkedge(ilay)%EDGEENR(2,iedge) = max(ie2,ie20)
481 IF (crkedge(ilay)%EDGEICRK(iedge) == 0)
482 . crkedge(ilay)%EDGEICRK(iedge) = icrk
483 ENDDO
484C------------------
485 crkedge(ilay)%LAYCUT(elcrk) = -1 ! layer cut
486 xfem_phantom(ilay)%ELCUT(elcrk) = icrk
487C
488 np = 0
489 DO k=1,4
490 ied = edgel(k,i)
491 iedge = xedge4n(k,elcrk)
492 IF (ied > 0) THEN
493 crkedge(ilay)%EDGETIP(1,iedge) = ied
494 crkedge(ilay)%EDGETIP(2,iedge) =
495 . crkedge(ilay)%EDGETIP(2,iedge) + 1
496 ENDIF
497 IF (isign(k) > 0) np = k
498 ENDDO
499c-------------------
500 itri = 0
501 nx1 = np
502 IF (np > 0 .and. isign(np-1) > 0) THEN
503 nx1 = np-1
504 ELSE
505 nx1 = np
506 ENDIF
507 xfem_phantom(ilay)%ITRI(1,elcrk) = itri
508 xfem_phantom(ilay)%ITRI(2,elcrk) = nx1 ! first positive node
509 nx2 = dx(nx1+1)
510 nx3 = dx(nx1+2)
511 nx4 = dx(nx1+3)
512c calculate first phantom area
513 x1 = xxl(nx1,i)
514 y1 = yyl(nx1,i)
515 x2 = xxl(nx2,i)
516 y2 = yyl(nx2,i)
517 ied = edgel(nx2,i)
518 IF (ied > 0) THEN
519 x3 = xin(ied,i)
520 y3 = yin(ied,i)
521 ELSE
522 print*,' ERROR: K,IED=',k,ied
523 ENDIF
524 ied = edgel(nx4,i)
525 IF (ied > 0) THEN
526 x4 = xin(ied,i)
527 y4 = yin(ied,i)
528 ELSE
529 print*,' ERROR: K,IED=',k,ied
530 ENDIF
531 area1 = half*abs((x1-x3)*(y2-y1) - (x1-x2)*(y3-y1))
532 area1 = area1 * a_i(i)
533 area2 = one - area1
534 crklvset(pp1)%AREA(elcrk) = area1
535 crklvset(pp2)%AREA(elcrk) = area2
536 crklvset(pp3)%AREA(elcrk) = zero
537C
538 xfem_phantom(ilay)%IFI(iadc(1)) = isign(1)
539 xfem_phantom(ilay)%IFI(iadc(2)) = isign(2)
540 xfem_phantom(ilay)%IFI(iadc(3)) = isign(3)
541 xfem_phantom(ilay)%IFI(iadc(4)) = isign(4)
542C------------------
543C IXEL = 1 => positif element within ILAY
544C------------------
545 crklvset(pp1)%ENR0(1,iadc(1)) = -ienr(1)
546 crklvset(pp1)%ENR0(1,iadc(2)) = -ienr(2)
547 crklvset(pp1)%ENR0(1,iadc(3)) = -ienr(3)
548 crklvset(pp1)%ENR0(1,iadc(4)) = -ienr(4)
549C
550 IF (isign(1) > 0) crklvset(pp1)%ENR0(1,iadc(1)) = 0
551 IF (isign(2) > 0) crklvset(pp1)%ENR0(1,iadc(2)) = 0
552 IF (isign(3) > 0) crklvset(pp1)%ENR0(1,iadc(3)) = 0
553 IF (isign(4) > 0) crklvset(pp1)%ENR0(1,iadc(4)) = 0
554C------------------
555C IXEL = 2 => negatif element within ILAY ! ILEV = PP2
556C------------------
557 crklvset(pp2)%ENR0(1,iadc(1)) = -ienr(1)
558 crklvset(pp2)%ENR0(1,iadc(2)) = -ienr(2)
559 crklvset(pp2)%ENR0(1,iadc(3)) = -ienr(3)
560 crklvset(pp2)%ENR0(1,iadc(4)) = -ienr(4)
561C
562 IF (isign(1) < 0) crklvset(pp2)%ENR0(1,iadc(1)) = 0
563 IF (isign(2) < 0) crklvset(pp2)%ENR0(1,iadc(2)) = 0
564 IF (isign(3) < 0) crklvset(pp2)%ENR0(1,iadc(3)) = 0
565 IF (isign(4) < 0) crklvset(pp2)%ENR0(1,iadc(4)) = 0
566C------------------
567c IXEL = 3 => not actif
568C------------------
569 xfem_str(nxel)%GBUF%OFF(i) = zero
570 xfem_str(nxel)%BUFLY(ilay)%LBUF(1,1,1)%OFF(i) = zero
571c
572 ENDDO ! IR=1,NEWCRK
573C-------------------
574 nlevset = nlevset + 1 ! update nb of cracks
575C-------------------
576 RETURN
577 END
lsint4
subroutine lsint4(y1, z1, y2, z2, y, z, fi)
Definition crklayer4n_adv.F:712
crklayer4n_ini
subroutine crklayer4n_ini(xfem_str, nel, nft, ixc, elcutc, ilay, nlay, iel_crk, inod_crk, iadc_crk, nodenr, elcrkini, dir1, dir2, nodedge, crknodiad, knod2elc, crkedge, a_i, xl2, xl3, xl4, yl2, yl3, yl4, xedge4n, ngl)
Definition crklayer4n_ini.F:43
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
crackxfem_mod::xfem_phantom
type(xfem_phantom_), dimension(:), allocatable xfem_phantom
Definition crackxfem_mod.F:139
crackxfem_mod::crkshell
type(xfem_shell_), dimension(:), allocatable crkshell
Definition crackxfem_mod.F:190
crackxfem_mod::crklvset
type(xfem_lvset_), dimension(:), allocatable crklvset
Definition crackxfem_mod.F:146
arret
subroutine arret(nn)
Definition arret.F:86