OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fail_tab_old_xfem.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!|| fail_tab_old_xfem ../engine/source/materials/fail/tabulated/fail_tab_old_xfem.f
25!||--- called by ------------------------------------------------------
26!|| mulawc ../engine/source/materials/mat_share/mulawc.F90
27!|| usermat_shell ../engine/source/materials/mat_share/usermat_shell.F
28!||--- calls -----------------------------------------------------
29!|| finter ../engine/source/tools/curve/finter.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../engine/share/message_module/message_mod.F
32!||====================================================================
33 SUBROUTINE fail_tab_old_xfem(
34 1 NEL ,NPARAM ,NUVAR ,NPF ,TF ,
35 2 TIME ,TIMESTEP ,UPARAM ,NGL ,IPT ,
36 3 NPTOT ,NFUNC ,IFUNC ,DMG_FLAG ,
37 4 SIGNXX ,SIGNYY ,SIGNXY ,SIGNYZ ,SIGNZX ,
38 5 DPLA ,EPSP ,TSTAR ,TENS ,UVAR ,
39 6 NOFF ,ALDT ,OFF ,OFFL ,ELCRKINI ,
40 7 IXFEM ,IXEL ,ILAY ,DFMAX ,TDEL )
41C-----------------------------------------------
42C tabulated failure model (old, obsolete version) for XFEM
43C-----------------------------------------------
44 USE message_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C G l o b a l P a r a m e t e r s
51C-----------------------------------------------
52#include "units_c.inc"
53#include "comlock.inc"
54#include "com_xfem1.inc"
55C---------+---------+---+---+--------------------------------------------
56C ILAY CURRENT LAYER
57C IPT CURRENT INTEGRATION POINT IN ALL LAYERS
58C NPTOT NUMBER OF INTEGRATION POINTS IN ALL LAYERS (TOTAL)
59C NOFF NUMBER OF FAILED INTEGRATION POINTS (TOTAL)
60C-----------------------------------------------
61C I N P U T A r g u m e n t s
62C-----------------------------------------------
63 INTEGER NEL,NPARAM,NUVAR,IPT,NFUNC,IXFEM,IXEL,ILAY,NPTOT
64 INTEGER NGL(NEL),NOFF(NEL),IFUNC(NFUNC),
65 . ELCRKINI(NXLAYMAX,NEL)
66 my_real TIME,TIMESTEP(NEL),UPARAM(*),DPLA(NEL),EPSP(NEL),
67 . TSTAR(NEL),ALDT(NEL)
68C-----------------------------------------------
69C I N P U T O U T P U T A r g u m e n t s
70C-----------------------------------------------
71 my_real, DIMENSION(2) :: xx0
72 my_real
73 . uvar(nel,nuvar),off(nel),offl(nel),
74 . signxx(nel),signyy(nel),signxy(nel),signyz(nel),signzx(nel),
75 . tens(nel,5),dfmax(nel),tdel(nel)
76C-----------------------------------------------
77C VARIABLES FOR FUNCTION INTERPOLATION
78C-----------------------------------------------
79 INTEGER NPF(*)
80 my_real FINTER ,TF(*)
81 EXTERNAL FINTER
82C-----------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85 INTEGER :: I,J,J1,J2,K,L,NINDX,ISHELL,LAYXFEM,NRATE,DMG_FLAG,
86 . ifun_el,ifun_temp,nf_loc
87 INTEGER, DIMENSION(NEL) :: INDX,RFLAG
88 INTEGER ,DIMENSION(NFUNC) :: IFUN_STR
89C
90 my_real :: DP,P,SIGM,SIGM_PS,SVM,EF1,EF2,DF,FAC,DEPSF,LAMBDA,
91 . CC,BB,CR,ORM,SS1,SS2,YY,YY_N,DADV,
92 . dcrit,el_ref,sc_el,sc_temp,dd,dn
93 my_real, DIMENSION(NEL) :: epsf,dmg_scale
94 my_real, DIMENSION(NFUNC) :: yfac,rate
95 CHARACTER (LEN=3) :: XCHAR
96C-----------------------------------------------
97C UVAR(1) = DAMAGE
98C UVAR(2) = initial characteristic el. length
99C=======================================================================
100C INITIALIZATIONS
101C-----------------------------------------------
102 dmg_flag = 1
103 indx = 0
104 sigm_ps = one/sqrt(three)
105
106 IF (uvar(1,2) == zero) THEN
107 uvar(1:nel,2) = aldt(1:nel)
108 ENDIF
109C-----------------------------------------------
110 ishell = int(uparam(2)) !ISHEL
111 dcrit = uparam(4)
112 dd = uparam(5)
113 dn = uparam(6)
114 sc_temp = uparam(7)
115 sc_el = uparam(8)
116 el_ref = uparam(9)
117 dadv = uparam(11)
118 nrate = nfunc - 2
119 yfac(1:nrate) = uparam(11+1 :11+nrate)
120 rate(1:nrate) = uparam(11+1+nrate:11+nrate*2)
121c-----------------------------
122 layxfem = ixfem
123 IF (layxfem == 1 .and. ishell == 1) ishell=2
124c-----------------------------
125 nindx = 0
126 rflag = 0
127C---------
128 DO i=1,nel
129 tens(i,1) = signxx(i)
130 tens(i,2) = signyy(i)
131 tens(i,3) = signxy(i)
132 tens(i,4) = signyz(i)
133 tens(i,5) = signzx(i)
134 END DO
135c
136 IF (ixel > 0) THEN ! testing phantom elements
137 IF (ixel == 1) THEN
138 xchar = '1st'
139 ELSEIF (ixel == 2) THEN
140 xchar = '2nd'
141 ELSEIF (ixel == 3) THEN
142 xchar = '3rd'
143 ENDIF
144 ELSE
145 xchar = ' '
146 ENDIF
147C-------------------------------------------------------------------
148c Failure strain value - function interpolation
149C-------------------------------------------------------------------
150 ifun_str(1:nrate) = ifunc(1:nrate)
151c---- Scale functions
152 ifun_el = ifunc(nrate+1)
153 ifun_temp = ifunc(nrate+2)
154c-------------------------------------------------------------------
155c Failure strain value - function interpolation
156c-------------------------------------------------------------------
157 DO i=1,nel
158 j1 = 1
159 DO k=2, nrate-1
160 IF (epsp(i) > rate(j1)) j1 = k
161 ENDDO
162 p = third*(signxx(i) + signyy(i))
163 svm = sqrt(signxx(i)*signxx(i) + signyy(i)*signyy(i)
164 . - signxx(i)*signyy(i) + three*signxy(i)*signxy(i))
165 sigm = p / max(em20,svm)
166c----
167 IF (nrate > 1) THEN
168 j2 = j1+1
169 ef1 = yfac(j1)*finter(ifun_str(j1),sigm,npf,tf,df)
170 ef2 = yfac(j2)*finter(ifun_str(j2),sigm,npf,tf,df)
171 fac = (epsp(i) - rate(j1))/(rate(j2) - rate(j1))
172 fac = max(fac, one) ! no extrapolation
173 epsf(i) = max(ef1 + fac*(ef2 - ef1), em20)
174 ELSE
175 epsf(i) = yfac(j1)*finter(ifun_str(j1),sigm,npf,tf,df)
176 ENDIF
177 ENDDO
178c
179 DO i=1,nel
180c---- element length scale function
181 IF (ifun_el > 0) THEN
182 lambda = uvar(i,2) / el_ref
183 fac = sc_el*finter(ifun_el,lambda,npf,tf,df)
184 epsf(i) = epsf(i)* fac
185 ENDIF
186c---- temperature scale function
187 IF (ifun_temp > 0) THEN
188 fac = sc_temp*finter(ifun_temp,tstar(i),npf,tf,df)
189 epsf(i) = epsf(i)* fac
190 ENDIF
191 ENDDO
192C-------------------------------------------------------------------
193 IF (ishell == 1) THEN ! shell deleted when rupture in one integration point
194 IF (ixfem == 1 .OR. ixfem == 2) THEN
195 DO i=1,nel
196 IF (ishell == 1 .AND. off(i)==one) THEN
197 IF(uvar(i,1) == zero) THEN
198 dp = one
199 ELSE
200C DP = DN*DD**(ONE-ONE/DN) ! old and wrong
201 dp = dn*uvar(i,1)**(one-one/dn)
202 ENDIF
203 IF (epsf(i) > zero) uvar(i,1)=
204 . uvar(i,1)+dp*dpla(i)/epsf(i)
205 IF (ixel == 0) THEN
206 IF (elcrkini(ilay,i)==0) THEN
207 IF (uvar(i,1) >= dcrit) THEN
208 elcrkini(ilay,i) = -1
209 off(i) = four_over_5
210 nindx=nindx+1
211 indx(nindx)=i
212 rflag(i) = 1
213 tdel(i)= time
214 ENDIF
215 ELSEIF (elcrkini(ilay,i) == 2) THEN
216 IF (uvar(i,1) >= dadv) THEN
217 elcrkini(ilay,i) = 1
218 off(i) = four_over_5
219 nindx=nindx+1
220 indx(nindx)=i
221 rflag(i) = -1
222 tdel(i)= time
223 ENDIF
224 ENDIF
225 ELSEIF (uvar(i,1 )>= dcrit) THEN ! IXEL > 0
226 off(i) = four_over_5
227 nindx=nindx+1
228 indx(nindx)=i
229 rflag(i) = 2
230 ENDIF ! IXEL
231 ENDIF
232 ENDDO ! DO J=1,IR
233 ENDIF ! IF (IXFEM == 1 .OR. IXFEM == 2)
234C
235 IF (nindx > 0) THEN
236 DO j=1,nindx
237 i=indx(j)
238#include "lockon.inc"
239c initialization
240 IF (rflag(i)>0.AND.rflag(i)<2)
241 . WRITE(iout, 3800) ngl(i)
242 IF (rflag(i)>0.AND.rflag(i)<2)
243 . WRITE(istdo,3900) ngl(i),time
244c advancement
245 IF (rflag(i) < 0) WRITE(iout, 4000) ngl(i)
246 IF (rflag(i) < 0) WRITE(istdo,4100) ngl(i),time
247c delete
248 IF (rflag(i) > 1) WRITE(iout, 4200)xchar,ngl(i)
249 IF (rflag(i) > 1) WRITE(istdo,4300)xchar,ngl(i),time
250#include "lockoff.inc"
251 ENDDO
252 ENDIF
253 ENDIF ! IF(ISHELL == 1)
254C-------------------------------
255 IF (ishell > 1) THEN ! shell deleted when rupture in all integration points
256 IF (ixfem == 1) THEN
257 DO i=1,nel
258 IF (off(i) == one)THEN
259 IF (uvar(i,1) < dcrit) THEN
260 IF(uvar(i,1) == zero) THEN
261 dp = one
262 ELSE
263C DP = DN*DD**(ONE-ONE/DN) ! old and wrong
264 dp = dn*uvar(i,1)**(one-one/dn)
265 ENDIF
266 IF (epsf(i) > zero) uvar(i,1)=
267 . uvar(i,1)+dp*dpla(i)/epsf(i)
268 IF (ixel == 0) THEN
269 IF (elcrkini(ilay,i) == 0 .AND.
270 . uvar(i,1) >= dcrit) THEN
271 IF (ishell == 2) THEN
272 signxx(i) = zero
273 signyy(i) = zero
274 signxy(i) = zero
275 signyz(i) = zero
276 signzx(i) = zero
277 ENDIF
278 nindx=nindx+1
279 indx(nindx)=i
280 elcrkini(ilay,i) = -1
281 noff(i) = noff(i) + 1
282 IF (noff(i) == nptot) THEN
283 off(i) = four_over_5
284 tdel(i)= time
285 ENDIF
286 rflag(i) = 1
287 ELSEIF (elcrkini(ilay,i) == 2 .AND.
288 . uvar(i,1) >= dadv) THEN
289 IF (ishell == 2) THEN
290 signxx(i) = zero
291 signyy(i) = zero
292 signxy(i) = zero
293 signyz(i) = zero
294 signzx(i) = zero
295 ENDIF
296 nindx=nindx+1
297 indx(nindx)=i
298 elcrkini(ilay,i) = 1
299 noff(i) = noff(i) + 1
300 IF(dadv < dcrit) uvar(i,1) = dcrit
301 IF (noff(i) == nptot) THEN
302 off(i) = four_over_5
303 tdel(i)= time
304 ENDIF
305 rflag(i) = -1
306 ENDIF
307 ELSEIF (uvar(i,1) >= dcrit) THEN ! ixel > 0
308 IF (ishell == 2) THEN
309 signxx(i) = zero
310 signyy(i) = zero
311 signxy(i) = zero
312 signyz(i) = zero
313 signzx(i) = zero
314 ENDIF
315 nindx=nindx+1
316 indx(nindx)=i
317 noff(i) = noff(i) + 1
318 rflag(i) = 3
319 IF (noff(i) == nptot) THEN
320 off(i) = four_over_5
321 rflag(i) = 4 !!! obsolete
322 ENDIF
323 ENDIF ! IXEL
324 ELSEIF (ishell == 2) THEN
325 signxx(i) = zero
326 signyy(i) = zero
327 signxy(i) = zero
328 signyz(i) = zero
329 signzx(i) = zero
330 ENDIF
331 ENDIF ! OFF
332 ENDDO
333 ELSEIF (ixfem == 2) THEN
334 DO i=1,nel
335 IF (off(i)==one .AND. (ishell==2 .OR. ishell==3))THEN
336 IF (uvar(i,1) < dcrit) THEN
337 IF(uvar(i,1) == zero) THEN
338 dp = one
339 ELSE
340C DP = DN*DD**(ONE-ONE/DN) ! old and wrong
341 dp = dn*uvar(i,1)**(one-one/dn)
342 ENDIF
343
344 IF (epsf(i) > zero) uvar(i,1)=
345 . uvar(i,1)+dp*dpla(i)/epsf(i)
346 IF (ixel == 0) THEN
347 IF (elcrkini(ilay,i) == 0 .AND.
348 . uvar(i,1) >= dcrit) THEN
349 IF (ishell == 2) THEN
350 signxx(i) = zero
351 signyy(i) = zero
352 signxy(i) = zero
353 signyz(i) = zero
354 signzx(i) = zero
355 ENDIF
356 nindx=nindx+1
357 indx(nindx)=i
358 noff(i) = noff(i) + 1
359 IF (noff(i) == nptot) THEN
360 off(i) = four_over_5
361 elcrkini(ilay,i) = -1
362 rflag(i) = 1
363 tdel(i)= time
364 ENDIF
365 ELSEIF (elcrkini(ilay,i) == 2 .AND.
366 . uvar(i,1) >= dadv) THEN
367 IF (ishell == 2) THEN
368 signxx(i) = zero
369 signyy(i) = zero
370 signxy(i) = zero
371 signyz(i) = zero
372 signzx(i) = zero
373 ENDIF
374 nindx=nindx+1
375 indx(nindx)=i
376 noff(i) = noff(i) + 1
377 IF(dadv < dcrit) uvar(i,1) = dcrit
378 IF (noff(i) == nptot) THEN
379 off(i) = four_over_5
380 elcrkini(ilay,i) = 1
381 rflag(i) = -1
382 tdel(i)= time
383 ENDIF
384 ENDIF
385 ELSEIF (uvar(i,1) >= dcrit) THEN ! IXEL > 0
386 IF (ishell == 2) THEN
387 signxx(i) = zero
388 signyy(i) = zero
389 signxy(i) = zero
390 signyz(i) = zero
391 signzx(i) = zero
392 ENDIF
393 nindx=nindx+1
394 indx(nindx)=i
395 noff(i) = noff(i) + 1
396 IF (noff(i) == nptot) THEN
397 off(i) = four_over_5
398 rflag(i) = 4
399 ENDIF
400 ENDIF ! IXEL
401 ELSEIF (ishell == 2) THEN
402 signxx(i) = zero
403 signyy(i) = zero
404 signxy(i) = zero
405 signyz(i) = zero
406 signzx(i) = zero
407 ENDIF
408 ENDIF ! OFF
409 ENDDO
410 ENDIF ! IF (IXFEM == 1)
411c-----------------------------------------------------------------------
412 IF (nindx > 0) THEN
413 DO j=1,nindx
414 i = indx(j)
415#include "lockon.inc"
416 IF(ixfem ==1)THEN
417c initialization
418 IF (rflag(i)>0.AND.rflag(i)<3)WRITE(iout,4600)ngl(i),ipt
419 IF (rflag(i)>0.AND.rflag(i)<3)WRITE(istdo,4700)
420 . ngl(i),ipt,time
421c advancement
422 IF (rflag(i) < 0) WRITE(iout, 4800) ngl(i),ipt
423 IF (rflag(i) < 0) WRITE(istdo,4900) ngl(i),ipt,time
424c delete
425 IF (rflag(i) > 2) WRITE(iout, 4400)xchar,ngl(i),ipt
426 IF (rflag(i) > 2) WRITE(istdo,4500)xchar,ngl(i),ipt,time
427C
428 IF (rflag(i) /= 0 .AND. ixel == 0)
429 . WRITE(iout, 2000) ngl(i),ipt
430 IF (rflag(i) /= 0.AND. ixel == 0)
431 . WRITE(istdo,2100) ngl(i),ipt,time
432 ELSEIF(ixfem ==2)THEN
433c initialization
434 IF (rflag(i)>0.AND.rflag(i)<3)WRITE(iout,3800)ngl(i)
435 IF (rflag(i)>0.AND.rflag(i)<3)WRITE(istdo,3900)
436 . ngl(i),time
437c advancement
438 IF (rflag(i) < 0) WRITE(iout, 4000) ngl(i)
439 IF (rflag(i) < 0) WRITE(istdo,4100) ngl(i),time
440c delete
441 IF (rflag(i) > 2) WRITE(iout, 4200)xchar,ngl(i)
442 IF (rflag(i) > 2) WRITE(istdo,4300)xchar,ngl(i),time
443 ENDIF
444#include "lockoff.inc"
445 ENDDO
446 ENDIF
447 ENDIF ! IF (ISHELL > 1)
448c
449C-------------Maximum Damage storing for output : 0 < DFMAX < 1--------------
450 DO i=1,nel
451 dfmax(i)= min(one,max(dfmax(i),uvar(i,1)/dcrit))
452 ENDDO
453C------------------
454 2000 FORMAT(1x,'FAILURE OF SHELL ELEMENT (TAB)',i10,1x,
455 .'LAYER',i10)
456 2100 FORMAT(1x,'FAILURE OF SHELL ELEMENT (TAB)',i10,1x,
457 .'LAYER',i10,':',/,'AT TIME :',1pe12.4)
458 2200 FORMAT(1x,'STRESS TENSOR SET TO ZERO IN THE LAYER')
459 2400 FORMAT(1x,1pg20.13,' % OF THICKNESS OF SHELL BROKEN ')
460 2500 FORMAT(1x,' LOWER SKIN -> UPPER SKIN ')
461 2600 FORMAT(1x,' UPPER SKIN -> LOWER SKIN ')
462 3700 FORMAT(1x,'STRESS TENSOR SET TO ZERO, LAYER',i10)
463C---
464 2410 FORMAT(1x,1pg20.13,' % OF THICKNESS OF SHELL ',i10,' BROKEN ')
465 3800 FORMAT(1x,'CRACK INITIALIZATION IN SHELL ELEMENT (TAB)',i10)
466 3900 FORMAT(1x,'CRACK INITIALIZATION IN SHELL ELEMENT (TAB)',i10,
467 . 1x,':',/,' AT TIME :',1pe12.4)
468 4000 FORMAT(1x,'CRACK ADVANCEMENT IN SHELL ELEMENT (TAB) ',i10)
469 4100 FORMAT(1x,'CRACK ADVANCEMENT IN SHELL ELEMENT (TAB) ',i10,
470 . 1x,':',/,' AT TIME :',1pe12.4)
471 4200 FORMAT(1x,'DELETE OF ',a5,' CRACKED PHANTOM ELEMENT'/
472 . 1x,'OF THE ORIGINAL SHELL ELEMENT (TAB) ',
473 . i10)
474 4300 FORMAT(1x,'DELETE OF ',a5,' CRACKED PHANTOM ELEMENT'/
475 . 1x,'OF THE ORIGINAL SHELL ELEMENT (TAB) ',
476 . i10,':',/1x,'AT TIME :',1pe20.13)
477 4400 FORMAT(1x,'DELETE OF ',a5,' CRACKED PHANTOM ELEMENT'/
478 . 1x,'OF THE ORIGINAL SHELL ELEMENT (TAB) ',
479 . i10,' LAYER',i10)
480 4500 FORMAT(1x,'DELETE OF ',a5,' CRACKED PHANTOM ELEMENT'/
481 . 1x,'OF THE ORIGINAL SHELL ELEMENT (TAB) ',
482 . i10,' LAYER',i10,':',/1x,'AT TIME :',1pe20.13)
483 4600 FORMAT(1x,'CRACK INITIALIZATION IN SHELL ELEMENT (TAB)',i10,
484 . 1x,'LAYER',i10)
485 4700 FORMAT(1x,'CRACK INITIALIZATION IN SHELL ELEMENT (TAB)',i10,
486 . 1x,'LAYER',i10,':',/,' AT TIME :',1pe12.4)
487 4800 FORMAT(1x,'CRACK ADVANCEMENT IN SHELL ELEMENT (TAB) ',i10,
488 . 1x,'LAYER',i10)
489 4900 FORMAT(1x,'CRACK ADVANCEMENT IN SHELL ELEMENT (TAB) ',i10,
490 . 1x,'LAYER',i10,':',/,' AT TIME :',1pe12.4)
491 5010 FORMAT(1x,'SHELL ELEMENT FAILURE DUE TO THINNING (TAB)',i10)
492 5020 FORMAT(1x,'SHELL ELEMENT FAILURE DUE TO THINNING (TAB)',i10,
493 . 1x,':',/1x,'AT TIME :',1pe12.4)
494
495c-----------
496 RETURN
497 END
fail_tab_old_xfem
subroutine fail_tab_old_xfem(nel, nparam, nuvar, npf, tf, time, timestep, uparam, ngl, ipt, nptot, nfunc, ifunc, dmg_flag, signxx, signyy, signxy, signyz, signzx, dpla, epsp, tstar, tens, uvar, noff, aldt, off, offl, elcrkini, ixfem, ixel, ilay, dfmax, tdel)
Definition fail_tab_old_xfem.F:41
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1249
tabulated
subroutine tabulated(iflag, nel, pm, off, eint, mu, espe, dvol, df, vnew, mat, psh, pnew, dpdm, dpde, npf, tf)
Definition tabulated.F:32