OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
crklayer4n_ini.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "com04_c.inc"
#include "com_xfem1.inc"
#include "comlock.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ crklayer4n_ini()

subroutine crklayer4n_ini ( type (elbuf_struct_), dimension(nxel), target xfem_str,
integer nel,
integer nft,
integer, dimension(nixc,*) ixc,
integer, dimension(2,*) elcutc,
integer ilay,
integer nlay,
integer, dimension(*) iel_crk,
integer, dimension(*) inod_crk,
integer, dimension(4,*) iadc_crk,
integer, dimension(*) nodenr,
integer, dimension(nlay,nel) elcrkini,
dimension(nlay,nel) dir1,
dimension(nlay,nel) dir2,
integer, dimension(2,*) nodedge,
integer, dimension(*) crknodiad,
integer, dimension(*) knod2elc,
type (xfem_edge_), dimension(nxlaymax) crkedge,
dimension(nel) a_i,
xl2,
xl3,
xl4,
yl2,
yl3,
yl4,
integer, dimension(4,*) xedge4n,
integer, dimension(nel) ngl )

Definition at line 36 of file crklayer4n_ini.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
lsint4
subroutine lsint4(y1, z1, y2, z2, y, z, fi)
Definition crklayer4n_adv.F:712
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
arret
subroutine arret(nn)
Definition arret.F:86