30 1 NEL ,NUPARAM ,UPARAM ,NUVAR ,UVAR ,
31 2 TIME ,TIMESTEP ,TENS ,DFMAX ,TDEL ,
32 3 SIGNXX ,SIGNYY ,SIGNXY ,SIGNYZ ,SIGNZX ,
34 5 NOFF ,OFF ,OFFL ,ELCRKINI ,IXFEM ,
35 6 IXEL ,ILAY ,IPTT ,NPTT ,NPTTF )
41#include "implicit_f.inc"
47#include "com_xfem1.inc"
79 INTEGER NEL,NUPARAM,IXFEM,IXEL,ILAY,IPTT,NPTT,NUVAR,IPT,NPTOT
80 INTEGER NGL(NEL),ELCRKINI(NXLAYMAX,*),NOFF(NEL)
82 . TIME,TIMESTEP(NEL),UPARAM(NUPARAM),NPTTF(NEL),
83 . SIGNXX(NEL),SIGNYY(NEL),SIGNZZ(NEL),SIGNXY(NEL),SIGNYZ(NEL),
84 . SIGNZX(NEL),TENS(NEL,5),DFMAX(NEL),TDEL(NEL)
88 my_real uvar(nel,nuvar), off(nel),offl(nel)
89 my_real,
DIMENSION(:) ,
POINTER :: sigsav
93 INTEGER I,J,ISHELL,NINDX,NINDXP,LAYXFEM,IBRIT
94 INTEGER INDX(NEL),INDXP(NEL),RFLAG(NEL),RFLAGP(NEL)
96 . tba,tbk,kk,sigmax,dadv,sigr_ini,sigr_adv,
97 . sig1,sig2,s1,s2,brit_b,brit_c,damd(nel)
98 CHARACTER (LEN=3) :: XCHAR
103 ishell = int(uparam(4))
104 ibrit = int(uparam(6))
110 IF (layxfem == 1 .and. ishell == 1) ishell = 2
112 sigr_adv = sigr_ini*dadv
125 tens(i,1) = signxx(i)
126 tens(i,2) = signyy(i)
127 tens(i,3) = signxy(i)
128 tens(i,4) = signyz(i)
129 tens(i,5) = signzx(i)
137 ELSEIF (ixel == 3)
THEN
144 SELECT CASE (layxfem)
149 IF (off(i) == one)
THEN
150 IF (uvar(i,1) < tbk)
THEN
151 s1 = half*(signxx(i) + signyy(i))
152 s2 = half*(signxx(i) - signyy(i))
153 sig1 = s1 + sqrt(s2**2 + signxy(i)**2)
154 sig2 = s1 - sqrt(s2**2 + signxy(i)**2)
155 sigmax =
max(sig1,sig2)
158 IF (elcrkini(ilay,i)==0 .and. sigmax > sigr_ini)
THEN
159 uvar(i,1) = uvar(i,1) + timestep(i)*(sigmax - sigr_ini)
164 IF (uvar(i,1) >= tbk)
THEN
168 noff(i) = noff(i) + 1
169 npttf(i) = npttf(i) + one
171 IF (int(npttf(i)) == nptt)
THEN
174 elcrkini(ilay,i) = -1
177 IF (noff(i) == nptot)
THEN
182 ELSEIF (elcrkini(ilay,i) == 2 .and. sigmax > sigr_adv)
THEN
183 uvar(i,1) = uvar(i,1) + timestep(i)*(sigmax - sigr_adv)**tba
186 IF (uvar(i,1) >= tbk)
THEN
190 noff(i) = noff(i) + 1
191 npttf(i) = npttf(i)+ one
193 IF (int(npttf(i)) == nptt)
THEN
199 IF (noff(i) == nptot)
THEN
205 ELSEIF (sigmax > sigr_ini)
THEN
206 uvar(i,1) = uvar(i,1) + timestep(i)*(sigmax - sigr_ini)**tba
207 IF (uvar(i,1) >= tbk)
THEN
211 npttf(i) = npttf(i) + one
213 IF (int(npttf(i)) == nptt)
THEN
241 IF (rflagp
WRITE(iout, 3800)ngl(i),ilay,iptt
242 IF (rflagp(i) == 1)
WRITE(istdo,3900)ngl(i),ilay,iptt,time
243#include "lockoff.inc"
252 IF (rflag(i) == 1)
WRITE(iout ,3000) ngl(i),ilay
253 IF (rflag(i) == 1)
WRITE(istdo,3100) ngl(i),ilay,time
255 IF (rflag(i) == -1)
WRITE(iout ,3200) ngl(i),ilay
256 IF (rflag(i) == -1)
WRITE(istdo,3300) ngl(i),ilay,time
258 IF (rflag(i) == 3)
WRITE(iout, 3400)xchar,ngl(i),ilay
259 IF (rflag(i) == 3)
WRITE(istdo,3500)xchar,ngl(i),ilay,time
260#include "lockoff.inc"
267 IF (ishell == 1)
THEN
270 IF (off(i) == one)
THEN
271 s1 = half*(signxx(i) + signyy(i))
272 s2 = half*(signxx(i) - signyy(i))
273 sig1 = s1 + sqrt(s2**2 + signxy(i)**2)
274 sig2 = s1 - sqrt(s2**2 + signxy(i)**2)
275 sigmax =
max(sig1,sig2)
277 IF (ibrit == 1)
THEN ! ductile rupture
279 IF (elcrkini(ilay,i) == 0 .and. sigmax > sigr_ini)
THEN
280 uvar(i,1) = uvar(i,1) + timestep(i)*(sigmax - sigr_ini)**tba
281 IF (uvar(i,1) >= tbk)
THEN
282 elcrkini(ilay,i) = -1
292 ELSEIF (elcrkini(ilay,i) == 2 .and. sigmax > sigr_adv)
THEN
293 uvar(i,1) = uvar(i,1) + timestep(i)*(sigmax - sigr_adv)**tba
294 IF (uvar(i,1) >= tbk)
THEN
306 ELSEIF (sigmax > sigr_ini)
THEN
307 uvar(i,1) = uvar(i,1) + timestep(i)*(sigmax - sigr_ini)**tba
308 IF (uvar(i,1) >= tbk)
THEN
319 ELSEIF (ibrit == 2)
THEN
320 kk = one/
max(em10,tbk)
321 IF (sigmax > uvar(i,1))
THEN
322 damd(i) = kk*(sigmax-uvar(i,1))**brit_b
324 noff(i) = noff(i) + damd(i)*timestep(i)
325 IF (noff(i)<one) uvar(i,1) = sigr_ini*(one-noff(i))**brit_c
327 IF (elcrkini(ilay,i) == 0)
THEN
328 IF (noff(i) >= one)
THEN
329 elcrkini(ilay,i) = -1
339 ELSEIF (elcrkini(ilay,i) == 2)
THEN
340 IF (noff(i) >= one)
THEN
352 ELSEIF (noff(i) >= one)
THEN
366 ELSEIF (ishell == 2)
THEN
369 IF (off(i) == one)
THEN
370 IF (uvar(i,1) < tbk)
THEN
371 s1 = half*(signxx(i) + signyy(i))
372 s2 = half*(signxx(i) - signyy(i))
373 sig1 = s1 + sqrt(s2**2 + signxy(i)**2)
374 sig2 = s1 - sqrt(s2**2 + signxy(i)**2)
375 sigmax =
max(sig1,sig2)
378 IF (elcrkini(ilay,i)==0 .and. sigmax > sigr_ini)
THEN
379 uvar(i,1) = uvar(i,1) + timestep(i)*(sigmax - sigr_ini)**tba
380 IF (uvar(i,1) >= tbk)
THEN
381 noff(i) = noff(i) + 1
387 IF (noff(i) == nptot)
THEN
388 elcrkini(ilay,i) = -1
394 ELSEIF (elcrkini(ilay,i) == 2 .and. sigmax > sigr_adv)
THEN
395 uvar(i,1) = uvar(i,1) + timestep(i)*(sigmax - sigr_adv)**tba
396 IF (uvar(i,1) >= tbk)
THEN
397 noff(i) = noff(i) + 1
403 IF (noff(i) == nptot)
THEN
411 ELSEIF (sigmax > sigr_ini)
THEN
412 uvar(i,1) = uvar(i,1) + timestep(i)*(sigmax - sigr_ini)**tba
413 IF (uvar(i,1) >= tbk)
THEN
418 noff(i) = noff(i) + 1
419 IF (noff(i) == nptot)
THEN
444 IF (rflagp(i) == 1)
WRITE(iout, 4800)ngl(i),iptt
445 IF (rflagp(i) == 1)
WRITE(istdo,4900)ngl(i),iptt,time
446#include "lockoff.inc"
455 IF (rflag(i) == 1)
WRITE(iout, 4000) ngl(i)
456 IF (rflag(i) == 1)
WRITE(istdo,4100) ngl(i),time
458 IF (rflag(i) == -1)
WRITE(iout, 4200) ngl(i)
459 IF (rflag(i) == -1)
WRITE(istdo,4300) ngl(i),time
461 IF (rflag(i) == 3)
WRITE(iout, 4400)xchar,ngl(i)
462 IF (rflag(i) == 3)
WRITE(istdo,4500)xchar,ngl(i),time
463#include "lockoff.inc"
475 dfmax(i) =
min(one,
max(dfmax(i),uvar(i,1)/tbk))
478 2000
FORMAT(1x,
'FOR SHELL ELEMENT',i10,1x,
'LAYER',i3,
':',/
479 . 1x,
'STRESS TENSOR SET TO ZERO (TBUTCHER)')
480 2100
FORMAT(1x,
'FOR SHELL ELEMENT',i10,1x,
'LAYER',i3,
':',/,
481 . 1x,
'STRESS TENSOR SET TO ZERO (TBUTCHER)',1x,
'AT TIME :',1pe20.13)
483 3000
FORMAT(1x,
'CRACK INITIALIZATION IN SHELL ELEMENT',i10,1x,
'LAYER',i3)
484 3100
FORMAT(1x,
'CRACK INITIALIZATION IN SHELL ELEMENT',i10,1x,
'LAYER',i3,/
485 . 1x,
'AT TIME :',1pe12.4)
486 3200
FORMAT(1x,
'CRACK ADVANCEMENT IN SHELL ELEMENT',i10,
' LAYER',i3)
487 3300
FORMAT(1x,
'CRACK ADVANCEMENT IN SHELL ELEMENT',i10,
' LAYER',i3/
488 . 1x,
'AT TIME :',1pe12.4)
489 3400
FORMAT(1x,
'DELETE ',a4,
' PHANTOM ELEMENT, SHELL ID=',i10,
' LAYER',i3)
490 3500
FORMAT(1x,
'DELETE ',a4,
' PHANTOM ELEMENT, SHELL ID=',i10,
' LAYER',i3,/
491 . 1x,
'AT TIME :',1pe12.4)
492 3800
FORMAT(1x,
'TBUTCHER FAILURE IN SHELL',i10,1x,
'LAYER',i3,1x,
'INT POINT',i2)
493 3900
FORMAT(1x,
'TBUTCHER FAILURE IN SHELL',i10,1x,
'LAYER',i3,1x,
'INT POINT',i2,/
494 . 1x,
'AT TIME :',1pe12.4)
496 4000
FORMAT(1x,
'CRACK INITIALIZATION IN SHELL ELEMENT',i10)
497 4100
FORMAT(1x,
'CRACK INITIALIZATION IN SHELL ELEMENT',i10,/
498 . 1x,
'AT TIME :',1pe12.4)
499 4200
FORMAT(1x,
'CRACK ADVANCEMENT IN SHELL ELEMENT',i10)
500 4300
FORMAT(1x,
'CRACK ADVANCEMENT IN SHELL ELEMENT',i10,/
501 . 1x,
'AT TIME :',1pe12.4)
502 4400
FORMAT(1x,
'DELETE ',a4,
' PHANTOM ELEMENT, SHELL ID=',i10)
503 4500
FORMAT(1x,
'DELETE ',a4,
' PHANTOM ELEMENT, SHELL ID=',i10,/
504 . 1x,
'AT TIME :',1pe12.4)
505 4800
FORMAT(1x,
'TBUTCHER FAILURE IN SHELL',i10,1x,
'INT POINT',i2)
506 4900
FORMAT(1x,
'TBUTCHER FAILURE IN SHELL',i10,1x,
'INT POINT',i2,1x,
'AT TIME :',1pe12.4)
subroutine fail_tbutcher_xfem(nel, nuparam, uparam, nuvar, uvar, time, timestep, tens, dfmax, tdel, signxx, signyy, signxy, signyz, signzx, ngl, ipt, nptot, noff, off, offl, elcrkini, ixfem, ixel, ilay, iptt, nptt, npttf)