37 . IXTG ,NFT ,JFT ,JLT ,NXLAY ,
38 . IAD_CRKTG,IEL_CRKTG,INOD_CRK,ELCUTC ,NODEDGE ,
39 . CRKNODIAD,KNOD2ELC ,X ,CRKEDGE,XEDGE3N )
43 use element_mod ,
only : nixtg
47#include "implicit_f.inc"
55#include "com_xfem1.inc"
65 TYPE (ELBUF_STRUCT_) :: ELBUF_STR
66 TYPE (XFEM_EDGE_) ,
DIMENSION(*) :: CRKEDGE
70 INTEGER I,K,ELCRK,ELCRKTG,ELCUT,pp1,pp2,pp3,IADC(3),IENR0(3),
71 . IENR(3),IED,IEDGE,IE10,IE20,IE1,IE2,NOD1,NOD2,N(3),DX(6),
72 . NX(3),dd(3),LAYCUT,ISIGN1,ISIGN2,ISIGN3,SIGBETA,
73 . isign0(nxel,3),p1,p2,
74 . ntag(3),edgeenr(3),enr(3),ilay,itri,nx1,nx2,nx3,nm,np
76 . x1g(mvsiz),x2g(mvsiz),x3g(mvsiz),y1g(mvsiz),y2g(mvsiz),
77 . y3g(mvsiz),z1g(mvsiz),z2g(mvsiz),z3g(mvsiz),
area(mvsiz),
78 . lxyz0(2),rx(mvsiz),ry(mvsiz),rz(mvsiz),
79 . sx(mvsiz),sy(mvsiz),sz(mvsiz),r11(mvsiz),r12(mvsiz),
80 . r13(mvsiz),r21(mvsiz),r22(mvsiz),r23(mvsiz),r31(mvsiz),
81 . r32(mvsiz),r33(mvsiz),xl1(mvsiz),yl1(mvsiz),xl2(mvsiz),
82 . yl2(mvsiz),xl3(mvsiz),yl3(mvsiz),
83 . fit(3,mvsiz),offg(mvsiz),xin(2,mvsiz),yin(2,mvsiz),fi,
84 . xxl(3,mvsiz),yyl(3,mvsiz),xn(3),yn(3),xm(2),ym(2)
86 . beta,area1,area2,area3
100 x1g(i)=x(1,ixtg(2,i+nft))
101 y1g(i)=x(2,ixtg(2,i+nft))
102 z1g(i)=x(3,ixtg(2,i+nft))
103 x2g(i)=x(1,ixtg(3,i+nft))
104 y2g(i)=x(2,ixtg(3,i+nft))
105 z2g(i)=x(3,ixtg(3,i+nft))
106 x3g(i)=x(1,ixtg(4,i+nft))
107 y3g(i)=x(2,ixtg(4,i+nft))
108 z3g(i)=x(3,ixtg(4,i+nft))
114 rx(i) = x2g(i)-x1g(i)
115 ry(i) = y2g(i)-y1g(i)
116 rz(i) = z2g(i)-z1g(i)
117 sx(i) = x3g(i)-x1g(i)
118 sy(i) = y3g(i)-y1g(i)
119 sz(i) = z3g(i)-z1g(i)
120 offg(i) = elbuf_str%GBUF%OFF(i)
126 . r11,r12,r13,r21,r22,r23,r31,r32,r33,
area,offg )
133 xl2(i)=r11(i)*rx(i)+r21(i)*ry(i)+r31(i)*rz(i)
134 yl2(i)=r12(i)*rx(i)+r22(i)*ry(i)+r32(i)*rz(i)
135 xl3(i)=r11(i)*sx(i)+r21(i)*sy(i)+r31(i)*sz(i)
136 yl3(i)=r12(i)*sx(i)+r22(i)*sy(i)+r32(i)*sz(i)
143 lxyz0(1)=third*(xl1(i)+xl2(i)+xl3(i))
144 lxyz0(2)=third*(yl1(i)+yl2(i)+yl3(i))
146 xl1(i)=xl1(i)-lxyz0(1)
147 yl1(i)=yl1(i)-lxyz0(2)
148 xl2(i)=xl2(i)-lxyz0(1)
149 yl2(i)=yl2(i)-lxyz0(2)
150 xl3(i)=xl3(i)-lxyz0(1)
151 yl3(i)=yl3(i)-lxyz0(2)
157 pp1 = nxel*(ilay-1)+1
168 elcrktg = iel_crktg(i+nft)
169 elcrk = elcrktg + ecrkxfec
170 laycut = crkedge(ilay)%LAYCUT(elcrk)
171 IF (laycut /= 0)
THEN
187 ied = crkedge(ilay)%IEDGETG(k,elcrktg)
189 iedge = xedge3n(k,elcrktg)
190 beta = crkedge(ilay)%RATIO(iedge)
191 nod1 = nodedge(1,iedge)
192 nod2 = nodedge(2,iedge)
193 IF (nod1 == ixtg(k+1,i+nft) .and. nod2 == ixtg(dd(k)+1,i+nft))
THEN
196 ELSEIF (nod2 == ixtg(k+1,i+nft).and.nod1 == ixtg(dd(k)+1,i+nft))
THEN
200 xin(ied,i) = xn(p1) + beta*(xn(p2) - xn(p1))
201 yin(ied,i) = yn(p1) + beta*(yn(p2) - yn(p1))
202 xm(ied) = half*(xn(p1)+xn(p2))
203 ym(ied) = half*(yn(p1)+yn(p2))
209 CALL lsint4(xm(1),ym(1),xm(2),ym(2),xn(k),yn(k),fi )
210 IF (fit(k,i)==zero) fit(k,i) = fi
217 elcrktg = iel_crktg(i+nft)
218 elcrk = elcrktg + ecrkxfec
219 elcut = crkedge(ilay)%LAYCUT(elcrk)
228 elcrktg = iel_crktg(i+nft)
229 elcrk = elcrktg + ecrkxfec
230 laycut = crkedge(ilay)%LAYCUT(elcrk)
231 IF (laycut /= 0)
THEN
233 iadc(1) = iad_crktg(1,elcrktg)
234 iadc(2) = iad_crktg(2,elcrktg)
235 iadc(3) = iad_crktg(3,elcrktg)
237 ienr0(1) = crknodiad(iadc(1))
238 ienr0(2) = crknodiad(iadc(2))
239 ienr0(3) = crknodiad(iadc(3))
245 nx(1) = inod_crk(n(1))
246 nx(2) = inod_crk(n(2))
247 nx(3) = inod_crk(n(3))
249 ienr(1) = ienr0(1) + knod2elc(nx(1))*(ilay-1)
250 ienr(2) = ienr0(2) + knod2elc(nx(2))*(ilay-1)
251 ienr(3) = ienr0(3) + knod2elc(nx(3))*(ilay-1)
258 ied = crkedge(ilay)%IEDGETG(k,elcrktg)
260 ntag(k) = ntag(k) + 1
261 ntag(dd(k)) = ntag(dd(k)) + 1
262 iedge = xedge3n(k,elcrktg)
263 nod1 = nodedge(1,iedge)
264 nod2 = nodedge(2,iedge)
265 ie10 = crkedge(ilay)%EDGEENR(1,iedge)
266 ie20 = crkedge(ilay)%EDGEENR(2,iedge)
267 IF (nod1 == n(k) .and. nod2 == n(dd(k)))
THEN
270 ELSEIF (nod2 == n(k) .and. nod1 == n(dd(k)))
THEN
280 IF (ntag(k) > 0)
THEN
288 IF (ienr(k) > ienrnod)
THEN
289 WRITE(iout,*)
'ERROR CRACK INITIATION,ENRICHMENT NODE EXCEEDED'
294 isign1 = int(sign(one,fit(1,i)))
295 isign2 = int(sign(one,fit(2,i)))
296 isign3 = int(sign(one,fit(3,i)))
298 IF (fit(1,i) == zero) isign1 = 0
299 IF (fit(2,i) == zero) isign2 = 0
300 IF (fit(3,i) == zero) isign3 = 0
312 IF (isign0(1,k) > 0)
THEN
315 ELSEIF (isign0(1,k) < 0)
THEN
322 ELSEIF (itri == 2)
THEN
337 crklvset(pp1)%ENR0(1,iadc(1)) = enr(1)
338 crklvset(pp1)%ENR0(1,iadc(2)) = enr(2)
339 crklvset(pp1)%ENR0(1,iadc(3)) = enr(3)
341 IF (isign0(1,1) > 0)
crklvset(pp1)%ENR0(1,iadc(1)) = 0
342 IF (isign0(1,2) > 0)
crklvset(pp1)%ENR0(1,iadc(2)) = 0
343 IF (isign0(1,3) > 0)
crklvset(pp1)%ENR0(1,iadc(3)) = 0
351 crklvset(pp2)%ENR0(1,iadc(1)) = enr(1)
352 crklvset(pp2)%ENR0(1,iadc(2)) = enr(2)
353 crklvset(pp2)%ENR0(1,iadc(3)) = enr(3)
355 IF (isign0(2,1) < 0)
crklvset(pp2)%ENR0(1,iadc(1)) = 0
356 IF (isign0(2,2) < 0)
crklvset(pp2)%ENR0(1,iadc(2)) = 0
357 IF (isign0(2,3) < 0)
crklvset(pp2)%ENR0(1,iadc(3)) = 0
366 ie1 = xedge3n(nx1,elcrktg)
367 ie2 = xedge3n(nx3,elcrktg)
372 crklvset(pp2)%ENR0(1,iadc(nx1)) = -crknodiad(iadc(nx1)) - knod2elc(nx(nx1))*(ilay-1)
374 beta = crkedge(ilay)%RATIO(ie2)
375 nod1 = nodedge(1,ie2)
376 nod2 = nodedge(2,ie2)
378 IF (nod1 == ixtg(k+1,i+nft) .and.
379 . nod2 == ixtg(dd(k)+1,i
THEN
383 ELSEIF (nod2 == ixtg(k+1,i+nft) .and.
384 . nod1 == ixtg(dd(k)+1,i+nft))
THEN
393 ied = crkedge(ilay)%IEDGETG(nx1,elcrktg)
396 ied = crkedge(ilay)%IEDGETG(nx3,elcrktg)
399 area1 = half*abs((x1-x3)*(y2-y1) - (x1-x2)*(y3-y1))
400 area1 = area1 /
area(i)
405 area2 = half*abs((x1-x3)*(y2-y1) - (x1-x2)*(y3-y1))
406 area3 = one - area1 - area2
408 ELSEIF (itri > 0)
THEN
410 ie1 = xedge3n(nx1,elcrktg)
415 crklvset(pp1)%ENR0(1,iadc(nx1)) = -crknodiad(iadc(nx1)) - knod2elc(nx(nx1))*(ilay-1)
417 beta = crkedge(ilay)%RATIO(ie1)
418 nod1 = nodedge(1,ie1)
419 nod2 = nodedge(2,ie1)
421 IF (nod1 == ixtg(k+1,i+nft) .and.
422 . nod2 == ixtg(dd(k)+1,i+nft))
THEN
426 ELSEIF (nod2 == ixtg(k+1,i+nft) .and.
427 . nod1 == ixtg(dd(k)+1,i+nft))
THEN
436 ied = crkedge(ilay)%IEDGETG(nx3,elcrktg)
439 ied = crkedge(ilay)%IEDGETG(nx1,elcrktg)
442 area1 = half*abs((x1-x3)*(y2-y1) - (x1-x2)*(y3-y1))
443 area1 = area1 /
area(i)
448 area2 = half*abs((x1-x3)*(y2-y1) - (x1-x2)*(y3-y1))
449 area3 = one - area1 - area2