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